From d6c48ae6a8b58f5974133170863a31c70f0123d1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 14 Jul 2021 13:59:02 -0400 Subject: Normalized the hierarchy of the standard library modules. --- .gitignore | 17 +- lux-bootstrapper/src/lux/analyser/base.clj | 2 +- lux-bootstrapper/src/lux/base.clj | 5 +- lux-bootstrapper/src/lux/compiler/jvm.clj | 4 +- lux-bootstrapper/src/lux/compiler/jvm/base.clj | 8 +- lux-bootstrapper/src/lux/compiler/jvm/case.clj | 16 +- lux-bootstrapper/src/lux/compiler/jvm/lux.clj | 13 +- .../src/lux/compiler/jvm/proc/common.clj | 13 +- lux-bootstrapper/src/lux/compiler/jvm/rt.clj | 28 +- lux-bootstrapper/src/lux/host.clj | 13 +- lux-bootstrapper/src/lux/repl.clj | 2 +- lux-bootstrapper/src/lux/type.clj | 42 +- lux-bootstrapper/src/lux/type/host.clj | 2 +- lux-js/source/program.lux | 125 +- lux-jvm/source/luxc/lang/directive/jvm.lux | 69 +- lux-jvm/source/luxc/lang/host/jvm.lux | 55 +- lux-jvm/source/luxc/lang/host/jvm/def.lux | 45 +- lux-jvm/source/luxc/lang/host/jvm/inst.lux | 69 +- lux-jvm/source/luxc/lang/synthesis/variable.lux | 3 +- lux-jvm/source/luxc/lang/translation/jvm.lux | 71 +- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 53 +- .../source/luxc/lang/translation/jvm/common.lux | 43 +- .../luxc/lang/translation/jvm/expression.lux | 17 +- .../source/luxc/lang/translation/jvm/extension.lux | 9 +- .../luxc/lang/translation/jvm/extension/common.lux | 67 +- .../luxc/lang/translation/jvm/extension/host.lux | 103 +- .../source/luxc/lang/translation/jvm/function.lux | 69 +- lux-jvm/source/luxc/lang/translation/jvm/loop.lux | 41 +- .../source/luxc/lang/translation/jvm/primitive.lux | 23 +- .../source/luxc/lang/translation/jvm/program.lux | 27 +- .../source/luxc/lang/translation/jvm/reference.lux | 39 +- .../source/luxc/lang/translation/jvm/runtime.lux | 63 +- .../source/luxc/lang/translation/jvm/structure.lux | 59 +- lux-jvm/source/program.lux | 113 +- lux-lua/source/program.lux | 121 +- lux-php/source/lux.lux | 1 + lux-python/source/program.lux | 125 +- lux-ruby/source/program.lux | 139 +- stdlib/source/library/lux.lux | 5958 ++++++++++++++++++++ stdlib/source/library/lux/abstract/algebra.lux | 17 + stdlib/source/library/lux/abstract/apply.lux | 37 + stdlib/source/library/lux/abstract/codec.lux | 29 + stdlib/source/library/lux/abstract/comonad.lux | 79 + .../source/library/lux/abstract/comonad/cofree.lux | 28 + stdlib/source/library/lux/abstract/enum.lux | 26 + stdlib/source/library/lux/abstract/equivalence.lux | 25 + stdlib/source/library/lux/abstract/fold.lux | 17 + stdlib/source/library/lux/abstract/functor.lux | 45 + .../library/lux/abstract/functor/contravariant.lux | 9 + stdlib/source/library/lux/abstract/hash.lux | 27 + stdlib/source/library/lux/abstract/interval.lux | 194 + stdlib/source/library/lux/abstract/monad.lux | 184 + stdlib/source/library/lux/abstract/monad/free.lux | 68 + .../source/library/lux/abstract/monad/indexed.lux | 84 + stdlib/source/library/lux/abstract/monoid.lux | 21 + stdlib/source/library/lux/abstract/order.lux | 58 + stdlib/source/library/lux/abstract/predicate.lux | 61 + .../source/library/lux/control/concatenative.lux | 331 ++ .../library/lux/control/concurrency/actor.lux | 390 ++ .../library/lux/control/concurrency/atom.lux | 103 + .../source/library/lux/control/concurrency/frp.lux | 296 + .../library/lux/control/concurrency/promise.lux | 200 + .../library/lux/control/concurrency/semaphore.lux | 174 + .../source/library/lux/control/concurrency/stm.lux | 274 + .../library/lux/control/concurrency/thread.lux | 170 + stdlib/source/library/lux/control/continuation.lux | 100 + stdlib/source/library/lux/control/exception.lux | 184 + stdlib/source/library/lux/control/function.lux | 47 + .../library/lux/control/function/contract.lux | 52 + .../source/library/lux/control/function/memo.lux | 64 + .../source/library/lux/control/function/mixin.lux | 64 + .../source/library/lux/control/function/mutual.lux | 158 + stdlib/source/library/lux/control/io.lux | 72 + stdlib/source/library/lux/control/parser.lux | 324 ++ .../source/library/lux/control/parser/analysis.lux | 135 + .../source/library/lux/control/parser/binary.lux | 275 + stdlib/source/library/lux/control/parser/cli.lux | 99 + stdlib/source/library/lux/control/parser/code.lux | 199 + .../library/lux/control/parser/environment.lux | 44 + stdlib/source/library/lux/control/parser/json.lux | 207 + .../library/lux/control/parser/synthesis.lux | 164 + stdlib/source/library/lux/control/parser/text.lux | 377 ++ stdlib/source/library/lux/control/parser/tree.lux | 60 + stdlib/source/library/lux/control/parser/type.lux | 349 ++ stdlib/source/library/lux/control/parser/xml.lux | 142 + stdlib/source/library/lux/control/pipe.lux | 161 + stdlib/source/library/lux/control/reader.lux | 72 + stdlib/source/library/lux/control/region.lux | 158 + stdlib/source/library/lux/control/remember.lux | 74 + .../library/lux/control/security/capability.lux | 71 + .../source/library/lux/control/security/policy.lux | 93 + stdlib/source/library/lux/control/state.lux | 149 + stdlib/source/library/lux/control/thread.lux | 106 + stdlib/source/library/lux/control/try.lux | 153 + stdlib/source/library/lux/control/writer.lux | 78 + stdlib/source/library/lux/data/binary.lux | 367 ++ stdlib/source/library/lux/data/bit.lux | 59 + .../source/library/lux/data/collection/array.lux | 388 ++ stdlib/source/library/lux/data/collection/bits.lux | 177 + .../library/lux/data/collection/dictionary.lux | 732 +++ .../lux/data/collection/dictionary/ordered.lux | 584 ++ .../lux/data/collection/dictionary/plist.lux | 98 + stdlib/source/library/lux/data/collection/list.lux | 616 ++ .../source/library/lux/data/collection/queue.lux | 93 + .../library/lux/data/collection/queue/priority.lux | 121 + stdlib/source/library/lux/data/collection/row.lux | 490 ++ .../library/lux/data/collection/sequence.lux | 151 + stdlib/source/library/lux/data/collection/set.lux | 105 + .../library/lux/data/collection/set/multi.lux | 158 + .../library/lux/data/collection/set/ordered.lux | 85 + .../source/library/lux/data/collection/stack.lux | 66 + stdlib/source/library/lux/data/collection/tree.lux | 85 + .../library/lux/data/collection/tree/finger.lux | 108 + .../library/lux/data/collection/tree/zipper.lux | 318 ++ stdlib/source/library/lux/data/color.lux | 425 ++ stdlib/source/library/lux/data/color/named.lux | 156 + stdlib/source/library/lux/data/format/binary.lux | 292 + stdlib/source/library/lux/data/format/css.lux | 126 + stdlib/source/library/lux/data/format/css/font.lux | 26 + .../library/lux/data/format/css/property.lux | 503 ++ .../source/library/lux/data/format/css/query.lux | 135 + .../library/lux/data/format/css/selector.lux | 205 + .../source/library/lux/data/format/css/style.lux | 36 + .../source/library/lux/data/format/css/value.lux | 1329 +++++ stdlib/source/library/lux/data/format/html.lux | 563 ++ stdlib/source/library/lux/data/format/json.lux | 422 ++ stdlib/source/library/lux/data/format/markdown.lux | 181 + stdlib/source/library/lux/data/format/tar.lux | 871 +++ stdlib/source/library/lux/data/format/xml.lux | 299 + stdlib/source/library/lux/data/identity.lux | 38 + stdlib/source/library/lux/data/lazy.lux | 68 + stdlib/source/library/lux/data/maybe.lux | 151 + stdlib/source/library/lux/data/name.lux | 64 + stdlib/source/library/lux/data/product.lux | 69 + stdlib/source/library/lux/data/store.lux | 50 + stdlib/source/library/lux/data/sum.lux | 90 + stdlib/source/library/lux/data/text.lux | 380 ++ stdlib/source/library/lux/data/text/buffer.lux | 115 + stdlib/source/library/lux/data/text/encoding.lux | 163 + .../source/library/lux/data/text/encoding/utf8.lux | 164 + stdlib/source/library/lux/data/text/escape.lux | 244 + stdlib/source/library/lux/data/text/format.lux | 135 + stdlib/source/library/lux/data/text/regex.lux | 495 ++ .../source/library/lux/data/text/unicode/block.lux | 205 + .../source/library/lux/data/text/unicode/set.lux | 240 + stdlib/source/library/lux/data/trace.lux | 36 + stdlib/source/library/lux/debug.lux | 598 ++ stdlib/source/library/lux/extension.lux | 89 + stdlib/source/library/lux/ffi.js.lux | 364 ++ stdlib/source/library/lux/ffi.jvm.lux | 2048 +++++++ stdlib/source/library/lux/ffi.lua.lux | 310 + stdlib/source/library/lux/ffi.old.lux | 1829 ++++++ stdlib/source/library/lux/ffi.php.lux | 314 ++ stdlib/source/library/lux/ffi.py.lux | 315 ++ stdlib/source/library/lux/ffi.rb.lux | 332 ++ stdlib/source/library/lux/ffi.scm.lux | 220 + stdlib/source/library/lux/locale.lux | 45 + stdlib/source/library/lux/locale/language.lux | 573 ++ stdlib/source/library/lux/locale/territory.lux | 312 + stdlib/source/library/lux/macro.lux | 210 + stdlib/source/library/lux/macro/code.lux | 161 + stdlib/source/library/lux/macro/local.lux | 106 + stdlib/source/library/lux/macro/poly.lux | 128 + stdlib/source/library/lux/macro/syntax.lux | 129 + .../library/lux/macro/syntax/annotations.lux | 42 + stdlib/source/library/lux/macro/syntax/check.lux | 42 + .../library/lux/macro/syntax/declaration.lux | 47 + .../source/library/lux/macro/syntax/definition.lux | 141 + stdlib/source/library/lux/macro/syntax/export.lux | 21 + stdlib/source/library/lux/macro/syntax/input.lux | 38 + .../library/lux/macro/syntax/type/variable.lux | 28 + stdlib/source/library/lux/macro/template.lux | 185 + stdlib/source/library/lux/math.lux | 394 ++ stdlib/source/library/lux/math/infix.lux | 96 + .../source/library/lux/math/logic/continuous.lux | 40 + stdlib/source/library/lux/math/logic/fuzzy.lux | 132 + stdlib/source/library/lux/math/modular.lux | 157 + stdlib/source/library/lux/math/modulus.lux | 56 + stdlib/source/library/lux/math/number.lux | 87 + stdlib/source/library/lux/math/number/complex.lux | 316 ++ stdlib/source/library/lux/math/number/frac.lux | 447 ++ stdlib/source/library/lux/math/number/i16.lux | 24 + stdlib/source/library/lux/math/number/i32.lux | 24 + stdlib/source/library/lux/math/number/i64.lux | 214 + stdlib/source/library/lux/math/number/i8.lux | 24 + stdlib/source/library/lux/math/number/int.lux | 260 + stdlib/source/library/lux/math/number/nat.lux | 380 ++ stdlib/source/library/lux/math/number/ratio.lux | 162 + stdlib/source/library/lux/math/number/rev.lux | 463 ++ stdlib/source/library/lux/math/random.lux | 400 ++ stdlib/source/library/lux/meta.lux | 568 ++ stdlib/source/library/lux/meta/annotation.lux | 95 + stdlib/source/library/lux/meta/location.lux | 49 + stdlib/source/library/lux/program.lux | 83 + stdlib/source/library/lux/target.lux | 26 + stdlib/source/library/lux/target/common_lisp.lux | 469 ++ stdlib/source/library/lux/target/js.lux | 449 ++ stdlib/source/library/lux/target/jvm.lux | 284 + stdlib/source/library/lux/target/jvm/attribute.lux | 123 + .../library/lux/target/jvm/attribute/code.lux | 83 + .../lux/target/jvm/attribute/code/exception.lux | 58 + .../library/lux/target/jvm/attribute/constant.lux | 27 + stdlib/source/library/lux/target/jvm/bytecode.lux | 1046 ++++ .../library/lux/target/jvm/bytecode/address.lux | 74 + .../lux/target/jvm/bytecode/environment.lux | 108 + .../lux/target/jvm/bytecode/environment/limit.lux | 58 + .../jvm/bytecode/environment/limit/registry.lux | 91 + .../jvm/bytecode/environment/limit/stack.lux | 69 + .../lux/target/jvm/bytecode/instruction.lux | 714 +++ .../library/lux/target/jvm/bytecode/jump.lux | 27 + stdlib/source/library/lux/target/jvm/class.lux | 134 + stdlib/source/library/lux/target/jvm/constant.lux | 246 + .../library/lux/target/jvm/constant/pool.lux | 158 + .../source/library/lux/target/jvm/constant/tag.lux | 50 + .../library/lux/target/jvm/encoding/name.lux | 40 + .../library/lux/target/jvm/encoding/signed.lux | 107 + .../library/lux/target/jvm/encoding/unsigned.lux | 121 + stdlib/source/library/lux/target/jvm/field.lux | 70 + stdlib/source/library/lux/target/jvm/index.lux | 38 + stdlib/source/library/lux/target/jvm/loader.lux | 143 + stdlib/source/library/lux/target/jvm/magic.lux | 20 + stdlib/source/library/lux/target/jvm/method.lux | 104 + stdlib/source/library/lux/target/jvm/modifier.lux | 88 + .../library/lux/target/jvm/modifier/inner.lux | 21 + .../source/library/lux/target/jvm/reflection.lux | 382 ++ stdlib/source/library/lux/target/jvm/type.lux | 205 + .../source/library/lux/target/jvm/type/alias.lux | 116 + stdlib/source/library/lux/target/jvm/type/box.lux | 19 + .../library/lux/target/jvm/type/category.lux | 36 + .../library/lux/target/jvm/type/descriptor.lux | 123 + stdlib/source/library/lux/target/jvm/type/lux.lux | 189 + .../source/library/lux/target/jvm/type/parser.lux | 253 + .../library/lux/target/jvm/type/reflection.lux | 104 + .../library/lux/target/jvm/type/signature.lux | 134 + stdlib/source/library/lux/target/jvm/version.lux | 38 + stdlib/source/library/lux/target/lua.lux | 416 ++ stdlib/source/library/lux/target/php.lux | 545 ++ stdlib/source/library/lux/target/python.lux | 501 ++ stdlib/source/library/lux/target/r.lux | 386 ++ stdlib/source/library/lux/target/ruby.lux | 473 ++ stdlib/source/library/lux/target/scheme.lux | 380 ++ stdlib/source/library/lux/test.lux | 419 ++ stdlib/source/library/lux/time.lux | 217 + stdlib/source/library/lux/time/date.lux | 349 ++ stdlib/source/library/lux/time/day.lux | 121 + stdlib/source/library/lux/time/duration.lux | 203 + stdlib/source/library/lux/time/instant.lux | 235 + stdlib/source/library/lux/time/month.lux | 225 + stdlib/source/library/lux/time/year.lux | 142 + stdlib/source/library/lux/tool/compiler.lux | 47 + stdlib/source/library/lux/tool/compiler/arity.lux | 16 + .../library/lux/tool/compiler/default/init.lux | 287 + .../library/lux/tool/compiler/default/platform.lux | 602 ++ .../library/lux/tool/compiler/language/lux.lux | 107 + .../lux/tool/compiler/language/lux/analysis.lux | 556 ++ .../compiler/language/lux/analysis/evaluation.lux | 57 + .../tool/compiler/language/lux/analysis/macro.lux | 52 + .../lux/tool/compiler/language/lux/directive.lux | 83 + .../lux/tool/compiler/language/lux/generation.lux | 336 ++ .../tool/compiler/language/lux/phase/analysis.lux | 144 + .../compiler/language/lux/phase/analysis/case.lux | 325 ++ .../language/lux/phase/analysis/case/coverage.lux | 373 ++ .../language/lux/phase/analysis/function.lux | 113 + .../language/lux/phase/analysis/inference.lux | 301 + .../language/lux/phase/analysis/module.lux | 275 + .../language/lux/phase/analysis/primitive.lux | 33 + .../language/lux/phase/analysis/reference.lux | 85 + .../compiler/language/lux/phase/analysis/scope.lux | 206 + .../language/lux/phase/analysis/structure.lux | 361 ++ .../compiler/language/lux/phase/analysis/type.lux | 56 + .../tool/compiler/language/lux/phase/directive.lux | 79 + .../tool/compiler/language/lux/phase/extension.lux | 177 + .../language/lux/phase/extension/analysis.lux | 16 + .../lux/phase/extension/analysis/common_lisp.lux | 35 + .../language/lux/phase/extension/analysis/js.lux | 218 + .../language/lux/phase/extension/analysis/jvm.lux | 2076 +++++++ .../language/lux/phase/extension/analysis/lua.lux | 252 + .../language/lux/phase/extension/analysis/lux.lux | 301 + .../language/lux/phase/extension/analysis/php.lux | 214 + .../lux/phase/extension/analysis/python.lux | 231 + .../language/lux/phase/extension/analysis/r.lux | 35 + .../language/lux/phase/extension/analysis/ruby.lux | 199 + .../lux/phase/extension/analysis/scheme.lux | 158 + .../language/lux/phase/extension/bundle.lux | 29 + .../language/lux/phase/extension/directive/jvm.lux | 307 + .../language/lux/phase/extension/directive/lux.lux | 451 ++ .../lux/phase/extension/generation/common_lisp.lux | 18 + .../extension/generation/common_lisp/common.lux | 180 + .../extension/generation/common_lisp/host.lux | 40 + .../language/lux/phase/extension/generation/js.lux | 18 + .../lux/phase/extension/generation/js/common.lux | 191 + .../lux/phase/extension/generation/js/host.lux | 160 + .../lux/phase/extension/generation/jvm.lux | 20 + .../lux/phase/extension/generation/jvm/common.lux | 414 ++ .../lux/phase/extension/generation/jvm/host.lux | 1106 ++++ .../lux/phase/extension/generation/lua.lux | 18 + .../lux/phase/extension/generation/lua/common.lux | 181 + .../lux/phase/extension/generation/lua/host.lux | 200 + .../lux/phase/extension/generation/php.lux | 18 + .../lux/phase/extension/generation/php/common.lux | 192 + .../lux/phase/extension/generation/php/host.lux | 143 + .../lux/phase/extension/generation/python.lux | 18 + .../phase/extension/generation/python/common.lux | 171 + .../lux/phase/extension/generation/python/host.lux | 165 + .../language/lux/phase/extension/generation/r.lux | 18 + .../lux/phase/extension/generation/r/common.lux | 179 + .../lux/phase/extension/generation/r/host.lux | 40 + .../lux/phase/extension/generation/ruby.lux | 18 + .../lux/phase/extension/generation/ruby/common.lux | 186 + .../lux/phase/extension/generation/ruby/host.lux | 136 + .../lux/phase/extension/generation/scheme.lux | 18 + .../phase/extension/generation/scheme/common.lux | 175 + .../lux/phase/extension/generation/scheme/host.lux | 109 + .../language/lux/phase/extension/synthesis.lux | 11 + .../language/lux/phase/generation/common_lisp.lux | 57 + .../lux/phase/generation/common_lisp/case.lux | 262 + .../lux/phase/generation/common_lisp/extension.lux | 14 + .../generation/common_lisp/extension/common.lux | 137 + .../lux/phase/generation/common_lisp/function.lux | 103 + .../lux/phase/generation/common_lisp/loop.lux | 70 + .../lux/phase/generation/common_lisp/primitive.lux | 21 + .../lux/phase/generation/common_lisp/reference.lux | 13 + .../lux/phase/generation/common_lisp/runtime.lux | 293 + .../lux/phase/generation/common_lisp/structure.lux | 37 + .../language/lux/phase/generation/extension.lux | 66 + .../compiler/language/lux/phase/generation/js.lux | 117 + .../language/lux/phase/generation/js/case.lux | 322 ++ .../language/lux/phase/generation/js/function.lux | 123 + .../language/lux/phase/generation/js/loop.lux | 91 + .../language/lux/phase/generation/js/primitive.lux | 21 + .../language/lux/phase/generation/js/reference.lux | 13 + .../language/lux/phase/generation/js/runtime.lux | 785 +++ .../language/lux/phase/generation/js/structure.lux | 38 + .../compiler/language/lux/phase/generation/jvm.lux | 73 + .../language/lux/phase/generation/jvm/case.lux | 266 + .../language/lux/phase/generation/jvm/debug.lux | 31 + .../language/lux/phase/generation/jvm/function.lux | 135 + .../lux/phase/generation/jvm/function/abstract.lux | 24 + .../generation/jvm/function/field/constant.lux | 26 + .../jvm/function/field/constant/arity.lux | 22 + .../generation/jvm/function/field/variable.lux | 56 + .../jvm/function/field/variable/foreign.lux | 40 + .../jvm/function/field/variable/partial.lux | 59 + .../jvm/function/field/variable/partial/count.lux | 31 + .../lux/phase/generation/jvm/function/method.lux | 14 + .../phase/generation/jvm/function/method/apply.lux | 157 + .../jvm/function/method/implementation.lux | 42 + .../phase/generation/jvm/function/method/init.lux | 98 + .../phase/generation/jvm/function/method/new.lux | 81 + .../phase/generation/jvm/function/method/reset.lux | 50 + .../language/lux/phase/generation/jvm/host.lux | 161 + .../language/lux/phase/generation/jvm/loop.lux | 90 + .../lux/phase/generation/jvm/primitive.lux | 121 + .../language/lux/phase/generation/jvm/program.lux | 144 + .../lux/phase/generation/jvm/reference.lux | 67 + .../language/lux/phase/generation/jvm/runtime.lux | 611 ++ .../lux/phase/generation/jvm/structure.lux | 95 + .../language/lux/phase/generation/jvm/type.lux | 23 + .../language/lux/phase/generation/jvm/value.lux | 49 + .../compiler/language/lux/phase/generation/lua.lux | 119 + .../language/lux/phase/generation/lua/case.lux | 280 + .../language/lux/phase/generation/lua/function.lux | 137 + .../language/lux/phase/generation/lua/loop.lux | 119 + .../lux/phase/generation/lua/primitive.lux | 16 + .../lux/phase/generation/lua/reference.lux | 13 + .../language/lux/phase/generation/lua/runtime.lux | 432 ++ .../lux/phase/generation/lua/structure.lux | 37 + .../compiler/language/lux/phase/generation/php.lux | 103 + .../language/lux/phase/generation/php/case.lux | 298 + .../lux/phase/generation/php/extension.lux | 14 + .../lux/phase/generation/php/extension/common.lux | 112 + .../language/lux/phase/generation/php/function.lux | 116 + .../language/lux/phase/generation/php/loop.lux | 122 + .../lux/phase/generation/php/primitive.lux | 32 + .../lux/phase/generation/php/reference.lux | 13 + .../language/lux/phase/generation/php/runtime.lux | 610 ++ .../lux/phase/generation/php/structure.lux | 42 + .../language/lux/phase/generation/python.lux | 113 + .../language/lux/phase/generation/python/case.lux | 334 ++ .../lux/phase/generation/python/function.lux | 112 + .../language/lux/phase/generation/python/loop.lux | 122 + .../lux/phase/generation/python/primitive.lux | 18 + .../lux/phase/generation/python/reference.lux | 13 + .../lux/phase/generation/python/runtime.lux | 456 ++ .../lux/phase/generation/python/structure.lux | 37 + .../compiler/language/lux/phase/generation/r.lux | 59 + .../language/lux/phase/generation/r/case.lux | 240 + .../language/lux/phase/generation/r/function.lux | 117 + .../language/lux/phase/generation/r/loop.lux | 65 + .../language/lux/phase/generation/r/primitive.lux | 18 + .../lux/phase/generation/r/procedure/common.lux | 340 ++ .../lux/phase/generation/r/procedure/host.lux | 90 + .../language/lux/phase/generation/r/reference.lux | 13 + .../language/lux/phase/generation/r/runtime.lux | 855 +++ .../language/lux/phase/generation/r/structure.lux | 40 + .../language/lux/phase/generation/reference.lux | 89 + .../language/lux/phase/generation/ruby.lux | 105 + .../language/lux/phase/generation/ruby/case.lux | 360 ++ .../lux/phase/generation/ruby/function.lux | 112 + .../language/lux/phase/generation/ruby/loop.lux | 96 + .../lux/phase/generation/ruby/primitive.lux | 16 + .../lux/phase/generation/ruby/reference.lux | 13 + .../language/lux/phase/generation/ruby/runtime.lux | 403 ++ .../lux/phase/generation/ruby/structure.lux | 37 + .../language/lux/phase/generation/scheme.lux | 59 + .../language/lux/phase/generation/scheme/case.lux | 223 + .../lux/phase/generation/scheme/extension.lux | 14 + .../phase/generation/scheme/extension/common.lux | 223 + .../lux/phase/generation/scheme/function.lux | 101 + .../language/lux/phase/generation/scheme/loop.lux | 64 + .../lux/phase/generation/scheme/primitive.lux | 16 + .../lux/phase/generation/scheme/reference.lux | 13 + .../lux/phase/generation/scheme/runtime.lux | 370 ++ .../lux/phase/generation/scheme/structure.lux | 40 + .../tool/compiler/language/lux/phase/synthesis.lux | 104 + .../compiler/language/lux/phase/synthesis/case.lux | 430 ++ .../language/lux/phase/synthesis/function.lux | 277 + .../compiler/language/lux/phase/synthesis/loop.lux | 187 + .../language/lux/phase/synthesis/variable.lux | 443 ++ .../lux/tool/compiler/language/lux/program.lux | 57 + .../lux/tool/compiler/language/lux/syntax.lux | 584 ++ .../lux/tool/compiler/language/lux/synthesis.lux | 809 +++ .../lux/tool/compiler/language/lux/version.lux | 9 + stdlib/source/library/lux/tool/compiler/meta.lux | 9 + .../library/lux/tool/compiler/meta/archive.lux | 280 + .../lux/tool/compiler/meta/archive/artifact.lux | 155 + .../lux/tool/compiler/meta/archive/descriptor.lux | 49 + .../lux/tool/compiler/meta/archive/document.lux | 72 + .../library/lux/tool/compiler/meta/archive/key.lux | 19 + .../lux/tool/compiler/meta/archive/signature.lux | 42 + .../lux/tool/compiler/meta/cache/dependency.lux | 97 + .../source/library/lux/tool/compiler/meta/io.lux | 20 + .../library/lux/tool/compiler/meta/io/archive.lux | 450 ++ .../library/lux/tool/compiler/meta/io/context.lux | 170 + .../library/lux/tool/compiler/meta/packager.lux | 43 + .../lux/tool/compiler/meta/packager/jvm.lux | 145 + .../lux/tool/compiler/meta/packager/scheme.lux | 132 + .../lux/tool/compiler/meta/packager/script.lux | 76 + stdlib/source/library/lux/tool/compiler/phase.lux | 119 + .../source/library/lux/tool/compiler/reference.lux | 85 + .../lux/tool/compiler/reference/variable.lux | 68 + .../source/library/lux/tool/compiler/version.lux | 52 + stdlib/source/library/lux/tool/interpreter.lux | 222 + stdlib/source/library/lux/tool/mediator.lux | 19 + stdlib/source/library/lux/type.lux | 463 ++ stdlib/source/library/lux/type/abstract.lux | 269 + stdlib/source/library/lux/type/check.lux | 721 +++ stdlib/source/library/lux/type/dynamic.lux | 51 + stdlib/source/library/lux/type/implicit.lux | 401 ++ stdlib/source/library/lux/type/quotient.lux | 56 + stdlib/source/library/lux/type/refinement.lux | 89 + stdlib/source/library/lux/type/resource.lux | 218 + stdlib/source/library/lux/type/unit.lux | 188 + stdlib/source/library/lux/type/variance.lux | 12 + stdlib/source/library/lux/world/console.lux | 159 + stdlib/source/library/lux/world/db/jdbc.lux | 176 + stdlib/source/library/lux/world/db/jdbc/input.lux | 107 + stdlib/source/library/lux/world/db/jdbc/output.lux | 195 + stdlib/source/library/lux/world/db/sql.lux | 476 ++ stdlib/source/library/lux/world/file.lux | 1303 +++++ stdlib/source/library/lux/world/file/watch.lux | 459 ++ stdlib/source/library/lux/world/input/keyboard.lux | 112 + stdlib/source/library/lux/world/net.lux | 13 + stdlib/source/library/lux/world/net/http.lux | 80 + .../source/library/lux/world/net/http/client.lux | 227 + .../source/library/lux/world/net/http/cookie.lux | 88 + .../source/library/lux/world/net/http/header.lux | 35 + stdlib/source/library/lux/world/net/http/mime.lux | 100 + stdlib/source/library/lux/world/net/http/query.lux | 65 + .../source/library/lux/world/net/http/request.lux | 128 + .../source/library/lux/world/net/http/response.lux | 74 + stdlib/source/library/lux/world/net/http/route.lux | 74 + .../source/library/lux/world/net/http/status.lux | 83 + .../source/library/lux/world/net/http/version.lux | 13 + stdlib/source/library/lux/world/net/uri.lux | 9 + .../library/lux/world/output/video/resolution.lux | 47 + stdlib/source/library/lux/world/program.lux | 451 ++ .../library/lux/world/service/authentication.lux | 25 + stdlib/source/library/lux/world/service/crud.lux | 33 + .../source/library/lux/world/service/inventory.lux | 31 + .../source/library/lux/world/service/journal.lux | 51 + stdlib/source/library/lux/world/service/mail.lux | 19 + stdlib/source/library/lux/world/shell.lux | 374 ++ stdlib/source/lux.lux | 5953 ------------------- stdlib/source/lux/abstract/algebra.lux | 16 - stdlib/source/lux/abstract/apply.lux | 36 - stdlib/source/lux/abstract/codec.lux | 28 - stdlib/source/lux/abstract/comonad.lux | 78 - stdlib/source/lux/abstract/comonad/cofree.lux | 27 - stdlib/source/lux/abstract/enum.lux | 25 - stdlib/source/lux/abstract/equivalence.lux | 24 - stdlib/source/lux/abstract/fold.lux | 16 - stdlib/source/lux/abstract/functor.lux | 44 - .../source/lux/abstract/functor/contravariant.lux | 8 - stdlib/source/lux/abstract/hash.lux | 26 - stdlib/source/lux/abstract/interval.lux | 193 - stdlib/source/lux/abstract/monad.lux | 183 - stdlib/source/lux/abstract/monad/free.lux | 67 - stdlib/source/lux/abstract/monad/indexed.lux | 83 - stdlib/source/lux/abstract/monoid.lux | 20 - stdlib/source/lux/abstract/order.lux | 57 - stdlib/source/lux/abstract/predicate.lux | 60 - stdlib/source/lux/control/concatenative.lux | 330 -- stdlib/source/lux/control/concurrency/actor.lux | 389 -- stdlib/source/lux/control/concurrency/atom.lux | 102 - stdlib/source/lux/control/concurrency/frp.lux | 295 - stdlib/source/lux/control/concurrency/promise.lux | 199 - .../source/lux/control/concurrency/semaphore.lux | 173 - stdlib/source/lux/control/concurrency/stm.lux | 273 - stdlib/source/lux/control/concurrency/thread.lux | 169 - stdlib/source/lux/control/continuation.lux | 99 - stdlib/source/lux/control/exception.lux | 183 - stdlib/source/lux/control/function.lux | 46 - stdlib/source/lux/control/function/contract.lux | 51 - stdlib/source/lux/control/function/memo.lux | 63 - stdlib/source/lux/control/function/mixin.lux | 63 - stdlib/source/lux/control/function/mutual.lux | 157 - stdlib/source/lux/control/io.lux | 71 - stdlib/source/lux/control/parser.lux | 323 -- stdlib/source/lux/control/parser/analysis.lux | 134 - stdlib/source/lux/control/parser/binary.lux | 274 - stdlib/source/lux/control/parser/cli.lux | 98 - stdlib/source/lux/control/parser/code.lux | 198 - stdlib/source/lux/control/parser/environment.lux | 43 - stdlib/source/lux/control/parser/json.lux | 206 - stdlib/source/lux/control/parser/synthesis.lux | 163 - stdlib/source/lux/control/parser/text.lux | 376 -- stdlib/source/lux/control/parser/tree.lux | 59 - stdlib/source/lux/control/parser/type.lux | 348 -- stdlib/source/lux/control/parser/xml.lux | 141 - stdlib/source/lux/control/pipe.lux | 160 - stdlib/source/lux/control/reader.lux | 71 - stdlib/source/lux/control/region.lux | 157 - stdlib/source/lux/control/remember.lux | 73 - stdlib/source/lux/control/security/capability.lux | 70 - stdlib/source/lux/control/security/policy.lux | 92 - stdlib/source/lux/control/state.lux | 148 - stdlib/source/lux/control/thread.lux | 105 - stdlib/source/lux/control/try.lux | 151 - stdlib/source/lux/control/writer.lux | 77 - stdlib/source/lux/data/binary.lux | 366 -- stdlib/source/lux/data/bit.lux | 58 - stdlib/source/lux/data/collection/array.lux | 387 -- stdlib/source/lux/data/collection/bits.lux | 176 - stdlib/source/lux/data/collection/dictionary.lux | 731 --- .../lux/data/collection/dictionary/ordered.lux | 583 -- .../lux/data/collection/dictionary/plist.lux | 97 - stdlib/source/lux/data/collection/list.lux | 615 -- stdlib/source/lux/data/collection/queue.lux | 92 - .../source/lux/data/collection/queue/priority.lux | 120 - stdlib/source/lux/data/collection/row.lux | 489 -- stdlib/source/lux/data/collection/sequence.lux | 150 - stdlib/source/lux/data/collection/set.lux | 104 - stdlib/source/lux/data/collection/set/multi.lux | 157 - stdlib/source/lux/data/collection/set/ordered.lux | 84 - stdlib/source/lux/data/collection/stack.lux | 65 - stdlib/source/lux/data/collection/tree.lux | 84 - stdlib/source/lux/data/collection/tree/finger.lux | 107 - stdlib/source/lux/data/collection/tree/zipper.lux | 317 -- stdlib/source/lux/data/color.lux | 424 -- stdlib/source/lux/data/color/named.lux | 155 - stdlib/source/lux/data/format/binary.lux | 291 - stdlib/source/lux/data/format/css.lux | 125 - stdlib/source/lux/data/format/css/font.lux | 25 - stdlib/source/lux/data/format/css/property.lux | 502 -- stdlib/source/lux/data/format/css/query.lux | 134 - stdlib/source/lux/data/format/css/selector.lux | 204 - stdlib/source/lux/data/format/css/style.lux | 35 - stdlib/source/lux/data/format/css/value.lux | 1328 ----- stdlib/source/lux/data/format/html.lux | 562 -- stdlib/source/lux/data/format/json.lux | 421 -- stdlib/source/lux/data/format/markdown.lux | 180 - stdlib/source/lux/data/format/tar.lux | 870 --- stdlib/source/lux/data/format/xml.lux | 298 - stdlib/source/lux/data/identity.lux | 37 - stdlib/source/lux/data/lazy.lux | 67 - stdlib/source/lux/data/maybe.lux | 150 - stdlib/source/lux/data/name.lux | 63 - stdlib/source/lux/data/product.lux | 68 - stdlib/source/lux/data/store.lux | 49 - stdlib/source/lux/data/sum.lux | 89 - stdlib/source/lux/data/text.lux | 379 -- stdlib/source/lux/data/text/buffer.lux | 114 - stdlib/source/lux/data/text/encoding.lux | 162 - stdlib/source/lux/data/text/encoding/utf8.lux | 163 - stdlib/source/lux/data/text/escape.lux | 243 - stdlib/source/lux/data/text/format.lux | 134 - stdlib/source/lux/data/text/regex.lux | 494 -- stdlib/source/lux/data/text/unicode/block.lux | 204 - stdlib/source/lux/data/text/unicode/set.lux | 239 - stdlib/source/lux/data/trace.lux | 35 - stdlib/source/lux/debug.lux | 597 -- stdlib/source/lux/extension.lux | 88 - stdlib/source/lux/ffi.js.lux | 363 -- stdlib/source/lux/ffi.jvm.lux | 2047 ------- stdlib/source/lux/ffi.lua.lux | 309 - stdlib/source/lux/ffi.old.lux | 1828 ------ stdlib/source/lux/ffi.php.lux | 313 - stdlib/source/lux/ffi.py.lux | 314 -- stdlib/source/lux/ffi.rb.lux | 331 -- stdlib/source/lux/ffi.scm.lux | 219 - stdlib/source/lux/locale.lux | 44 - stdlib/source/lux/locale/language.lux | 572 -- stdlib/source/lux/locale/territory.lux | 311 - stdlib/source/lux/macro.lux | 209 - stdlib/source/lux/macro/code.lux | 160 - stdlib/source/lux/macro/local.lux | 105 - stdlib/source/lux/macro/poly.lux | 127 - stdlib/source/lux/macro/syntax.lux | 128 - stdlib/source/lux/macro/syntax/annotations.lux | 41 - stdlib/source/lux/macro/syntax/check.lux | 41 - stdlib/source/lux/macro/syntax/declaration.lux | 46 - stdlib/source/lux/macro/syntax/definition.lux | 140 - stdlib/source/lux/macro/syntax/export.lux | 20 - stdlib/source/lux/macro/syntax/input.lux | 37 - stdlib/source/lux/macro/syntax/type/variable.lux | 27 - stdlib/source/lux/macro/template.lux | 184 - stdlib/source/lux/math.lux | 393 -- stdlib/source/lux/math/infix.lux | 95 - stdlib/source/lux/math/logic/continuous.lux | 39 - stdlib/source/lux/math/logic/fuzzy.lux | 131 - stdlib/source/lux/math/modular.lux | 156 - stdlib/source/lux/math/modulus.lux | 55 - stdlib/source/lux/math/number.lux | 86 - stdlib/source/lux/math/number/complex.lux | 315 -- stdlib/source/lux/math/number/frac.lux | 446 -- stdlib/source/lux/math/number/i16.lux | 23 - stdlib/source/lux/math/number/i32.lux | 23 - stdlib/source/lux/math/number/i64.lux | 213 - stdlib/source/lux/math/number/i8.lux | 23 - stdlib/source/lux/math/number/int.lux | 259 - stdlib/source/lux/math/number/nat.lux | 379 -- stdlib/source/lux/math/number/ratio.lux | 161 - stdlib/source/lux/math/number/rev.lux | 462 -- stdlib/source/lux/math/random.lux | 399 -- stdlib/source/lux/meta.lux | 567 -- stdlib/source/lux/meta/annotation.lux | 94 - stdlib/source/lux/meta/location.lux | 48 - stdlib/source/lux/program.lux | 82 - stdlib/source/lux/target.lux | 25 - stdlib/source/lux/target/common_lisp.lux | 468 -- stdlib/source/lux/target/js.lux | 448 -- stdlib/source/lux/target/jvm.lux | 283 - stdlib/source/lux/target/jvm/attribute.lux | 122 - stdlib/source/lux/target/jvm/attribute/code.lux | 82 - .../lux/target/jvm/attribute/code/exception.lux | 57 - .../source/lux/target/jvm/attribute/constant.lux | 26 - stdlib/source/lux/target/jvm/bytecode.lux | 1045 ---- stdlib/source/lux/target/jvm/bytecode/address.lux | 73 - .../source/lux/target/jvm/bytecode/environment.lux | 107 - .../lux/target/jvm/bytecode/environment/limit.lux | 57 - .../jvm/bytecode/environment/limit/registry.lux | 90 - .../jvm/bytecode/environment/limit/stack.lux | 68 - .../source/lux/target/jvm/bytecode/instruction.lux | 713 --- stdlib/source/lux/target/jvm/bytecode/jump.lux | 26 - stdlib/source/lux/target/jvm/class.lux | 133 - stdlib/source/lux/target/jvm/constant.lux | 245 - stdlib/source/lux/target/jvm/constant/pool.lux | 157 - stdlib/source/lux/target/jvm/constant/tag.lux | 49 - stdlib/source/lux/target/jvm/encoding/name.lux | 39 - stdlib/source/lux/target/jvm/encoding/signed.lux | 106 - stdlib/source/lux/target/jvm/encoding/unsigned.lux | 120 - stdlib/source/lux/target/jvm/field.lux | 69 - stdlib/source/lux/target/jvm/index.lux | 37 - stdlib/source/lux/target/jvm/loader.lux | 142 - stdlib/source/lux/target/jvm/magic.lux | 19 - stdlib/source/lux/target/jvm/method.lux | 103 - stdlib/source/lux/target/jvm/modifier.lux | 87 - stdlib/source/lux/target/jvm/modifier/inner.lux | 20 - stdlib/source/lux/target/jvm/reflection.lux | 381 -- stdlib/source/lux/target/jvm/type.lux | 204 - stdlib/source/lux/target/jvm/type/alias.lux | 115 - stdlib/source/lux/target/jvm/type/box.lux | 18 - stdlib/source/lux/target/jvm/type/category.lux | 35 - stdlib/source/lux/target/jvm/type/descriptor.lux | 122 - stdlib/source/lux/target/jvm/type/lux.lux | 188 - stdlib/source/lux/target/jvm/type/parser.lux | 252 - stdlib/source/lux/target/jvm/type/reflection.lux | 103 - stdlib/source/lux/target/jvm/type/signature.lux | 133 - stdlib/source/lux/target/jvm/version.lux | 37 - stdlib/source/lux/target/lua.lux | 415 -- stdlib/source/lux/target/php.lux | 544 -- stdlib/source/lux/target/python.lux | 500 -- stdlib/source/lux/target/r.lux | 385 -- stdlib/source/lux/target/ruby.lux | 472 -- stdlib/source/lux/target/scheme.lux | 379 -- stdlib/source/lux/test.lux | 418 -- stdlib/source/lux/time.lux | 216 - stdlib/source/lux/time/date.lux | 348 -- stdlib/source/lux/time/day.lux | 120 - stdlib/source/lux/time/duration.lux | 202 - stdlib/source/lux/time/instant.lux | 234 - stdlib/source/lux/time/month.lux | 224 - stdlib/source/lux/time/year.lux | 141 - stdlib/source/lux/tool/compiler.lux | 46 - stdlib/source/lux/tool/compiler/arity.lux | 15 - stdlib/source/lux/tool/compiler/default/init.lux | 286 - .../source/lux/tool/compiler/default/platform.lux | 601 -- stdlib/source/lux/tool/compiler/language/lux.lux | 106 - .../lux/tool/compiler/language/lux/analysis.lux | 555 -- .../compiler/language/lux/analysis/evaluation.lux | 56 - .../tool/compiler/language/lux/analysis/macro.lux | 51 - .../lux/tool/compiler/language/lux/directive.lux | 82 - .../lux/tool/compiler/language/lux/generation.lux | 335 -- .../tool/compiler/language/lux/phase/analysis.lux | 143 - .../compiler/language/lux/phase/analysis/case.lux | 324 -- .../language/lux/phase/analysis/case/coverage.lux | 372 -- .../language/lux/phase/analysis/function.lux | 112 - .../language/lux/phase/analysis/inference.lux | 300 - .../language/lux/phase/analysis/module.lux | 274 - .../language/lux/phase/analysis/primitive.lux | 32 - .../language/lux/phase/analysis/reference.lux | 84 - .../compiler/language/lux/phase/analysis/scope.lux | 205 - .../language/lux/phase/analysis/structure.lux | 360 -- .../compiler/language/lux/phase/analysis/type.lux | 55 - .../tool/compiler/language/lux/phase/directive.lux | 78 - .../tool/compiler/language/lux/phase/extension.lux | 176 - .../language/lux/phase/extension/analysis.lux | 15 - .../lux/phase/extension/analysis/common_lisp.lux | 34 - .../language/lux/phase/extension/analysis/js.lux | 217 - .../language/lux/phase/extension/analysis/jvm.lux | 2075 ------- .../language/lux/phase/extension/analysis/lua.lux | 251 - .../language/lux/phase/extension/analysis/lux.lux | 300 - .../language/lux/phase/extension/analysis/php.lux | 213 - .../lux/phase/extension/analysis/python.lux | 230 - .../language/lux/phase/extension/analysis/r.lux | 34 - .../language/lux/phase/extension/analysis/ruby.lux | 198 - .../lux/phase/extension/analysis/scheme.lux | 157 - .../language/lux/phase/extension/bundle.lux | 28 - .../language/lux/phase/extension/directive/jvm.lux | 306 - .../language/lux/phase/extension/directive/lux.lux | 450 -- .../lux/phase/extension/generation/common_lisp.lux | 17 - .../extension/generation/common_lisp/common.lux | 179 - .../extension/generation/common_lisp/host.lux | 39 - .../language/lux/phase/extension/generation/js.lux | 17 - .../lux/phase/extension/generation/js/common.lux | 190 - .../lux/phase/extension/generation/js/host.lux | 159 - .../lux/phase/extension/generation/jvm.lux | 19 - .../lux/phase/extension/generation/jvm/common.lux | 413 -- .../lux/phase/extension/generation/jvm/host.lux | 1105 ---- .../lux/phase/extension/generation/lua.lux | 17 - .../lux/phase/extension/generation/lua/common.lux | 180 - .../lux/phase/extension/generation/lua/host.lux | 199 - .../lux/phase/extension/generation/php.lux | 17 - .../lux/phase/extension/generation/php/common.lux | 191 - .../lux/phase/extension/generation/php/host.lux | 142 - .../lux/phase/extension/generation/python.lux | 17 - .../phase/extension/generation/python/common.lux | 170 - .../lux/phase/extension/generation/python/host.lux | 164 - .../language/lux/phase/extension/generation/r.lux | 17 - .../lux/phase/extension/generation/r/common.lux | 178 - .../lux/phase/extension/generation/r/host.lux | 39 - .../lux/phase/extension/generation/ruby.lux | 17 - .../lux/phase/extension/generation/ruby/common.lux | 185 - .../lux/phase/extension/generation/ruby/host.lux | 135 - .../lux/phase/extension/generation/scheme.lux | 17 - .../phase/extension/generation/scheme/common.lux | 174 - .../lux/phase/extension/generation/scheme/host.lux | 108 - .../language/lux/phase/extension/synthesis.lux | 10 - .../language/lux/phase/generation/common_lisp.lux | 56 - .../lux/phase/generation/common_lisp/case.lux | 261 - .../lux/phase/generation/common_lisp/extension.lux | 13 - .../generation/common_lisp/extension/common.lux | 136 - .../lux/phase/generation/common_lisp/function.lux | 102 - .../lux/phase/generation/common_lisp/loop.lux | 69 - .../lux/phase/generation/common_lisp/primitive.lux | 20 - .../lux/phase/generation/common_lisp/reference.lux | 12 - .../lux/phase/generation/common_lisp/runtime.lux | 292 - .../lux/phase/generation/common_lisp/structure.lux | 36 - .../language/lux/phase/generation/extension.lux | 65 - .../compiler/language/lux/phase/generation/js.lux | 116 - .../language/lux/phase/generation/js/case.lux | 321 -- .../language/lux/phase/generation/js/function.lux | 122 - .../language/lux/phase/generation/js/loop.lux | 90 - .../language/lux/phase/generation/js/primitive.lux | 20 - .../language/lux/phase/generation/js/reference.lux | 12 - .../language/lux/phase/generation/js/runtime.lux | 784 --- .../language/lux/phase/generation/js/structure.lux | 37 - .../compiler/language/lux/phase/generation/jvm.lux | 72 - .../language/lux/phase/generation/jvm/case.lux | 265 - .../language/lux/phase/generation/jvm/debug.lux | 30 - .../language/lux/phase/generation/jvm/function.lux | 134 - .../lux/phase/generation/jvm/function/abstract.lux | 23 - .../generation/jvm/function/field/constant.lux | 25 - .../jvm/function/field/constant/arity.lux | 21 - .../generation/jvm/function/field/variable.lux | 55 - .../jvm/function/field/variable/foreign.lux | 39 - .../jvm/function/field/variable/partial.lux | 58 - .../jvm/function/field/variable/partial/count.lux | 30 - .../lux/phase/generation/jvm/function/method.lux | 13 - .../phase/generation/jvm/function/method/apply.lux | 156 - .../jvm/function/method/implementation.lux | 41 - .../phase/generation/jvm/function/method/init.lux | 97 - .../phase/generation/jvm/function/method/new.lux | 80 - .../phase/generation/jvm/function/method/reset.lux | 49 - .../language/lux/phase/generation/jvm/host.lux | 160 - .../language/lux/phase/generation/jvm/loop.lux | 89 - .../lux/phase/generation/jvm/primitive.lux | 120 - .../language/lux/phase/generation/jvm/program.lux | 143 - .../lux/phase/generation/jvm/reference.lux | 66 - .../language/lux/phase/generation/jvm/runtime.lux | 610 -- .../lux/phase/generation/jvm/structure.lux | 94 - .../language/lux/phase/generation/jvm/type.lux | 22 - .../language/lux/phase/generation/jvm/value.lux | 48 - .../compiler/language/lux/phase/generation/lua.lux | 118 - .../language/lux/phase/generation/lua/case.lux | 279 - .../language/lux/phase/generation/lua/function.lux | 136 - .../language/lux/phase/generation/lua/loop.lux | 118 - .../lux/phase/generation/lua/primitive.lux | 15 - .../lux/phase/generation/lua/reference.lux | 12 - .../language/lux/phase/generation/lua/runtime.lux | 431 -- .../lux/phase/generation/lua/structure.lux | 36 - .../compiler/language/lux/phase/generation/php.lux | 102 - .../language/lux/phase/generation/php/case.lux | 297 - .../lux/phase/generation/php/extension.lux | 13 - .../lux/phase/generation/php/extension/common.lux | 111 - .../language/lux/phase/generation/php/function.lux | 115 - .../language/lux/phase/generation/php/loop.lux | 121 - .../lux/phase/generation/php/primitive.lux | 31 - .../lux/phase/generation/php/reference.lux | 12 - .../language/lux/phase/generation/php/runtime.lux | 609 -- .../lux/phase/generation/php/structure.lux | 41 - .../language/lux/phase/generation/python.lux | 112 - .../language/lux/phase/generation/python/case.lux | 317 -- .../lux/phase/generation/python/function.lux | 111 - .../language/lux/phase/generation/python/loop.lux | 121 - .../lux/phase/generation/python/primitive.lux | 17 - .../lux/phase/generation/python/reference.lux | 12 - .../lux/phase/generation/python/runtime.lux | 455 -- .../lux/phase/generation/python/structure.lux | 36 - .../compiler/language/lux/phase/generation/r.lux | 58 - .../language/lux/phase/generation/r/case.lux | 239 - .../language/lux/phase/generation/r/function.lux | 116 - .../language/lux/phase/generation/r/loop.lux | 64 - .../language/lux/phase/generation/r/primitive.lux | 17 - .../lux/phase/generation/r/procedure/common.lux | 339 -- .../lux/phase/generation/r/procedure/host.lux | 89 - .../language/lux/phase/generation/r/reference.lux | 12 - .../language/lux/phase/generation/r/runtime.lux | 854 --- .../language/lux/phase/generation/r/structure.lux | 39 - .../language/lux/phase/generation/reference.lux | 88 - .../language/lux/phase/generation/ruby.lux | 104 - .../language/lux/phase/generation/ruby/case.lux | 311 - .../lux/phase/generation/ruby/function.lux | 111 - .../language/lux/phase/generation/ruby/loop.lux | 95 - .../lux/phase/generation/ruby/primitive.lux | 15 - .../lux/phase/generation/ruby/reference.lux | 12 - .../language/lux/phase/generation/ruby/runtime.lux | 402 -- .../lux/phase/generation/ruby/structure.lux | 36 - .../language/lux/phase/generation/scheme.lux | 58 - .../language/lux/phase/generation/scheme/case.lux | 222 - .../lux/phase/generation/scheme/extension.lux | 13 - .../phase/generation/scheme/extension/common.lux | 222 - .../lux/phase/generation/scheme/function.lux | 100 - .../language/lux/phase/generation/scheme/loop.lux | 63 - .../lux/phase/generation/scheme/primitive.lux | 15 - .../lux/phase/generation/scheme/reference.lux | 12 - .../lux/phase/generation/scheme/runtime.lux | 369 -- .../lux/phase/generation/scheme/structure.lux | 39 - .../tool/compiler/language/lux/phase/synthesis.lux | 103 - .../compiler/language/lux/phase/synthesis/case.lux | 429 -- .../language/lux/phase/synthesis/function.lux | 276 - .../compiler/language/lux/phase/synthesis/loop.lux | 186 - .../language/lux/phase/synthesis/variable.lux | 442 -- .../lux/tool/compiler/language/lux/program.lux | 56 - .../lux/tool/compiler/language/lux/syntax.lux | 582 -- .../lux/tool/compiler/language/lux/synthesis.lux | 808 --- .../lux/tool/compiler/language/lux/version.lux | 8 - stdlib/source/lux/tool/compiler/meta.lux | 8 - stdlib/source/lux/tool/compiler/meta/archive.lux | 279 - .../lux/tool/compiler/meta/archive/artifact.lux | 154 - .../lux/tool/compiler/meta/archive/descriptor.lux | 48 - .../lux/tool/compiler/meta/archive/document.lux | 71 - .../source/lux/tool/compiler/meta/archive/key.lux | 18 - .../lux/tool/compiler/meta/archive/signature.lux | 41 - .../lux/tool/compiler/meta/cache/dependency.lux | 96 - stdlib/source/lux/tool/compiler/meta/io.lux | 19 - .../source/lux/tool/compiler/meta/io/archive.lux | 449 -- .../source/lux/tool/compiler/meta/io/context.lux | 169 - stdlib/source/lux/tool/compiler/meta/packager.lux | 42 - .../source/lux/tool/compiler/meta/packager/jvm.lux | 144 - .../lux/tool/compiler/meta/packager/scheme.lux | 131 - .../lux/tool/compiler/meta/packager/script.lux | 75 - stdlib/source/lux/tool/compiler/phase.lux | 118 - stdlib/source/lux/tool/compiler/reference.lux | 84 - .../lux/tool/compiler/reference/variable.lux | 67 - stdlib/source/lux/tool/compiler/version.lux | 51 - stdlib/source/lux/tool/interpreter.lux | 221 - stdlib/source/lux/tool/mediator.lux | 18 - stdlib/source/lux/type.lux | 462 -- stdlib/source/lux/type/abstract.lux | 268 - stdlib/source/lux/type/check.lux | 720 --- stdlib/source/lux/type/dynamic.lux | 50 - stdlib/source/lux/type/implicit.lux | 400 -- stdlib/source/lux/type/quotient.lux | 55 - stdlib/source/lux/type/refinement.lux | 88 - stdlib/source/lux/type/resource.lux | 217 - stdlib/source/lux/type/unit.lux | 188 - stdlib/source/lux/type/variance.lux | 11 - stdlib/source/lux/world/console.lux | 158 - stdlib/source/lux/world/db/jdbc.lux | 175 - stdlib/source/lux/world/db/jdbc/input.lux | 106 - stdlib/source/lux/world/db/jdbc/output.lux | 194 - stdlib/source/lux/world/db/sql.lux | 475 -- stdlib/source/lux/world/file.lux | 1302 ----- stdlib/source/lux/world/file/watch.lux | 458 -- stdlib/source/lux/world/input/keyboard.lux | 111 - stdlib/source/lux/world/net.lux | 12 - stdlib/source/lux/world/net/http.lux | 79 - stdlib/source/lux/world/net/http/client.lux | 226 - stdlib/source/lux/world/net/http/cookie.lux | 87 - stdlib/source/lux/world/net/http/header.lux | 34 - stdlib/source/lux/world/net/http/mime.lux | 99 - stdlib/source/lux/world/net/http/query.lux | 64 - stdlib/source/lux/world/net/http/request.lux | 127 - stdlib/source/lux/world/net/http/response.lux | 73 - stdlib/source/lux/world/net/http/route.lux | 73 - stdlib/source/lux/world/net/http/status.lux | 82 - stdlib/source/lux/world/net/http/version.lux | 12 - stdlib/source/lux/world/net/uri.lux | 8 - .../source/lux/world/output/video/resolution.lux | 46 - stdlib/source/lux/world/program.lux | 450 -- stdlib/source/lux/world/service/authentication.lux | 24 - stdlib/source/lux/world/service/crud.lux | 32 - stdlib/source/lux/world/service/inventory.lux | 30 - stdlib/source/lux/world/service/journal.lux | 50 - stdlib/source/lux/world/service/mail.lux | 18 - stdlib/source/lux/world/shell.lux | 373 -- stdlib/source/poly/lux/abstract/equivalence.lux | 81 +- stdlib/source/poly/lux/abstract/functor.lux | 45 +- stdlib/source/poly/lux/data/format/json.lux | 83 +- stdlib/source/program/aedifex.lux | 81 +- stdlib/source/program/aedifex/action.lux | 15 +- stdlib/source/program/aedifex/artifact.lux | 31 +- .../source/program/aedifex/artifact/extension.lux | 13 +- .../source/program/aedifex/artifact/snapshot.lux | 25 +- .../program/aedifex/artifact/snapshot/build.lux | 33 +- .../program/aedifex/artifact/snapshot/stamp.lux | 25 +- .../program/aedifex/artifact/snapshot/time.lux | 33 +- .../program/aedifex/artifact/snapshot/version.lux | 27 +- .../aedifex/artifact/snapshot/version/value.lux | 15 +- stdlib/source/program/aedifex/artifact/time.lux | 31 +- .../source/program/aedifex/artifact/time/date.lux | 45 +- .../source/program/aedifex/artifact/time/time.lux | 27 +- stdlib/source/program/aedifex/artifact/type.lux | 3 +- .../source/program/aedifex/artifact/versioning.lux | 51 +- stdlib/source/program/aedifex/cli.lux | 21 +- stdlib/source/program/aedifex/command.lux | 3 +- stdlib/source/program/aedifex/command/auto.lux | 35 +- stdlib/source/program/aedifex/command/build.lux | 57 +- stdlib/source/program/aedifex/command/clean.lux | 27 +- stdlib/source/program/aedifex/command/deploy.lux | 55 +- stdlib/source/program/aedifex/command/deps.lux | 39 +- stdlib/source/program/aedifex/command/install.lux | 47 +- stdlib/source/program/aedifex/command/pom.lux | 35 +- stdlib/source/program/aedifex/command/test.lux | 35 +- stdlib/source/program/aedifex/command/version.lux | 25 +- stdlib/source/program/aedifex/dependency.lux | 19 +- .../program/aedifex/dependency/deployment.lux | 43 +- .../program/aedifex/dependency/resolution.lux | 77 +- .../source/program/aedifex/dependency/status.lux | 15 +- stdlib/source/program/aedifex/format.lux | 21 +- stdlib/source/program/aedifex/hash.lux | 41 +- stdlib/source/program/aedifex/input.lux | 45 +- stdlib/source/program/aedifex/local.lux | 15 +- stdlib/source/program/aedifex/metadata.lux | 17 +- .../source/program/aedifex/metadata/artifact.lux | 67 +- .../source/program/aedifex/metadata/snapshot.lux | 69 +- stdlib/source/program/aedifex/package.lux | 37 +- stdlib/source/program/aedifex/parser.lux | 37 +- stdlib/source/program/aedifex/pom.lux | 39 +- stdlib/source/program/aedifex/profile.lux | 49 +- stdlib/source/program/aedifex/project.lux | 31 +- stdlib/source/program/aedifex/repository.lux | 29 +- .../source/program/aedifex/repository/identity.lux | 21 +- stdlib/source/program/aedifex/repository/local.lux | 31 +- .../source/program/aedifex/repository/origin.lux | 19 +- .../source/program/aedifex/repository/remote.lux | 49 +- stdlib/source/program/aedifex/runtime.lux | 27 +- stdlib/source/program/compositor.lux | 101 +- stdlib/source/program/compositor/cli.lux | 25 +- stdlib/source/program/compositor/export.lux | 51 +- stdlib/source/program/compositor/import.lux | 53 +- stdlib/source/program/compositor/static.lux | 9 +- stdlib/source/program/scriptum.lux | 5 +- stdlib/source/spec/aedifex/repository.lux | 27 +- stdlib/source/spec/compositor/generation/case.lux | 4 +- stdlib/source/spec/lux/abstract/apply.lux | 23 +- stdlib/source/spec/lux/abstract/codec.lux | 19 +- stdlib/source/spec/lux/abstract/comonad.lux | 19 +- stdlib/source/spec/lux/abstract/enum.lux | 15 +- stdlib/source/spec/lux/abstract/equivalence.lux | 15 +- stdlib/source/spec/lux/abstract/fold.lux | 19 +- stdlib/source/spec/lux/abstract/functor.lux | 25 +- .../spec/lux/abstract/functor/contravariant.lux | 25 +- stdlib/source/spec/lux/abstract/hash.lux | 23 +- stdlib/source/spec/lux/abstract/interval.lux | 17 +- stdlib/source/spec/lux/abstract/monad.lux | 15 +- stdlib/source/spec/lux/abstract/monoid.lux | 15 +- stdlib/source/spec/lux/abstract/order.lux | 15 +- stdlib/source/spec/lux/world/console.lux | 31 +- stdlib/source/spec/lux/world/file.lux | 59 +- stdlib/source/spec/lux/world/program.lux | 33 +- stdlib/source/spec/lux/world/shell.lux | 41 +- stdlib/source/test/aedifex.lux | 11 +- stdlib/source/test/aedifex/artifact.lux | 37 +- stdlib/source/test/aedifex/artifact/extension.lux | 27 +- stdlib/source/test/aedifex/artifact/snapshot.lux | 25 +- .../test/aedifex/artifact/snapshot/build.lux | 25 +- .../test/aedifex/artifact/snapshot/stamp.lux | 29 +- .../source/test/aedifex/artifact/snapshot/time.lux | 25 +- .../test/aedifex/artifact/snapshot/version.lux | 25 +- .../aedifex/artifact/snapshot/version/value.lux | 41 +- stdlib/source/test/aedifex/artifact/time.lux | 29 +- stdlib/source/test/aedifex/artifact/time/date.lux | 33 +- stdlib/source/test/aedifex/artifact/time/time.lux | 29 +- stdlib/source/test/aedifex/artifact/type.lux | 27 +- stdlib/source/test/aedifex/artifact/versioning.lux | 25 +- stdlib/source/test/aedifex/cache.lux | 51 +- stdlib/source/test/aedifex/cli.lux | 31 +- stdlib/source/test/aedifex/command.lux | 5 +- stdlib/source/test/aedifex/command/auto.lux | 65 +- stdlib/source/test/aedifex/command/build.lux | 45 +- stdlib/source/test/aedifex/command/clean.lux | 45 +- stdlib/source/test/aedifex/command/deploy.lux | 57 +- stdlib/source/test/aedifex/command/deps.lux | 53 +- stdlib/source/test/aedifex/command/install.lux | 45 +- stdlib/source/test/aedifex/command/pom.lux | 39 +- stdlib/source/test/aedifex/command/test.lux | 45 +- stdlib/source/test/aedifex/command/version.lux | 47 +- stdlib/source/test/aedifex/dependency.lux | 17 +- .../source/test/aedifex/dependency/deployment.lux | 65 +- .../source/test/aedifex/dependency/resolution.lux | 55 +- stdlib/source/test/aedifex/dependency/status.lux | 15 +- stdlib/source/test/aedifex/hash.lux | 37 +- stdlib/source/test/aedifex/input.lux | 39 +- stdlib/source/test/aedifex/local.lux | 17 +- stdlib/source/test/aedifex/metadata.lux | 17 +- stdlib/source/test/aedifex/metadata/artifact.lux | 47 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 47 +- stdlib/source/test/aedifex/package.lux | 51 +- stdlib/source/test/aedifex/parser.lux | 45 +- stdlib/source/test/aedifex/pom.lux | 29 +- stdlib/source/test/aedifex/profile.lux | 45 +- stdlib/source/test/aedifex/project.lux | 35 +- stdlib/source/test/aedifex/repository.lux | 45 +- stdlib/source/test/aedifex/repository/identity.lux | 15 +- stdlib/source/test/aedifex/repository/local.lux | 41 +- stdlib/source/test/aedifex/repository/origin.lux | 15 +- stdlib/source/test/aedifex/repository/remote.lux | 53 +- stdlib/source/test/aedifex/runtime.lux | 29 +- stdlib/source/test/lux.lux | 49 +- stdlib/source/test/lux/abstract.lux | 5 +- stdlib/source/test/lux/abstract/apply.lux | 27 +- stdlib/source/test/lux/abstract/codec.lux | 27 +- stdlib/source/test/lux/abstract/comonad.lux | 23 +- stdlib/source/test/lux/abstract/comonad/cofree.lux | 35 +- stdlib/source/test/lux/abstract/enum.lux | 29 +- stdlib/source/test/lux/abstract/equivalence.lux | 31 +- stdlib/source/test/lux/abstract/fold.lux | 25 +- stdlib/source/test/lux/abstract/functor.lux | 27 +- .../test/lux/abstract/functor/contravariant.lux | 7 +- stdlib/source/test/lux/abstract/hash.lux | 29 +- stdlib/source/test/lux/abstract/interval.lux | 37 +- stdlib/source/test/lux/abstract/monad.lux | 23 +- stdlib/source/test/lux/abstract/monad/free.lux | 33 +- stdlib/source/test/lux/abstract/monoid.lux | 21 +- stdlib/source/test/lux/abstract/order.lux | 29 +- stdlib/source/test/lux/abstract/predicate.lux | 41 +- stdlib/source/test/lux/control.lux | 5 +- stdlib/source/test/lux/control/concatenative.lux | 37 +- .../source/test/lux/control/concurrency/actor.lux | 39 +- .../source/test/lux/control/concurrency/atom.lux | 23 +- stdlib/source/test/lux/control/concurrency/frp.lux | 43 +- .../test/lux/control/concurrency/promise.lux | 45 +- .../test/lux/control/concurrency/semaphore.lux | 55 +- stdlib/source/test/lux/control/concurrency/stm.lux | 39 +- .../source/test/lux/control/concurrency/thread.lux | 31 +- stdlib/source/test/lux/control/continuation.lux | 33 +- stdlib/source/test/lux/control/exception.lux | 25 +- stdlib/source/test/lux/control/function.lux | 29 +- .../source/test/lux/control/function/contract.lux | 23 +- stdlib/source/test/lux/control/function/memo.lux | 43 +- stdlib/source/test/lux/control/function/mixin.lux | 39 +- stdlib/source/test/lux/control/function/mutual.lux | 27 +- stdlib/source/test/lux/control/io.lux | 27 +- stdlib/source/test/lux/control/parser.lux | 53 +- stdlib/source/test/lux/control/parser/analysis.lux | 61 +- stdlib/source/test/lux/control/parser/binary.lux | 79 +- stdlib/source/test/lux/control/parser/cli.lux | 33 +- stdlib/source/test/lux/control/parser/code.lux | 49 +- .../source/test/lux/control/parser/environment.lux | 33 +- stdlib/source/test/lux/control/parser/json.lux | 53 +- .../source/test/lux/control/parser/synthesis.lux | 61 +- stdlib/source/test/lux/control/parser/text.lux | 55 +- stdlib/source/test/lux/control/parser/tree.lux | 33 +- stdlib/source/test/lux/control/parser/type.lux | 35 +- stdlib/source/test/lux/control/parser/xml.lux | 47 +- stdlib/source/test/lux/control/pipe.lux | 29 +- stdlib/source/test/lux/control/reader.lux | 27 +- stdlib/source/test/lux/control/region.lux | 47 +- stdlib/source/test/lux/control/remember.lux | 53 +- .../test/lux/control/security/capability.lux | 27 +- stdlib/source/test/lux/control/security/policy.lux | 33 +- stdlib/source/test/lux/control/state.lux | 37 +- stdlib/source/test/lux/control/thread.lux | 27 +- stdlib/source/test/lux/control/try.lux | 39 +- stdlib/source/test/lux/control/writer.lux | 41 +- stdlib/source/test/lux/data.lux | 65 +- stdlib/source/test/lux/data/binary.lux | 41 +- stdlib/source/test/lux/data/bit.lux | 29 +- stdlib/source/test/lux/data/collection.lux | 5 +- stdlib/source/test/lux/data/collection/array.lux | 41 +- stdlib/source/test/lux/data/collection/bits.lux | 25 +- .../source/test/lux/data/collection/dictionary.lux | 43 +- .../lux/data/collection/dictionary/ordered.lux | 41 +- .../test/lux/data/collection/dictionary/plist.lux | 37 +- stdlib/source/test/lux/data/collection/list.lux | 61 +- stdlib/source/test/lux/data/collection/queue.lux | 35 +- .../test/lux/data/collection/queue/priority.lux | 25 +- stdlib/source/test/lux/data/collection/row.lux | 49 +- .../source/test/lux/data/collection/sequence.lux | 39 +- stdlib/source/test/lux/data/collection/set.lux | 37 +- .../source/test/lux/data/collection/set/multi.lux | 39 +- .../test/lux/data/collection/set/ordered.lux | 33 +- stdlib/source/test/lux/data/collection/stack.lux | 31 +- stdlib/source/test/lux/data/collection/tree.lux | 35 +- .../test/lux/data/collection/tree/finger.lux | 31 +- .../test/lux/data/collection/tree/zipper.lux | 43 +- stdlib/source/test/lux/data/color.lux | 43 +- stdlib/source/test/lux/data/color/named.lux | 31 +- stdlib/source/test/lux/data/format/binary.lux | 25 +- stdlib/source/test/lux/data/format/json.lux | 59 +- stdlib/source/test/lux/data/format/tar.lux | 69 +- stdlib/source/test/lux/data/format/xml.lux | 51 +- stdlib/source/test/lux/data/identity.lux | 21 +- stdlib/source/test/lux/data/lazy.lux | 33 +- stdlib/source/test/lux/data/maybe.lux | 47 +- stdlib/source/test/lux/data/name.lux | 46 +- stdlib/source/test/lux/data/product.lux | 25 +- stdlib/source/test/lux/data/sum.lux | 37 +- stdlib/source/test/lux/data/text.lux | 43 +- stdlib/source/test/lux/data/text/buffer.lux | 25 +- stdlib/source/test/lux/data/text/encoding.lux | 43 +- stdlib/source/test/lux/data/text/encoding/utf8.lux | 21 +- stdlib/source/test/lux/data/text/escape.lux | 53 +- stdlib/source/test/lux/data/text/format.lux | 175 +- stdlib/source/test/lux/data/text/regex.lux | 39 +- stdlib/source/test/lux/data/text/unicode/block.lux | 41 +- stdlib/source/test/lux/data/text/unicode/set.lux | 33 +- stdlib/source/test/lux/debug.lux | 61 +- stdlib/source/test/lux/extension.lux | 85 +- stdlib/source/test/lux/ffi.js.lux | 31 +- stdlib/source/test/lux/ffi.jvm.lux | 51 +- stdlib/source/test/lux/ffi.lua.lux | 29 +- stdlib/source/test/lux/ffi.old.lux | 41 +- stdlib/source/test/lux/ffi.php.lux | 29 +- stdlib/source/test/lux/ffi.py.lux | 71 +- stdlib/source/test/lux/ffi.rb.lux | 29 +- stdlib/source/test/lux/ffi.scm.lux | 29 +- stdlib/source/test/lux/locale.lux | 31 +- stdlib/source/test/lux/locale/language.lux | 58 +- stdlib/source/test/lux/locale/territory.lux | 41 +- stdlib/source/test/lux/macro.lux | 45 +- stdlib/source/test/lux/macro/code.lux | 51 +- stdlib/source/test/lux/macro/local.lux | 51 +- stdlib/source/test/lux/macro/poly.lux | 7 +- stdlib/source/test/lux/macro/poly/equivalence.lux | 47 +- stdlib/source/test/lux/macro/poly/functor.lux | 31 +- stdlib/source/test/lux/macro/poly/json.lux | 89 +- stdlib/source/test/lux/macro/syntax.lux | 19 +- .../source/test/lux/macro/syntax/annotations.lux | 37 +- stdlib/source/test/lux/macro/syntax/check.lux | 31 +- .../source/test/lux/macro/syntax/declaration.lux | 31 +- stdlib/source/test/lux/macro/syntax/definition.lux | 37 +- stdlib/source/test/lux/macro/syntax/export.lux | 27 +- stdlib/source/test/lux/macro/syntax/input.lux | 31 +- .../source/test/lux/macro/syntax/type/variable.lux | 27 +- stdlib/source/test/lux/macro/template.lux | 37 +- stdlib/source/test/lux/math.lux | 27 +- stdlib/source/test/lux/math/infix.lux | 25 +- stdlib/source/test/lux/math/logic/continuous.lux | 23 +- stdlib/source/test/lux/math/logic/fuzzy.lux | 39 +- stdlib/source/test/lux/math/modular.lux | 45 +- stdlib/source/test/lux/math/modulus.lux | 33 +- stdlib/source/test/lux/math/number.lux | 15 +- stdlib/source/test/lux/math/number/complex.lux | 31 +- stdlib/source/test/lux/math/number/frac.lux | 35 +- stdlib/source/test/lux/math/number/i16.lux | 19 +- stdlib/source/test/lux/math/number/i32.lux | 19 +- stdlib/source/test/lux/math/number/i64.lux | 27 +- stdlib/source/test/lux/math/number/i8.lux | 19 +- stdlib/source/test/lux/math/number/int.lux | 35 +- stdlib/source/test/lux/math/number/nat.lux | 35 +- stdlib/source/test/lux/math/number/ratio.lux | 31 +- stdlib/source/test/lux/math/number/rev.lux | 35 +- stdlib/source/test/lux/meta.lux | 59 +- stdlib/source/test/lux/meta/annotation.lux | 51 +- stdlib/source/test/lux/meta/location.lux | 23 +- stdlib/source/test/lux/program.lux | 39 +- stdlib/source/test/lux/target.lux | 23 +- stdlib/source/test/lux/target/jvm.lux | 69 +- stdlib/source/test/lux/test.lux | 37 +- stdlib/source/test/lux/time.lux | 47 +- stdlib/source/test/lux/time/date.lux | 47 +- stdlib/source/test/lux/time/day.lux | 31 +- stdlib/source/test/lux/time/duration.lux | 37 +- stdlib/source/test/lux/time/instant.lux | 45 +- stdlib/source/test/lux/time/month.lux | 47 +- stdlib/source/test/lux/time/year.lux | 43 +- stdlib/source/test/lux/tool.lux | 5 +- stdlib/source/test/lux/type.lux | 60 +- stdlib/source/test/lux/type/abstract.lux | 39 +- stdlib/source/test/lux/type/check.lux | 57 +- stdlib/source/test/lux/type/dynamic.lux | 31 +- stdlib/source/test/lux/type/implicit.lux | 35 +- stdlib/source/test/lux/type/quotient.lux | 29 +- stdlib/source/test/lux/type/refinement.lux | 29 +- stdlib/source/test/lux/type/resource.lux | 47 +- stdlib/source/test/lux/type/unit.lux | 41 +- stdlib/source/test/lux/type/variance.lux | 15 +- stdlib/source/test/lux/world.lux | 5 +- stdlib/source/test/lux/world/console.lux | 29 +- stdlib/source/test/lux/world/file.lux | 19 +- stdlib/source/test/lux/world/file/watch.lux | 39 +- stdlib/source/test/lux/world/input/keyboard.lux | 35 +- stdlib/source/test/lux/world/net/http/client.lux | 55 +- stdlib/source/test/lux/world/net/http/status.lux | 25 +- .../test/lux/world/output/video/resolution.lux | 35 +- stdlib/source/test/lux/world/program.lux | 74 +- stdlib/source/test/lux/world/shell.lux | 45 +- 1231 files changed, 96351 insertions(+), 95357 deletions(-) create mode 120000 lux-php/source/lux.lux create mode 100644 stdlib/source/library/lux.lux create mode 100644 stdlib/source/library/lux/abstract/algebra.lux create mode 100644 stdlib/source/library/lux/abstract/apply.lux create mode 100644 stdlib/source/library/lux/abstract/codec.lux create mode 100644 stdlib/source/library/lux/abstract/comonad.lux create mode 100644 stdlib/source/library/lux/abstract/comonad/cofree.lux create mode 100644 stdlib/source/library/lux/abstract/enum.lux create mode 100644 stdlib/source/library/lux/abstract/equivalence.lux create mode 100644 stdlib/source/library/lux/abstract/fold.lux create mode 100644 stdlib/source/library/lux/abstract/functor.lux create mode 100644 stdlib/source/library/lux/abstract/functor/contravariant.lux create mode 100644 stdlib/source/library/lux/abstract/hash.lux create mode 100644 stdlib/source/library/lux/abstract/interval.lux create mode 100644 stdlib/source/library/lux/abstract/monad.lux create mode 100644 stdlib/source/library/lux/abstract/monad/free.lux create mode 100644 stdlib/source/library/lux/abstract/monad/indexed.lux create mode 100644 stdlib/source/library/lux/abstract/monoid.lux create mode 100644 stdlib/source/library/lux/abstract/order.lux create mode 100644 stdlib/source/library/lux/abstract/predicate.lux create mode 100644 stdlib/source/library/lux/control/concatenative.lux create mode 100644 stdlib/source/library/lux/control/concurrency/actor.lux create mode 100644 stdlib/source/library/lux/control/concurrency/atom.lux create mode 100644 stdlib/source/library/lux/control/concurrency/frp.lux create mode 100644 stdlib/source/library/lux/control/concurrency/promise.lux create mode 100644 stdlib/source/library/lux/control/concurrency/semaphore.lux create mode 100644 stdlib/source/library/lux/control/concurrency/stm.lux create mode 100644 stdlib/source/library/lux/control/concurrency/thread.lux create mode 100644 stdlib/source/library/lux/control/continuation.lux create mode 100644 stdlib/source/library/lux/control/exception.lux create mode 100644 stdlib/source/library/lux/control/function.lux create mode 100644 stdlib/source/library/lux/control/function/contract.lux create mode 100644 stdlib/source/library/lux/control/function/memo.lux create mode 100644 stdlib/source/library/lux/control/function/mixin.lux create mode 100644 stdlib/source/library/lux/control/function/mutual.lux create mode 100644 stdlib/source/library/lux/control/io.lux create mode 100644 stdlib/source/library/lux/control/parser.lux create mode 100644 stdlib/source/library/lux/control/parser/analysis.lux create mode 100644 stdlib/source/library/lux/control/parser/binary.lux create mode 100644 stdlib/source/library/lux/control/parser/cli.lux create mode 100644 stdlib/source/library/lux/control/parser/code.lux create mode 100644 stdlib/source/library/lux/control/parser/environment.lux create mode 100644 stdlib/source/library/lux/control/parser/json.lux create mode 100644 stdlib/source/library/lux/control/parser/synthesis.lux create mode 100644 stdlib/source/library/lux/control/parser/text.lux create mode 100644 stdlib/source/library/lux/control/parser/tree.lux create mode 100644 stdlib/source/library/lux/control/parser/type.lux create mode 100644 stdlib/source/library/lux/control/parser/xml.lux create mode 100644 stdlib/source/library/lux/control/pipe.lux create mode 100644 stdlib/source/library/lux/control/reader.lux create mode 100644 stdlib/source/library/lux/control/region.lux create mode 100644 stdlib/source/library/lux/control/remember.lux create mode 100644 stdlib/source/library/lux/control/security/capability.lux create mode 100644 stdlib/source/library/lux/control/security/policy.lux create mode 100644 stdlib/source/library/lux/control/state.lux create mode 100644 stdlib/source/library/lux/control/thread.lux create mode 100644 stdlib/source/library/lux/control/try.lux create mode 100644 stdlib/source/library/lux/control/writer.lux create mode 100644 stdlib/source/library/lux/data/binary.lux create mode 100644 stdlib/source/library/lux/data/bit.lux create mode 100644 stdlib/source/library/lux/data/collection/array.lux create mode 100644 stdlib/source/library/lux/data/collection/bits.lux create mode 100644 stdlib/source/library/lux/data/collection/dictionary.lux create mode 100644 stdlib/source/library/lux/data/collection/dictionary/ordered.lux create mode 100644 stdlib/source/library/lux/data/collection/dictionary/plist.lux create mode 100644 stdlib/source/library/lux/data/collection/list.lux create mode 100644 stdlib/source/library/lux/data/collection/queue.lux create mode 100644 stdlib/source/library/lux/data/collection/queue/priority.lux create mode 100644 stdlib/source/library/lux/data/collection/row.lux create mode 100644 stdlib/source/library/lux/data/collection/sequence.lux create mode 100644 stdlib/source/library/lux/data/collection/set.lux create mode 100644 stdlib/source/library/lux/data/collection/set/multi.lux create mode 100644 stdlib/source/library/lux/data/collection/set/ordered.lux create mode 100644 stdlib/source/library/lux/data/collection/stack.lux create mode 100644 stdlib/source/library/lux/data/collection/tree.lux create mode 100644 stdlib/source/library/lux/data/collection/tree/finger.lux create mode 100644 stdlib/source/library/lux/data/collection/tree/zipper.lux create mode 100644 stdlib/source/library/lux/data/color.lux create mode 100644 stdlib/source/library/lux/data/color/named.lux create mode 100644 stdlib/source/library/lux/data/format/binary.lux create mode 100644 stdlib/source/library/lux/data/format/css.lux create mode 100644 stdlib/source/library/lux/data/format/css/font.lux create mode 100644 stdlib/source/library/lux/data/format/css/property.lux create mode 100644 stdlib/source/library/lux/data/format/css/query.lux create mode 100644 stdlib/source/library/lux/data/format/css/selector.lux create mode 100644 stdlib/source/library/lux/data/format/css/style.lux create mode 100644 stdlib/source/library/lux/data/format/css/value.lux create mode 100644 stdlib/source/library/lux/data/format/html.lux create mode 100644 stdlib/source/library/lux/data/format/json.lux create mode 100644 stdlib/source/library/lux/data/format/markdown.lux create mode 100644 stdlib/source/library/lux/data/format/tar.lux create mode 100644 stdlib/source/library/lux/data/format/xml.lux create mode 100644 stdlib/source/library/lux/data/identity.lux create mode 100644 stdlib/source/library/lux/data/lazy.lux create mode 100644 stdlib/source/library/lux/data/maybe.lux create mode 100644 stdlib/source/library/lux/data/name.lux create mode 100644 stdlib/source/library/lux/data/product.lux create mode 100644 stdlib/source/library/lux/data/store.lux create mode 100644 stdlib/source/library/lux/data/sum.lux create mode 100644 stdlib/source/library/lux/data/text.lux create mode 100644 stdlib/source/library/lux/data/text/buffer.lux create mode 100644 stdlib/source/library/lux/data/text/encoding.lux create mode 100644 stdlib/source/library/lux/data/text/encoding/utf8.lux create mode 100644 stdlib/source/library/lux/data/text/escape.lux create mode 100644 stdlib/source/library/lux/data/text/format.lux create mode 100644 stdlib/source/library/lux/data/text/regex.lux create mode 100644 stdlib/source/library/lux/data/text/unicode/block.lux create mode 100644 stdlib/source/library/lux/data/text/unicode/set.lux create mode 100644 stdlib/source/library/lux/data/trace.lux create mode 100644 stdlib/source/library/lux/debug.lux create mode 100644 stdlib/source/library/lux/extension.lux create mode 100644 stdlib/source/library/lux/ffi.js.lux create mode 100644 stdlib/source/library/lux/ffi.jvm.lux create mode 100644 stdlib/source/library/lux/ffi.lua.lux create mode 100644 stdlib/source/library/lux/ffi.old.lux create mode 100644 stdlib/source/library/lux/ffi.php.lux create mode 100644 stdlib/source/library/lux/ffi.py.lux create mode 100644 stdlib/source/library/lux/ffi.rb.lux create mode 100644 stdlib/source/library/lux/ffi.scm.lux create mode 100644 stdlib/source/library/lux/locale.lux create mode 100644 stdlib/source/library/lux/locale/language.lux create mode 100644 stdlib/source/library/lux/locale/territory.lux create mode 100644 stdlib/source/library/lux/macro.lux create mode 100644 stdlib/source/library/lux/macro/code.lux create mode 100644 stdlib/source/library/lux/macro/local.lux create mode 100644 stdlib/source/library/lux/macro/poly.lux create mode 100644 stdlib/source/library/lux/macro/syntax.lux create mode 100644 stdlib/source/library/lux/macro/syntax/annotations.lux create mode 100644 stdlib/source/library/lux/macro/syntax/check.lux create mode 100644 stdlib/source/library/lux/macro/syntax/declaration.lux create mode 100644 stdlib/source/library/lux/macro/syntax/definition.lux create mode 100644 stdlib/source/library/lux/macro/syntax/export.lux create mode 100644 stdlib/source/library/lux/macro/syntax/input.lux create mode 100644 stdlib/source/library/lux/macro/syntax/type/variable.lux create mode 100644 stdlib/source/library/lux/macro/template.lux create mode 100644 stdlib/source/library/lux/math.lux create mode 100644 stdlib/source/library/lux/math/infix.lux create mode 100644 stdlib/source/library/lux/math/logic/continuous.lux create mode 100644 stdlib/source/library/lux/math/logic/fuzzy.lux create mode 100644 stdlib/source/library/lux/math/modular.lux create mode 100644 stdlib/source/library/lux/math/modulus.lux create mode 100644 stdlib/source/library/lux/math/number.lux create mode 100644 stdlib/source/library/lux/math/number/complex.lux create mode 100644 stdlib/source/library/lux/math/number/frac.lux create mode 100644 stdlib/source/library/lux/math/number/i16.lux create mode 100644 stdlib/source/library/lux/math/number/i32.lux create mode 100644 stdlib/source/library/lux/math/number/i64.lux create mode 100644 stdlib/source/library/lux/math/number/i8.lux create mode 100644 stdlib/source/library/lux/math/number/int.lux create mode 100644 stdlib/source/library/lux/math/number/nat.lux create mode 100644 stdlib/source/library/lux/math/number/ratio.lux create mode 100644 stdlib/source/library/lux/math/number/rev.lux create mode 100644 stdlib/source/library/lux/math/random.lux create mode 100644 stdlib/source/library/lux/meta.lux create mode 100644 stdlib/source/library/lux/meta/annotation.lux create mode 100644 stdlib/source/library/lux/meta/location.lux create mode 100644 stdlib/source/library/lux/program.lux create mode 100644 stdlib/source/library/lux/target.lux create mode 100644 stdlib/source/library/lux/target/common_lisp.lux create mode 100644 stdlib/source/library/lux/target/js.lux create mode 100644 stdlib/source/library/lux/target/jvm.lux create mode 100644 stdlib/source/library/lux/target/jvm/attribute.lux create mode 100644 stdlib/source/library/lux/target/jvm/attribute/code.lux create mode 100644 stdlib/source/library/lux/target/jvm/attribute/code/exception.lux create mode 100644 stdlib/source/library/lux/target/jvm/attribute/constant.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/address.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/environment.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/instruction.lux create mode 100644 stdlib/source/library/lux/target/jvm/bytecode/jump.lux create mode 100644 stdlib/source/library/lux/target/jvm/class.lux create mode 100644 stdlib/source/library/lux/target/jvm/constant.lux create mode 100644 stdlib/source/library/lux/target/jvm/constant/pool.lux create mode 100644 stdlib/source/library/lux/target/jvm/constant/tag.lux create mode 100644 stdlib/source/library/lux/target/jvm/encoding/name.lux create mode 100644 stdlib/source/library/lux/target/jvm/encoding/signed.lux create mode 100644 stdlib/source/library/lux/target/jvm/encoding/unsigned.lux create mode 100644 stdlib/source/library/lux/target/jvm/field.lux create mode 100644 stdlib/source/library/lux/target/jvm/index.lux create mode 100644 stdlib/source/library/lux/target/jvm/loader.lux create mode 100644 stdlib/source/library/lux/target/jvm/magic.lux create mode 100644 stdlib/source/library/lux/target/jvm/method.lux create mode 100644 stdlib/source/library/lux/target/jvm/modifier.lux create mode 100644 stdlib/source/library/lux/target/jvm/modifier/inner.lux create mode 100644 stdlib/source/library/lux/target/jvm/reflection.lux create mode 100644 stdlib/source/library/lux/target/jvm/type.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/alias.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/box.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/category.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/descriptor.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/lux.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/parser.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/reflection.lux create mode 100644 stdlib/source/library/lux/target/jvm/type/signature.lux create mode 100644 stdlib/source/library/lux/target/jvm/version.lux create mode 100644 stdlib/source/library/lux/target/lua.lux create mode 100644 stdlib/source/library/lux/target/php.lux create mode 100644 stdlib/source/library/lux/target/python.lux create mode 100644 stdlib/source/library/lux/target/r.lux create mode 100644 stdlib/source/library/lux/target/ruby.lux create mode 100644 stdlib/source/library/lux/target/scheme.lux create mode 100644 stdlib/source/library/lux/test.lux create mode 100644 stdlib/source/library/lux/time.lux create mode 100644 stdlib/source/library/lux/time/date.lux create mode 100644 stdlib/source/library/lux/time/day.lux create mode 100644 stdlib/source/library/lux/time/duration.lux create mode 100644 stdlib/source/library/lux/time/instant.lux create mode 100644 stdlib/source/library/lux/time/month.lux create mode 100644 stdlib/source/library/lux/time/year.lux create mode 100644 stdlib/source/library/lux/tool/compiler.lux create mode 100644 stdlib/source/library/lux/tool/compiler/arity.lux create mode 100644 stdlib/source/library/lux/tool/compiler/default/init.lux create mode 100644 stdlib/source/library/lux/tool/compiler/default/platform.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/evaluation.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/directive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/generation.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/common_lisp.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/synthesis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant/arity.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/type.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/primitive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/program.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/version.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/document.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/key.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/io.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/io/archive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/io/context.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/packager/script.lux create mode 100644 stdlib/source/library/lux/tool/compiler/phase.lux create mode 100644 stdlib/source/library/lux/tool/compiler/reference.lux create mode 100644 stdlib/source/library/lux/tool/compiler/reference/variable.lux create mode 100644 stdlib/source/library/lux/tool/compiler/version.lux create mode 100644 stdlib/source/library/lux/tool/interpreter.lux create mode 100644 stdlib/source/library/lux/tool/mediator.lux create mode 100644 stdlib/source/library/lux/type.lux create mode 100644 stdlib/source/library/lux/type/abstract.lux create mode 100644 stdlib/source/library/lux/type/check.lux create mode 100644 stdlib/source/library/lux/type/dynamic.lux create mode 100644 stdlib/source/library/lux/type/implicit.lux create mode 100644 stdlib/source/library/lux/type/quotient.lux create mode 100644 stdlib/source/library/lux/type/refinement.lux create mode 100644 stdlib/source/library/lux/type/resource.lux create mode 100644 stdlib/source/library/lux/type/unit.lux create mode 100644 stdlib/source/library/lux/type/variance.lux create mode 100644 stdlib/source/library/lux/world/console.lux create mode 100644 stdlib/source/library/lux/world/db/jdbc.lux create mode 100644 stdlib/source/library/lux/world/db/jdbc/input.lux create mode 100644 stdlib/source/library/lux/world/db/jdbc/output.lux create mode 100644 stdlib/source/library/lux/world/db/sql.lux create mode 100644 stdlib/source/library/lux/world/file.lux create mode 100644 stdlib/source/library/lux/world/file/watch.lux create mode 100644 stdlib/source/library/lux/world/input/keyboard.lux create mode 100644 stdlib/source/library/lux/world/net.lux create mode 100644 stdlib/source/library/lux/world/net/http.lux create mode 100644 stdlib/source/library/lux/world/net/http/client.lux create mode 100644 stdlib/source/library/lux/world/net/http/cookie.lux create mode 100644 stdlib/source/library/lux/world/net/http/header.lux create mode 100644 stdlib/source/library/lux/world/net/http/mime.lux create mode 100644 stdlib/source/library/lux/world/net/http/query.lux create mode 100644 stdlib/source/library/lux/world/net/http/request.lux create mode 100644 stdlib/source/library/lux/world/net/http/response.lux create mode 100644 stdlib/source/library/lux/world/net/http/route.lux create mode 100644 stdlib/source/library/lux/world/net/http/status.lux create mode 100644 stdlib/source/library/lux/world/net/http/version.lux create mode 100644 stdlib/source/library/lux/world/net/uri.lux create mode 100644 stdlib/source/library/lux/world/output/video/resolution.lux create mode 100644 stdlib/source/library/lux/world/program.lux create mode 100644 stdlib/source/library/lux/world/service/authentication.lux create mode 100644 stdlib/source/library/lux/world/service/crud.lux create mode 100644 stdlib/source/library/lux/world/service/inventory.lux create mode 100644 stdlib/source/library/lux/world/service/journal.lux create mode 100644 stdlib/source/library/lux/world/service/mail.lux create mode 100644 stdlib/source/library/lux/world/shell.lux delete mode 100644 stdlib/source/lux.lux delete mode 100644 stdlib/source/lux/abstract/algebra.lux delete mode 100644 stdlib/source/lux/abstract/apply.lux delete mode 100644 stdlib/source/lux/abstract/codec.lux delete mode 100644 stdlib/source/lux/abstract/comonad.lux delete mode 100644 stdlib/source/lux/abstract/comonad/cofree.lux delete mode 100644 stdlib/source/lux/abstract/enum.lux delete mode 100644 stdlib/source/lux/abstract/equivalence.lux delete mode 100644 stdlib/source/lux/abstract/fold.lux delete mode 100644 stdlib/source/lux/abstract/functor.lux delete mode 100644 stdlib/source/lux/abstract/functor/contravariant.lux delete mode 100644 stdlib/source/lux/abstract/hash.lux delete mode 100644 stdlib/source/lux/abstract/interval.lux delete mode 100644 stdlib/source/lux/abstract/monad.lux delete mode 100644 stdlib/source/lux/abstract/monad/free.lux delete mode 100644 stdlib/source/lux/abstract/monad/indexed.lux delete mode 100644 stdlib/source/lux/abstract/monoid.lux delete mode 100644 stdlib/source/lux/abstract/order.lux delete mode 100644 stdlib/source/lux/abstract/predicate.lux delete mode 100644 stdlib/source/lux/control/concatenative.lux delete mode 100644 stdlib/source/lux/control/concurrency/actor.lux delete mode 100644 stdlib/source/lux/control/concurrency/atom.lux delete mode 100644 stdlib/source/lux/control/concurrency/frp.lux delete mode 100644 stdlib/source/lux/control/concurrency/promise.lux delete mode 100644 stdlib/source/lux/control/concurrency/semaphore.lux delete mode 100644 stdlib/source/lux/control/concurrency/stm.lux delete mode 100644 stdlib/source/lux/control/concurrency/thread.lux delete mode 100644 stdlib/source/lux/control/continuation.lux delete mode 100644 stdlib/source/lux/control/exception.lux delete mode 100644 stdlib/source/lux/control/function.lux delete mode 100644 stdlib/source/lux/control/function/contract.lux delete mode 100644 stdlib/source/lux/control/function/memo.lux delete mode 100644 stdlib/source/lux/control/function/mixin.lux delete mode 100644 stdlib/source/lux/control/function/mutual.lux delete mode 100644 stdlib/source/lux/control/io.lux delete mode 100644 stdlib/source/lux/control/parser.lux delete mode 100644 stdlib/source/lux/control/parser/analysis.lux delete mode 100644 stdlib/source/lux/control/parser/binary.lux delete mode 100644 stdlib/source/lux/control/parser/cli.lux delete mode 100644 stdlib/source/lux/control/parser/code.lux delete mode 100644 stdlib/source/lux/control/parser/environment.lux delete mode 100644 stdlib/source/lux/control/parser/json.lux delete mode 100644 stdlib/source/lux/control/parser/synthesis.lux delete mode 100644 stdlib/source/lux/control/parser/text.lux delete mode 100644 stdlib/source/lux/control/parser/tree.lux delete mode 100644 stdlib/source/lux/control/parser/type.lux delete mode 100644 stdlib/source/lux/control/parser/xml.lux delete mode 100644 stdlib/source/lux/control/pipe.lux delete mode 100644 stdlib/source/lux/control/reader.lux delete mode 100644 stdlib/source/lux/control/region.lux delete mode 100644 stdlib/source/lux/control/remember.lux delete mode 100644 stdlib/source/lux/control/security/capability.lux delete mode 100644 stdlib/source/lux/control/security/policy.lux delete mode 100644 stdlib/source/lux/control/state.lux delete mode 100644 stdlib/source/lux/control/thread.lux delete mode 100644 stdlib/source/lux/control/try.lux delete mode 100644 stdlib/source/lux/control/writer.lux delete mode 100644 stdlib/source/lux/data/binary.lux delete mode 100644 stdlib/source/lux/data/bit.lux delete mode 100644 stdlib/source/lux/data/collection/array.lux delete mode 100644 stdlib/source/lux/data/collection/bits.lux delete mode 100644 stdlib/source/lux/data/collection/dictionary.lux delete mode 100644 stdlib/source/lux/data/collection/dictionary/ordered.lux delete mode 100644 stdlib/source/lux/data/collection/dictionary/plist.lux delete mode 100644 stdlib/source/lux/data/collection/list.lux delete mode 100644 stdlib/source/lux/data/collection/queue.lux delete mode 100644 stdlib/source/lux/data/collection/queue/priority.lux delete mode 100644 stdlib/source/lux/data/collection/row.lux delete mode 100644 stdlib/source/lux/data/collection/sequence.lux delete mode 100644 stdlib/source/lux/data/collection/set.lux delete mode 100644 stdlib/source/lux/data/collection/set/multi.lux delete mode 100644 stdlib/source/lux/data/collection/set/ordered.lux delete mode 100644 stdlib/source/lux/data/collection/stack.lux delete mode 100644 stdlib/source/lux/data/collection/tree.lux delete mode 100644 stdlib/source/lux/data/collection/tree/finger.lux delete mode 100644 stdlib/source/lux/data/collection/tree/zipper.lux delete mode 100644 stdlib/source/lux/data/color.lux delete mode 100644 stdlib/source/lux/data/color/named.lux delete mode 100644 stdlib/source/lux/data/format/binary.lux delete mode 100644 stdlib/source/lux/data/format/css.lux delete mode 100644 stdlib/source/lux/data/format/css/font.lux delete mode 100644 stdlib/source/lux/data/format/css/property.lux delete mode 100644 stdlib/source/lux/data/format/css/query.lux delete mode 100644 stdlib/source/lux/data/format/css/selector.lux delete mode 100644 stdlib/source/lux/data/format/css/style.lux delete mode 100644 stdlib/source/lux/data/format/css/value.lux delete mode 100644 stdlib/source/lux/data/format/html.lux delete mode 100644 stdlib/source/lux/data/format/json.lux delete mode 100644 stdlib/source/lux/data/format/markdown.lux delete mode 100644 stdlib/source/lux/data/format/tar.lux delete mode 100644 stdlib/source/lux/data/format/xml.lux delete mode 100644 stdlib/source/lux/data/identity.lux delete mode 100644 stdlib/source/lux/data/lazy.lux delete mode 100644 stdlib/source/lux/data/maybe.lux delete mode 100644 stdlib/source/lux/data/name.lux delete mode 100644 stdlib/source/lux/data/product.lux delete mode 100644 stdlib/source/lux/data/store.lux delete mode 100644 stdlib/source/lux/data/sum.lux delete mode 100644 stdlib/source/lux/data/text.lux delete mode 100644 stdlib/source/lux/data/text/buffer.lux delete mode 100644 stdlib/source/lux/data/text/encoding.lux delete mode 100644 stdlib/source/lux/data/text/encoding/utf8.lux delete mode 100644 stdlib/source/lux/data/text/escape.lux delete mode 100644 stdlib/source/lux/data/text/format.lux delete mode 100644 stdlib/source/lux/data/text/regex.lux delete mode 100644 stdlib/source/lux/data/text/unicode/block.lux delete mode 100644 stdlib/source/lux/data/text/unicode/set.lux delete mode 100644 stdlib/source/lux/data/trace.lux delete mode 100644 stdlib/source/lux/debug.lux delete mode 100644 stdlib/source/lux/extension.lux delete mode 100644 stdlib/source/lux/ffi.js.lux delete mode 100644 stdlib/source/lux/ffi.jvm.lux delete mode 100644 stdlib/source/lux/ffi.lua.lux delete mode 100644 stdlib/source/lux/ffi.old.lux delete mode 100644 stdlib/source/lux/ffi.php.lux delete mode 100644 stdlib/source/lux/ffi.py.lux delete mode 100644 stdlib/source/lux/ffi.rb.lux delete mode 100644 stdlib/source/lux/ffi.scm.lux delete mode 100644 stdlib/source/lux/locale.lux delete mode 100644 stdlib/source/lux/locale/language.lux delete mode 100644 stdlib/source/lux/locale/territory.lux delete mode 100644 stdlib/source/lux/macro.lux delete mode 100644 stdlib/source/lux/macro/code.lux delete mode 100644 stdlib/source/lux/macro/local.lux delete mode 100644 stdlib/source/lux/macro/poly.lux delete mode 100644 stdlib/source/lux/macro/syntax.lux delete mode 100644 stdlib/source/lux/macro/syntax/annotations.lux delete mode 100644 stdlib/source/lux/macro/syntax/check.lux delete mode 100644 stdlib/source/lux/macro/syntax/declaration.lux delete mode 100644 stdlib/source/lux/macro/syntax/definition.lux delete mode 100644 stdlib/source/lux/macro/syntax/export.lux delete mode 100644 stdlib/source/lux/macro/syntax/input.lux delete mode 100644 stdlib/source/lux/macro/syntax/type/variable.lux delete mode 100644 stdlib/source/lux/macro/template.lux delete mode 100644 stdlib/source/lux/math.lux delete mode 100644 stdlib/source/lux/math/infix.lux delete mode 100644 stdlib/source/lux/math/logic/continuous.lux delete mode 100644 stdlib/source/lux/math/logic/fuzzy.lux delete mode 100644 stdlib/source/lux/math/modular.lux delete mode 100644 stdlib/source/lux/math/modulus.lux delete mode 100644 stdlib/source/lux/math/number.lux delete mode 100644 stdlib/source/lux/math/number/complex.lux delete mode 100644 stdlib/source/lux/math/number/frac.lux delete mode 100644 stdlib/source/lux/math/number/i16.lux delete mode 100644 stdlib/source/lux/math/number/i32.lux delete mode 100644 stdlib/source/lux/math/number/i64.lux delete mode 100644 stdlib/source/lux/math/number/i8.lux delete mode 100644 stdlib/source/lux/math/number/int.lux delete mode 100644 stdlib/source/lux/math/number/nat.lux delete mode 100644 stdlib/source/lux/math/number/ratio.lux delete mode 100644 stdlib/source/lux/math/number/rev.lux delete mode 100644 stdlib/source/lux/math/random.lux delete mode 100644 stdlib/source/lux/meta.lux delete mode 100644 stdlib/source/lux/meta/annotation.lux delete mode 100644 stdlib/source/lux/meta/location.lux delete mode 100644 stdlib/source/lux/program.lux delete mode 100644 stdlib/source/lux/target.lux delete mode 100644 stdlib/source/lux/target/common_lisp.lux delete mode 100644 stdlib/source/lux/target/js.lux delete mode 100644 stdlib/source/lux/target/jvm.lux delete mode 100644 stdlib/source/lux/target/jvm/attribute.lux delete mode 100644 stdlib/source/lux/target/jvm/attribute/code.lux delete mode 100644 stdlib/source/lux/target/jvm/attribute/code/exception.lux delete mode 100644 stdlib/source/lux/target/jvm/attribute/constant.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/address.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/environment.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/environment/limit.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/instruction.lux delete mode 100644 stdlib/source/lux/target/jvm/bytecode/jump.lux delete mode 100644 stdlib/source/lux/target/jvm/class.lux delete mode 100644 stdlib/source/lux/target/jvm/constant.lux delete mode 100644 stdlib/source/lux/target/jvm/constant/pool.lux delete mode 100644 stdlib/source/lux/target/jvm/constant/tag.lux delete mode 100644 stdlib/source/lux/target/jvm/encoding/name.lux delete mode 100644 stdlib/source/lux/target/jvm/encoding/signed.lux delete mode 100644 stdlib/source/lux/target/jvm/encoding/unsigned.lux delete mode 100644 stdlib/source/lux/target/jvm/field.lux delete mode 100644 stdlib/source/lux/target/jvm/index.lux delete mode 100644 stdlib/source/lux/target/jvm/loader.lux delete mode 100644 stdlib/source/lux/target/jvm/magic.lux delete mode 100644 stdlib/source/lux/target/jvm/method.lux delete mode 100644 stdlib/source/lux/target/jvm/modifier.lux delete mode 100644 stdlib/source/lux/target/jvm/modifier/inner.lux delete mode 100644 stdlib/source/lux/target/jvm/reflection.lux delete mode 100644 stdlib/source/lux/target/jvm/type.lux delete mode 100644 stdlib/source/lux/target/jvm/type/alias.lux delete mode 100644 stdlib/source/lux/target/jvm/type/box.lux delete mode 100644 stdlib/source/lux/target/jvm/type/category.lux delete mode 100644 stdlib/source/lux/target/jvm/type/descriptor.lux delete mode 100644 stdlib/source/lux/target/jvm/type/lux.lux delete mode 100644 stdlib/source/lux/target/jvm/type/parser.lux delete mode 100644 stdlib/source/lux/target/jvm/type/reflection.lux delete mode 100644 stdlib/source/lux/target/jvm/type/signature.lux delete mode 100644 stdlib/source/lux/target/jvm/version.lux delete mode 100644 stdlib/source/lux/target/lua.lux delete mode 100644 stdlib/source/lux/target/php.lux delete mode 100644 stdlib/source/lux/target/python.lux delete mode 100644 stdlib/source/lux/target/r.lux delete mode 100644 stdlib/source/lux/target/ruby.lux delete mode 100644 stdlib/source/lux/target/scheme.lux delete mode 100644 stdlib/source/lux/test.lux delete mode 100644 stdlib/source/lux/time.lux delete mode 100644 stdlib/source/lux/time/date.lux delete mode 100644 stdlib/source/lux/time/day.lux delete mode 100644 stdlib/source/lux/time/duration.lux delete mode 100644 stdlib/source/lux/time/instant.lux delete mode 100644 stdlib/source/lux/time/month.lux delete mode 100644 stdlib/source/lux/time/year.lux delete mode 100644 stdlib/source/lux/tool/compiler.lux delete mode 100644 stdlib/source/lux/tool/compiler/arity.lux delete mode 100644 stdlib/source/lux/tool/compiler/default/init.lux delete mode 100644 stdlib/source/lux/tool/compiler/default/platform.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/analysis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/analysis/macro.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/directive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/generation.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/scope.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/analysis/type.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/common_lisp.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/bundle.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/extension/synthesis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/extension.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant/arity.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial/count.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/type.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/extension/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/php/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/primitive.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/case.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/variable.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/program.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/syntax.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/synthesis.lux delete mode 100644 stdlib/source/lux/tool/compiler/language/lux/version.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive/artifact.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive/document.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive/key.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/archive/signature.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/cache/dependency.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/io.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/io/archive.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/io/context.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/packager.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/packager/jvm.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/packager/scheme.lux delete mode 100644 stdlib/source/lux/tool/compiler/meta/packager/script.lux delete mode 100644 stdlib/source/lux/tool/compiler/phase.lux delete mode 100644 stdlib/source/lux/tool/compiler/reference.lux delete mode 100644 stdlib/source/lux/tool/compiler/reference/variable.lux delete mode 100644 stdlib/source/lux/tool/compiler/version.lux delete mode 100644 stdlib/source/lux/tool/interpreter.lux delete mode 100644 stdlib/source/lux/tool/mediator.lux delete mode 100644 stdlib/source/lux/type.lux delete mode 100644 stdlib/source/lux/type/abstract.lux delete mode 100644 stdlib/source/lux/type/check.lux delete mode 100644 stdlib/source/lux/type/dynamic.lux delete mode 100644 stdlib/source/lux/type/implicit.lux delete mode 100644 stdlib/source/lux/type/quotient.lux delete mode 100644 stdlib/source/lux/type/refinement.lux delete mode 100644 stdlib/source/lux/type/resource.lux delete mode 100644 stdlib/source/lux/type/unit.lux delete mode 100644 stdlib/source/lux/type/variance.lux delete mode 100644 stdlib/source/lux/world/console.lux delete mode 100644 stdlib/source/lux/world/db/jdbc.lux delete mode 100644 stdlib/source/lux/world/db/jdbc/input.lux delete mode 100644 stdlib/source/lux/world/db/jdbc/output.lux delete mode 100644 stdlib/source/lux/world/db/sql.lux delete mode 100644 stdlib/source/lux/world/file.lux delete mode 100644 stdlib/source/lux/world/file/watch.lux delete mode 100644 stdlib/source/lux/world/input/keyboard.lux delete mode 100644 stdlib/source/lux/world/net.lux delete mode 100644 stdlib/source/lux/world/net/http.lux delete mode 100644 stdlib/source/lux/world/net/http/client.lux delete mode 100644 stdlib/source/lux/world/net/http/cookie.lux delete mode 100644 stdlib/source/lux/world/net/http/header.lux delete mode 100644 stdlib/source/lux/world/net/http/mime.lux delete mode 100644 stdlib/source/lux/world/net/http/query.lux delete mode 100644 stdlib/source/lux/world/net/http/request.lux delete mode 100644 stdlib/source/lux/world/net/http/response.lux delete mode 100644 stdlib/source/lux/world/net/http/route.lux delete mode 100644 stdlib/source/lux/world/net/http/status.lux delete mode 100644 stdlib/source/lux/world/net/http/version.lux delete mode 100644 stdlib/source/lux/world/net/uri.lux delete mode 100644 stdlib/source/lux/world/output/video/resolution.lux delete mode 100644 stdlib/source/lux/world/program.lux delete mode 100644 stdlib/source/lux/world/service/authentication.lux delete mode 100644 stdlib/source/lux/world/service/crud.lux delete mode 100644 stdlib/source/lux/world/service/inventory.lux delete mode 100644 stdlib/source/lux/world/service/journal.lux delete mode 100644 stdlib/source/lux/world/service/mail.lux delete mode 100644 stdlib/source/lux/world/shell.lux diff --git a/.gitignore b/.gitignore index ded3e74bf..84f1571c4 100644 --- a/.gitignore +++ b/.gitignore @@ -21,39 +21,34 @@ pom.xml.asc /licentia/source/lux /lux-jvm/target -/lux-jvm/source/lux.lux -/lux-jvm/source/lux +/lux-jvm/source/library /lux-jvm/source/program /lux-jvm/source/spec /lux-js/target -/lux-js/source/lux.lux -/lux-js/source/lux +/lux-js/source/library /lux-js/source/program /lux-js/source/spec /lux-js/node_based_compiler.js /lux-js/lux.js /lux-python/target -/lux-python/source/lux.lux -/lux-python/source/lux +/lux-python/source/library /lux-python/source/program /lux-python/source/spec /lux-lua/target -/lux-lua/source/lux.lux -/lux-lua/source/lux +/lux-lua/source/library /lux-lua/source/program /lux-lua/source/spec /lux-ruby/target -/lux-ruby/source/lux.lux -/lux-ruby/source/lux +/lux-ruby/source/library /lux-ruby/source/program /lux-ruby/source/spec /lux-php/target -/lux-php/source/lux.lux +/lux-php/source/library /lux-php/source/lux /lux-php/source/program /lux-php/source/spec diff --git a/lux-bootstrapper/src/lux/analyser/base.clj b/lux-bootstrapper/src/lux/analyser/base.clj index d6787280f..e5f47f977 100644 --- a/lux-bootstrapper/src/lux/analyser/base.clj +++ b/lux-bootstrapper/src/lux/analyser/base.clj @@ -77,7 +77,7 @@ (let [tag-names #{"Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"}] (defn type-tag? [module name] - (and (= "lux" module) + (and (= &/prelude module) (contains? tag-names name)))) (defn |meta [type location analysis] diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index 5ef710a03..648b3341c 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -5,7 +5,7 @@ clojure.core.match.array)) (def prelude - "lux") + "library/lux") (def !log! (atom false)) (defn flag-prn! [& args] @@ -13,7 +13,8 @@ (apply prn args))) ;; [Tags] -(def unit-tag (.intern "")) +(def unit-tag + (.intern "")) (defn T [elems] (case (count elems) diff --git a/lux-bootstrapper/src/lux/compiler/jvm.clj b/lux-bootstrapper/src/lux/compiler/jvm.clj index bacf2cb9c..e2521fec7 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm.clj @@ -188,7 +188,7 @@ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) module-class-name nil "java/lang/Object" nil) (.visitSource file-name nil))] - _ (if (= "lux" name) + _ (if (= &/prelude name) (|do [_ &&rt/compile-Function-class _ &&rt/compile-LuxRT-class] (return nil)) @@ -242,7 +242,7 @@ &&jvm-cache/load-def-value &&jvm-cache/install-all-defs-in-module &&jvm-cache/uninstall-all-defs-in-module) - _ (compile-module source-dirs "lux")] + _ (compile-module source-dirs &/prelude)] (compile-module source-dirs program-module))] (|case (m-action (&/init-state "{old}" mode (jvm-host))) (&/$Right ?state _) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/base.clj b/lux-bootstrapper/src/lux/compiler/jvm/base.clj index b5e520de5..47566a626 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/base.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/base.clj @@ -21,8 +21,12 @@ (java.lang.reflect Field))) ;; [Constants] -(def ^:const ^String function-class "lux/Function") -(def ^:const ^String lux-utils-class "lux/LuxRT") +(def ^:const ^String function-class + (&host/internal &host/function-class)) + +(def ^:const ^String lux-utils-class + (&host/internal &host/lux-utils-class)) + (def ^:const ^String unit-tag-field "unit_tag") ;; Formats diff --git a/lux-bootstrapper/src/lux/compiler/jvm/case.clj b/lux-bootstrapper/src/lux/compiler/jvm/case.clj index b7cdb7571..8a41db0b3 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/case.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/case.clj @@ -114,21 +114,21 @@ #(doto ^MethodVisitor % (.visitInsn Opcodes/AALOAD)) #(doto ^MethodVisitor % - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;")))] + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;")))] (doto writer stack-peek (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitLdcInsn (int lefts)) accessI - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))) + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))) (&o/$TuplePM (&/$Right _idx)) (doto writer stack-peek (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitLdcInsn (int (dec _idx))) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) (&o/$VariantPM _idx+) (|let [$success (new Label) @@ -147,7 +147,7 @@ (.visitLdcInsn writer "") (.visitInsn writer Opcodes/ACONST_NULL))] (doto writer - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;") (.visitInsn Opcodes/DUP) (.visitJumpInsn Opcodes/IFNULL $fail) (.visitJumpInsn Opcodes/GOTO $success) @@ -155,7 +155,7 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $else) (.visitLabel $success) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))) + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))) (&o/$SeqPM _left-pm _right-pm) (doto writer @@ -178,7 +178,7 @@ (compile-pattern* bodies 1 $else pm) (.visitLabel $else) (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_fail" "()V") + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "pm_fail" "()V") (.visitInsn Opcodes/ACONST_NULL) (.visitJumpInsn Opcodes/GOTO $end)))) @@ -200,7 +200,7 @@ (.visitInsn Opcodes/ACONST_NULL))] _ (compile ?value) :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) _ (compile-pattern *writer* bodies-labels ?pm $end)] _ (compile-bodies *writer* compile bodies-labels ?bodies $end) :let [_ (.visitLabel *writer* $end)]] diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj index 515bd8db5..f5fa88e02 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj @@ -15,7 +15,8 @@ (lux.analyser [base :as &a] [module :as &a-module]) (lux.compiler.jvm [base :as &&] - [function :as &&function])) + [function :as &&function] + [rt :as &rt])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -79,7 +80,7 @@ (.visitLdcInsn *writer* "") (.visitInsn *writer* Opcodes/ACONST_NULL))] _ (compile value) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")]] + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")]] (return nil))) (defn compile-local [compile ?idx] @@ -120,7 +121,7 @@ class-loader &/loader :let [func-class (class func-obj) func-arity (.get ^Field (.getDeclaredField func-class &&/arity-field) nil) - func-partials (.get ^Field (.getDeclaredField (Class/forName "lux.Function" true class-loader) &&/partials-field) func-obj) + func-partials (.get ^Field (.getDeclaredField (Class/forName &host/function-class true class-loader) &&/partials-field) func-obj) num-args (&/|length ?args) func-class-name (->> func-class .getName &host-generics/->bytecode-class-name)]] (if (and (= 0 func-partials) @@ -208,7 +209,7 @@ (.visitLdcInsn (int (if tail? (dec idx) idx))) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class (if tail? "tuple_right" "tuple_left") "([Ljava/lang/Object;I)Ljava/lang/Object;")))) _path)]] @@ -339,7 +340,7 @@ (.visitLdcInsn (->> #'&/$Nil meta ::&/idx int)) ;; I (.visitInsn Opcodes/ACONST_NULL) ;; I? (.visitLdcInsn &/unit-tag) ;; I?U - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V ;; Tail: End ;; Size: Begin (.visitVarInsn Opcodes/ALOAD 0) ;; VA @@ -379,7 +380,7 @@ (.visitLdcInsn "") ;; I2I? (.visitInsn Opcodes/DUP2_X1) ;; II?2I? (.visitInsn Opcodes/POP2) ;; II?2 - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV ;; Cons: End (.visitInsn Opcodes/SWAP) ;; VI (.visitJumpInsn Opcodes/GOTO $loop) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj index f21557e88..cd1b77dee 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/common.clj @@ -14,7 +14,8 @@ [lux.type.host :as &host-type] [lux.host.generics :as &host-generics] [lux.analyser.base :as &a] - [lux.compiler.jvm.base :as &&]) + (lux.compiler.jvm [base :as &&] + [rt :as &rt])) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -81,8 +82,8 @@ ^MethodVisitor *writer* &/get-writer _ (compile ?op) :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "lux/Function") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "runTry" "(Llux/Function;)[Ljava/lang/Object;"))]] + (.visitTypeInsn Opcodes/CHECKCAST &rt/function-class) + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "runTry" (str "(L" &rt/function-class ";)[Ljava/lang/Object;")))]] (return nil))) (do-template [ ] @@ -160,7 +161,7 @@ _ (compile ?input) :let [_ (doto *writer* (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "decode_frac" "(Ljava/lang/String;)[Ljava/lang/Object;"))]] + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "decode_frac" "(Ljava/lang/String;)[Ljava/lang/Object;"))]] (return nil))) (defn ^:private compile-int-char [compile ?values special-args] @@ -276,11 +277,11 @@ (.visitJumpInsn Opcodes/IF_ICMPEQ $not-found) (.visitInsn Opcodes/I2L) &&/wrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") (.visitJumpInsn Opcodes/GOTO $end) (.visitLabel $not-found) (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC &rt/rt-class "make_none" "()[Ljava/lang/Object;") (.visitLabel $end))]] (return nil))) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj index 7fabd27ed..73812ef8f 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj @@ -21,6 +21,12 @@ MethodVisitor AnnotationVisitor))) +(def ^:const ^String rt-class + &&/lux-utils-class) + +(def ^:const ^String function-class + &&/function-class) + ;; [Utils] (def init-method "") @@ -63,7 +69,7 @@ (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)))))]] - (&&/save-class! (second (string/split &&/function-class #"/")) + (&&/save-class! (-> &&/function-class (string/split #"/") (nth 2)) (.toByteArray (doto =class .visitEnd))))) (defmacro [& instructions] @@ -170,7 +176,7 @@ super-nested ( super-nested-tag ;; super-tag !variant <>last? ;; super-tag, super-last !variant <>value ;; super-tag, super-last, super-value - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")) update-!variant ( !variant <>value (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") @@ -249,11 +255,11 @@ (.visitVarInsn Opcodes/ALOAD 0) (.visitMethodInsn Opcodes/INVOKESTATIC ) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitLabel $to) (.visitLabel $handler) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "make_none" "()[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd))) @@ -335,7 +341,7 @@ (.visitLdcInsn (->> #'&/$None meta ::&/idx int)) ;; I (.visitInsn Opcodes/ACONST_NULL) ;; I? (.visitLdcInsn &/unit-tag) ;; I?U - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) @@ -344,7 +350,7 @@ (.visitLdcInsn (->> #'&/$Some meta ::&/idx int)) ;; I (.visitLdcInsn "") ;; I? (.visitVarInsn Opcodes/ALOAD 0) ;; I?O - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) @@ -377,14 +383,14 @@ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/io/PrintWriter" "" "(Ljava/io/Writer;Z)V") ;; P ))] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "runTry" "(Llux/Function;)[Ljava/lang/Object;" nil nil) + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "runTry" (str "(L" function-class ";)[Ljava/lang/Object;") nil nil) (.visitCode) (.visitTryCatchBlock $from $to $handler "java/lang/Throwable") (.visitLabel $from) (.visitVarInsn Opcodes/ALOAD 0) (.visitInsn Opcodes/ACONST_NULL) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "lux/Function" &&/apply-method (&&/apply-signature 1)) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL function-class &&/apply-method (&&/apply-signature 1)) + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "make_some" "(Ljava/lang/Object;)[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitLabel $to) (.visitLabel $handler) ;; T @@ -397,7 +403,7 @@ (.visitLdcInsn (->> #'&/$Left meta ::&/idx int)) ;; SI (.visitInsn Opcodes/ACONST_NULL) ;; SI? swap2x1 ;; I?S - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitMethodInsn Opcodes/INVOKESTATIC rt-class "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd))) @@ -406,5 +412,5 @@ (compile-LuxRT-adt-methods) (compile-LuxRT-int-methods) (compile-LuxRT-frac-methods))]] - (&&/save-class! (second (string/split &&/lux-utils-class #"/")) + (&&/save-class! (-> &&/lux-utils-class (string/split #"/") (nth 2)) (.toByteArray (doto =class .visitEnd))))) diff --git a/lux-bootstrapper/src/lux/host.clj b/lux-bootstrapper/src/lux/host.clj index 4da818db2..eb1bcb41c 100644 --- a/lux-bootstrapper/src/lux/host.clj +++ b/lux-bootstrapper/src/lux/host.clj @@ -15,12 +15,23 @@ MethodVisitor))) ;; [Constants] -(def function-class "lux.Function") (def module-separator "/") (def class-name-separator ".") (def class-separator "/") (def bytecode-version Opcodes/V1_6) +(defn ^String external [^String internal] + (.replace internal class-separator class-name-separator)) + +(defn ^String internal [^String external] + (.replace external class-name-separator class-separator)) + +(def ^:const ^String function-class + (str (external &/prelude) class-name-separator "Function")) + +(def ^:const ^String lux-utils-class + (str (external &/prelude) class-name-separator "LuxRT")) + ;; [Resources] (defn ^String ->module-class [old] old) diff --git a/lux-bootstrapper/src/lux/repl.clj b/lux-bootstrapper/src/lux/repl.clj index d980ac9ec..ff5c108c5 100644 --- a/lux-bootstrapper/src/lux/repl.clj +++ b/lux-bootstrapper/src/lux/repl.clj @@ -21,7 +21,7 @@ (defn ^:private init [source-dirs] (do (&compiler/init!) - (|case ((|do [_ (&compiler/compile-module source-dirs "lux") + (|case ((|do [_ (&compiler/compile-module source-dirs &/prelude) _ (&cache/delete repl-module) _ (&module/create-module repl-module 0) _ (fn [?state] diff --git a/lux-bootstrapper/src/lux/type.clj b/lux-bootstrapper/src/lux/type.clj index 8853224b5..267b6d67b 100644 --- a/lux-bootstrapper/src/lux/type.clj +++ b/lux-bootstrapper/src/lux/type.clj @@ -25,41 +25,43 @@ (def empty-env &/$Nil) -(def I64 (&/$Named (&/T ["lux" "I64"]) +(def I64 (&/$Named (&/T [&/prelude "I64"]) (&/$UnivQ empty-env (&/$Primitive "#I64" (&/|list (&/$Parameter 1)))))) (def Nat* (&/$Primitive &&host/nat-data-tag &/$Nil)) (def Rev* (&/$Primitive &&host/rev-data-tag &/$Nil)) (def Int* (&/$Primitive &&host/int-data-tag &/$Nil)) -(def Bit (&/$Named (&/T ["lux" "Bit"]) (&/$Primitive "#Bit" &/$Nil))) -(def Nat (&/$Named (&/T ["lux" "Nat"]) (&/$Apply Nat* I64))) -(def Rev (&/$Named (&/T ["lux" "Rev"]) (&/$Apply Rev* I64))) -(def Int (&/$Named (&/T ["lux" "Int"]) (&/$Apply Int* I64))) -(def Frac (&/$Named (&/T ["lux" "Frac"]) (&/$Primitive "#Frac" &/$Nil))) -(def Text (&/$Named (&/T ["lux" "Text"]) (&/$Primitive "#Text" &/$Nil))) -(def Ident (&/$Named (&/T ["lux" "Ident"]) (&/$Product Text Text))) +(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Primitive "#Bit" &/$Nil))) +(def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Apply Nat* I64))) +(def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Apply Rev* I64))) +(def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Apply Int* I64))) +(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Primitive "#Frac" &/$Nil))) +(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Primitive "#Text" &/$Nil))) +(def Ident (&/$Named (&/T [&/prelude "Ident"]) (&/$Product Text Text))) (defn Array [elemT] (&/$Primitive "#Array" (&/|list elemT))) (def Nothing - (&/$Named (&/T ["lux" "Nothing"]) + (&/$Named (&/T [&/prelude "Nothing"]) (&/$UnivQ empty-env (&/$Parameter 1)))) (def Any - (&/$Named (&/T ["lux" "Any"]) + (&/$Named (&/T [&/prelude "Any"]) (&/$ExQ empty-env (&/$Parameter 1)))) (def IO - (&/$Named (&/T ["lux/control/io" "IO"]) + (&/$Named (&/T [(str &/prelude "/control/io") "IO"]) (&/$UnivQ empty-env - (&/$Primitive "lux/type/abstract.Abstraction lux/control/io.IO" (&/|list (&/$Parameter 1)))))) + (&/$Primitive (str &/prelude "/type/abstract.Abstraction " + &/prelude "/control/io.IO") + (&/|list (&/$Parameter 1)))))) (def List - (&/$Named (&/T ["lux" "List"]) + (&/$Named (&/T [&/prelude "List"]) (&/$UnivQ empty-env (&/$Sum ;; lux;Nil @@ -70,7 +72,7 @@ (&/$Parameter 0))))))) (def Maybe - (&/$Named (&/T ["lux" "Maybe"]) + (&/$Named (&/T [&/prelude "Maybe"]) (&/$UnivQ empty-env (&/$Sum ;; lux;None @@ -80,7 +82,7 @@ ))) (def Type - (&/$Named (&/T ["lux" "Type"]) + (&/$Named (&/T [&/prelude "Type"]) (let [Type (&/$Apply (&/$Parameter 1) (&/$Parameter 0)) TypeList (&/$Apply Type List) TypePair (&/$Product Type Type)] @@ -121,18 +123,18 @@ ))))) (def Location - (&/$Named (&/T ["lux" "Location"]) + (&/$Named (&/T [&/prelude "Location"]) (&/$Product Text (&/$Product Nat Nat)))) (def Meta - (&/$Named (&/T ["lux" "Meta"]) + (&/$Named (&/T [&/prelude "Meta"]) (&/$UnivQ empty-env (&/$UnivQ empty-env (&/$Product (&/$Parameter 3) (&/$Parameter 1)))))) (def Code* - (&/$Named (&/T ["lux" "Code'"]) + (&/$Named (&/T [&/prelude "Code'"]) (let [Code (&/$Apply (&/$Apply (&/$Parameter 1) (&/$Parameter 0)) (&/$Parameter 1)) @@ -164,12 +166,12 @@ )))) (def Code - (&/$Named (&/T ["lux" "Code"]) + (&/$Named (&/T [&/prelude "Code"]) (let [w (&/$Apply Location Meta)] (&/$Apply (&/$Apply w Code*) w)))) (def Macro - (&/$Named (&/T ["lux" "Macro"]) + (&/$Named (&/T [&/prelude "Macro"]) (&/$Primitive "#Macro" &/$Nil))) (defn bound? [id] diff --git a/lux-bootstrapper/src/lux/type/host.clj b/lux-bootstrapper/src/lux/type/host.clj index 36e969046..dbf780a84 100644 --- a/lux-bootstrapper/src/lux/type/host.clj +++ b/lux-bootstrapper/src/lux/type/host.clj @@ -59,7 +59,7 @@ output))) (def ^:private Any - (&/$Named (&/T ["lux" "Any"]) + (&/$Named (&/T [&/prelude "Any"]) (&/$ExQ (&/|list) (&/$Parameter 1)))) diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 28b18227f..6163c2dfa 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -1,66 +1,67 @@ (.module: - [lux #* - [program (#+ program:)] - ["." ffi (#+ import:)] - ["." debug] - [abstract - [monad (#+ do)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO io)] - ["." function] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." product] - ["." maybe] - [text - ["%" format (#+ format)] - [encoding - ["." utf8]]] - [collection - ["." array (#+ Array)]]] - [macro - ["." template]] - [math - [number - ["n" nat] - ["i" int] - ["." i64]]] - ["." world #_ - ["." file] - ["#/." program]] - ["@" target - ["_" js]] - [tool - [compiler - ["." phase (#+ Operation Phase)] - [reference - [variable (#+ Register)]] - [language - [lux - [program (#+ Program)] - [generation (#+ Context Host)] - [analysis - [macro (#+ Expander)]] - [phase - ["." extension (#+ Extender Handler) - ["#/." bundle] - ["." analysis #_ - ["#" js]] - ["." generation #_ - ["#" js]]] - [generation - ["." reference] - ["." js - ["." runtime]]]]]] - [default - ["." platform (#+ Platform)]] - [meta - [archive (#+ Archive)] - ["." packager #_ - ["#" script]]]]]] + [library + [lux #* + [program (#+ program:)] + ["." ffi (#+ import:)] + ["." debug] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." product] + ["." maybe] + [text + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." array (#+ Array)]]] + [macro + ["." template]] + [math + [number + ["n" nat] + ["i" int] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target + ["_" js]] + [tool + [compiler + ["." phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" js]] + ["." generation #_ + ["#" js]]] + [generation + ["." reference] + ["." js + ["." runtime]]]]]] + [default + ["." platform (#+ Platform)]] + [meta + [archive (#+ Archive)] + ["." packager #_ + ["#" script]]]]]]] [program ["/" compositor ["#." cli] diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index bcd40a1f8..4d78d729c 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1,38 +1,39 @@ (.module: - [lux #* - [ffi (#+ import:)] - [type (#+ :share)] - [abstract - ["." monad (#+ do)]] - [control - ["." try (#+ Try)]] - [data - [identity (#+ Identity)] - ["." product] - [text - ["%" format (#+ format)]] - [collection - ["." list ("#@." fold)] - ["." dictionary (#+ Dictionary)] - ["." row (#+ Row) ("#@." functor fold)]]] - [math - [number - ["." nat]]] - [target - ["/" jvm]] - [tool - [compiler - ["." phase] - [language - [lux - [synthesis (#+ Synthesis)] - ["." generation] - ["." directive] - [phase - ["." extension - ["." bundle] - [directive - ["./" lux]]]]]]]]] + [library + [lux #* + [ffi (#+ import:)] + [type (#+ :share)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)]] + [data + [identity (#+ Identity)] + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." fold)] + ["." dictionary (#+ Dictionary)] + ["." row (#+ Row) ("#@." functor fold)]]] + [math + [number + ["." nat]]] + [target + ["/" jvm]] + [tool + [compiler + ["." phase] + [language + [lux + [synthesis (#+ Synthesis)] + ["." generation] + ["." directive] + [phase + ["." extension + ["." bundle] + [directive + ["./" lux]]]]]]]]]] [/// [host ["." jvm (#+ Inst) diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index a50090c5d..de92a3ba5 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -1,31 +1,32 @@ (.module: - [lux (#- Definition Type) - [ffi (#+ import:)] - [abstract - monad] - [control - ["<>" parser - ["<.>" code]]] - [data - [binary (#+ Binary)] - [collection - ["." list ("#/." functor)]]] - [macro - ["." code] - [syntax (#+ syntax:)]] - [target - [jvm - ["." type (#+ Type) - [category (#+ Class)]]]] - [tool - [compiler - [reference - [variable (#+ Register)]] - [language - [lux - ["." generation]]] - [meta - [archive (#+ Archive)]]]]]) + [library + [lux (#- Definition Type) + [ffi (#+ import:)] + [abstract + monad] + [control + ["<>" parser + ["<.>" code]]] + [data + [binary (#+ Binary)] + [collection + ["." list ("#/." functor)]]] + [macro + ["." code] + [syntax (#+ syntax:)]] + [target + [jvm + ["." type (#+ Type) + [category (#+ Class)]]]] + [tool + [compiler + [reference + [variable (#+ Register)]] + [language + [lux + ["." generation]]] + [meta + [archive (#+ Archive)]]]]]]) (import: org/objectweb/asm/MethodVisitor) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index b2012006a..58121502a 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -1,26 +1,27 @@ (.module: - [lux (#- Type) - ["." ffi (#+ import: do_to)] - [control - ["." function]] - [data - ["." product] - ["." text - ["%" format (#+ format)]] - [collection - ["." array (#+ Array)] - ["." list ("#@." functor)]]] - [math - [number - ["i" int]]] - [target - [jvm - [encoding - ["." name]] - ["." type (#+ Type Constraint) - [category (#+ Class Value Method)] - ["." signature] - ["." descriptor]]]]] + [library + [lux (#- Type) + ["." ffi (#+ import: do_to)] + [control + ["." function]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [math + [number + ["i" int]]] + [target + [jvm + [encoding + ["." name]] + ["." type (#+ Type Constraint) + [category (#+ Class Value Method)] + ["." signature] + ["." descriptor]]]]]] ["." //]) (def: signature (|>> type.signature signature.signature)) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 95de82463..8427e23e1 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -1,38 +1,39 @@ (.module: - [lux (#- Type int char try) - ["." ffi (#+ import: do_to)] - [abstract - [monad (#+ do)]] - [control - ["." function] - ["." try] - ["p" parser - ["s" code]]] - [data - ["." product] - ["." maybe] - [collection - ["." list ("#@." functor)]]] - [macro - [syntax (#+ syntax:)] - ["." code] - ["." template]] - [math - [number - ["n" nat] - ["i" int]]] - [target - [jvm - [encoding - ["." name (#+ External)]] - ["." type (#+ Type) ("#@." equivalence) - [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] - ["." box] - ["." descriptor] - ["." reflection]]]] - [tool - [compiler - [phase (#+ Operation)]]]] + [library + [lux (#- Type int char try) + ["." ffi (#+ import: do_to)] + [abstract + [monad (#+ do)]] + [control + ["." function] + ["." try] + ["p" parser + ["s" code]]] + [data + ["." product] + ["." maybe] + [collection + ["." list ("#@." functor)]]] + [macro + [syntax (#+ syntax:)] + ["." code] + ["." template]] + [math + [number + ["n" nat] + ["i" int]]] + [target + [jvm + [encoding + ["." name (#+ External)]] + ["." type (#+ Type) ("#@." equivalence) + [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] + ["." box] + ["." descriptor] + ["." reflection]]]] + [tool + [compiler + [phase (#+ Operation)]]]]] ["." // (#+ Inst)]) (def: class_name (|>> type.descriptor descriptor.class_name name.read)) diff --git a/lux-jvm/source/luxc/lang/synthesis/variable.lux b/lux-jvm/source/luxc/lang/synthesis/variable.lux index f6a45b02e..33f359239 100644 --- a/lux-jvm/source/luxc/lang/synthesis/variable.lux +++ b/lux-jvm/source/luxc/lang/synthesis/variable.lux @@ -1,6 +1,7 @@ (.module: lux - (lux (data [number] + (lux (data [library + [number]] (coll [list "list/" Fold Monoid] ["s" set]))) (luxc (lang ["la" analysis] diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 7b5df9f08..4cd521f9f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -1,39 +1,40 @@ (.module: - [lux (#- Module Definition) - ["." ffi (#+ import: do_to object)] - [abstract - [monad (#+ do)]] - [control - pipe - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO io)] - [concurrency - ["." atom (#+ Atom atom)]]] - [data - [binary (#+ Binary)] - ["." product] - ["." text ("#@." hash) - ["%" format (#+ format)]] - [collection - ["." array] - ["." dictionary (#+ Dictionary)]]] - [target - [jvm - ["." loader (#+ Library)] - ["." type - ["." descriptor]]]] - [tool - [compiler - [language - [lux - ["." version] - ["." generation]]] - [meta - [io (#+ lux_context)] - [archive - [descriptor (#+ Module)] - ["." artifact]]]]]] + [library + [lux (#- Module Definition) + ["." ffi (#+ import: do_to object)] + [abstract + [monad (#+ do)]] + [control + pipe + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + [concurrency + ["." atom (#+ Atom atom)]]] + [data + [binary (#+ Binary)] + ["." product] + ["." text ("#@." hash) + ["%" format (#+ format)]] + [collection + ["." array] + ["." dictionary (#+ Dictionary)]]] + [target + [jvm + ["." loader (#+ Library)] + ["." type + ["." descriptor]]]] + [tool + [compiler + [language + [lux + ["." version] + ["." generation]]] + [meta + [io (#+ lux_context)] + [archive + [descriptor (#+ Module)] + ["." artifact]]]]]]] [/// [host ["." jvm (#+ Inst Definition Host State) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index f3bbb2a1c..65e5dba62 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -1,30 +1,31 @@ (.module: - [lux (#- Type if let case) - [abstract - ["." monad (#+ do)]] - [control - ["." function] - ["ex" exception (#+ exception:)]] - [data - [collection - ["." list ("#@." fold)]]] - [math - [number - ["n" nat]]] - [target - [jvm - ["." type (#+ Type) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature)]]]] - [tool - [compiler - ["." phase ("operation@." monad)] - [meta - [archive (#+ Archive)]] - [language - [lux - ["." synthesis (#+ Path Synthesis)]]]]]] + [library + [lux (#- Type if let case) + [abstract + ["." monad (#+ do)]] + [control + ["." function] + ["ex" exception (#+ exception:)]] + [data + [collection + ["." list ("#@." fold)]]] + [math + [number + ["n" nat]]] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." descriptor (#+ Descriptor)] + ["." signature (#+ Signature)]]]] + [tool + [compiler + ["." phase ("operation@." monad)] + [meta + [archive (#+ Archive)]] + [language + [lux + ["." synthesis (#+ Path Synthesis)]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/common.lux index 6cd7f4f2f..10e865283 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/common.lux @@ -1,25 +1,26 @@ (.module: - [lux #* - ## [abstract - ## [monad (#+ do)]] - ## [control - ## ["." try (#+ Try)] - ## ["ex" exception (#+ exception:)] - ## ["." io]] - ## [data - ## [binary (#+ Binary)] - ## ["." text ("#/." hash) - ## format] - ## [collection - ## ["." dictionary (#+ Dictionary)]]] - ## ["." macro] - ## [host (#+ import:)] - ## [tool - ## [compiler - ## [reference (#+ Register)] - ## ["." name] - ## ["." phase]]] - ] + [library + [lux #* + ## [abstract + ## [monad (#+ do)]] + ## [control + ## ["." try (#+ Try)] + ## ["ex" exception (#+ exception:)] + ## ["." io]] + ## [data + ## [binary (#+ Binary)] + ## ["." text ("#/." hash) + ## format] + ## [collection + ## ["." dictionary (#+ Dictionary)]]] + ## ["." macro] + ## [host (#+ import:)] + ## [tool + ## [compiler + ## [reference (#+ Register)] + ## ["." name] + ## ["." phase]]] + ]] ## [luxc ## [lang ## [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux index 01425750f..44abe2444 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux @@ -1,12 +1,13 @@ (.module: - [lux #* - [tool - [compiler - [language - [lux - ["." synthesis] - [phase - ["." extension]]]]]]] + [library + [lux #* + [tool + [compiler + [language + [lux + ["." synthesis] + [phase + ["." extension]]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux index 9066dd156..2f1bd6a36 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux @@ -1,8 +1,9 @@ (.module: - [lux #* - [data - [collection - ["." dictionary]]]] + [library + [lux #* + [data + [collection + ["." dictionary]]]]] [//// [host [jvm (#+ Bundle)]]] diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index c15d1ffcf..d79362d79 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -1,37 +1,38 @@ (.module: - [lux (#- Type) - [ffi (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." try] - ["<>" parser - ["" synthesis (#+ Parser)]]] - [data - ["." product] - [collection - ["." list ("#@." monad)] - ["." dictionary]]] - [math - [number - ["f" frac]]] - [target - [jvm - ["." type]]] - [tool - [compiler - ["." phase] - [meta - [archive (#+ Archive)]] - [language - [lux - ["." synthesis (#+ Synthesis %synthesis)] - [phase - [generation - [extension (#+ Nullary Unary Binary Trinary Variadic - nullary unary binary trinary variadic)]] - ["." extension - ["." bundle]]]]]]]] + [library + [lux (#- Type) + [ffi (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." try] + ["<>" parser + ["" synthesis (#+ Parser)]]] + [data + ["." product] + [collection + ["." list ("#@." monad)] + ["." dictionary]]] + [math + [number + ["f" frac]]] + [target + [jvm + ["." type]]] + [tool + [compiler + ["." phase] + [meta + [archive (#+ Archive)]] + [language + [lux + ["." synthesis (#+ Synthesis %synthesis)] + [phase + [generation + [extension (#+ Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic)]] + ["." extension + ["." bundle]]]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index 96fa95363..69e63ab71 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -1,56 +1,57 @@ (.module: - [lux (#- Type primitive int char type) - [ffi (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." exception (#+ exception:)] - ["." function] - ["<>" parser ("#@." monad) - ["<.>" text] - ["<.>" synthesis (#+ Parser)]]] - [data - ["." product] - ["." maybe ("#@." functor)] - ["." text ("#@." equivalence) - ["%" format (#+ format)]] - [collection - ["." list ("#@." monad)] - ["." dictionary (#+ Dictionary)] - ["." set]]] - [math - [number - ["." nat]]] - [target - [jvm - ["." type (#+ Type Typed Argument) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] - ["." box] - ["." reflection] - ["." signature] - ["." parser]]]] - [tool - [compiler - ["." phase ("#@." monad)] - [reference (#+) - ["." variable (#+ Variable)]] - [meta - [archive (#+ Archive)]] - [language - [lux - [analysis (#+ Environment)] - ["." synthesis (#+ Synthesis Path %synthesis)] - ["." generation] - [phase - [generation - [extension (#+ Nullary Unary Binary - nullary unary binary)]] - [analysis - [".A" reference]] - ["." extension - ["." bundle] + [library + [lux (#- Type primitive int char type) + [ffi (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." exception (#+ exception:)] + ["." function] + ["<>" parser ("#@." monad) + ["<.>" text] + ["<.>" synthesis (#+ Parser)]]] + [data + ["." product] + ["." maybe ("#@." functor)] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#@." monad)] + ["." dictionary (#+ Dictionary)] + ["." set]]] + [math + [number + ["." nat]]] + [target + [jvm + ["." type (#+ Type Typed Argument) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." box] + ["." reflection] + ["." signature] + ["." parser]]]] + [tool + [compiler + ["." phase ("#@." monad)] + [reference (#+) + ["." variable (#+ Variable)]] + [meta + [archive (#+ Archive)]] + [language + [lux + [analysis (#+ Environment)] + ["." synthesis (#+ Synthesis Path %synthesis)] + ["." generation] + [phase + [generation + [extension (#+ Nullary Unary Binary + nullary unary binary)]] [analysis - ["/" jvm]]]]]]]]] + [".A" reference]] + ["." extension + ["." bundle] + [analysis + ["/" jvm]]]]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index a3583155b..f524dc097 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -1,38 +1,39 @@ (.module: - [lux (#- Type function) - [abstract - ["." monad (#+ do)] - ["." enum]] - [control - [pipe (#+ when> new>)] - ["." function]] - [data - ["." product] - [text - ["%" format (#+ format)]] - [collection - ["." list ("#@." functor monoid)]]] - [math - [number - ["n" nat] - ["i" int]]] - [target - [jvm - ["." type (#+ Type) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]] - [tool - [compiler - [arity (#+ Arity)] - ["." phase] - [reference - [variable (#+ Register)]] - [language - [lux - [analysis (#+ Environment)] - [synthesis (#+ Synthesis Abstraction Apply)] - ["." generation (#+ Context)]]] - [meta - [archive (#+ Archive)]]]]] + [library + [lux (#- Type function) + [abstract + ["." monad (#+ do)] + ["." enum]] + [control + [pipe (#+ when> new>)] + ["." function]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor monoid)]]] + [math + [number + ["n" nat] + ["i" int]]] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]] + [tool + [compiler + [arity (#+ Arity)] + ["." phase] + [reference + [variable (#+ Register)]] + [language + [lux + [analysis (#+ Environment)] + [synthesis (#+ Synthesis Abstraction Apply)] + ["." generation (#+ Context)]]] + [meta + [archive (#+ Archive)]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux index 5ad997539..d17d3dfe2 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -1,24 +1,25 @@ (.module: - [lux #* - [abstract - ["." monad (#+ do)]] - [control - ["." function]] - [data - [collection - ["." list ("#@." functor monoid)]]] - [math - [number - ["n" nat]]] - [tool - [compiler - ["." phase] - [reference - [variable (#+ Register)]] - [language - [lux - ["." synthesis (#+ Synthesis)] - ["." generation]]]]]] + [library + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + [collection + ["." list ("#@." functor monoid)]]] + [math + [number + ["n" nat]]] + [tool + [compiler + ["." phase] + [reference + [variable (#+ Register)]] + [language + [lux + ["." synthesis (#+ Synthesis)] + ["." generation]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 5f3a98b0f..1bced2ffc 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -1,15 +1,16 @@ (.module: - [lux (#- i64) - ["." ffi (#+ import:)] - [math - [number - ["i" int]]] - [target - [jvm - ["." type]]] - [tool - [compiler - [phase ("operation@." monad)]]]] + [library + [lux (#- i64) + ["." ffi (#+ import:)] + [math + [number + ["i" int]]] + [target + [jvm + ["." type]]] + [tool + [compiler + [phase ("operation@." monad)]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux index 234c20fa9..1ebdf33f0 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/program.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -1,17 +1,18 @@ (.module: - [lux #* - [data - [text - ["%" format (#+ format)]]] - [target - [jvm - ["$t" type]]] - [tool - [compiler - [language - [lux - [generation (#+ Context)] - [program (#+ Program)]]]]]] + [library + [lux #* + [data + [text + ["%" format (#+ format)]]] + [target + [jvm + ["$t" type]]] + [tool + [compiler + [language + [lux + [generation (#+ Context)] + [program (#+ Program)]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux index d2a524a82..bfbda85be 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux @@ -1,23 +1,24 @@ (.module: - [lux #* - [abstract - [monad (#+ do)]] - [data - [text - ["%" format (#+ format)]]] - [target - [jvm - ["." type]]] - [tool - [compiler - [reference - ["." variable (#+ Register Variable)]] - ["." phase ("operation@." monad)] - [meta - [archive (#+ Archive)]] - [language - [lux - ["." generation]]]]]] + [library + [lux #* + [abstract + [monad (#+ do)]] + [data + [text + ["%" format (#+ format)]]] + [target + [jvm + ["." type]]] + [tool + [compiler + [reference + ["." variable (#+ Register Variable)]] + ["." phase ("operation@." monad)] + [meta + [archive (#+ Archive)]] + [language + [lux + ["." generation]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index cd719679d..20bd9bd9e 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -1,35 +1,36 @@ (.module: - [lux (#- Type try) - [abstract - [monad (#+ do)] - ["." enum]] - [data - [binary (#+ Binary)] - ["." product] - [text - ["%" format (#+ format)]] - [collection - ["." list ("#@." functor)] - ["." row]]] - ["." math - [number - ["n" nat]]] - [target - [jvm - ["." type (#+ Type) - ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] - ["." reflection]]]] - [tool - [compiler - [arity (#+ Arity)] - ["." phase] - [language - [lux - ["." synthesis] - ["." generation]]] - [meta - [archive (#+ Output) - ["." artifact (#+ Registry)]]]]]] + [library + [lux (#- Type try) + [abstract + [monad (#+ do)] + ["." enum]] + [data + [binary (#+ Binary)] + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)] + ["." row]]] + ["." math + [number + ["n" nat]]] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] + ["." reflection]]]] + [tool + [compiler + [arity (#+ Arity)] + ["." phase] + [language + [lux + ["." synthesis] + ["." generation]]] + [meta + [archive (#+ Output) + ["." artifact (#+ Registry)]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index 100bce9d9..16b320b6d 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -1,33 +1,34 @@ (.module: - [lux (#- Type) - ["." ffi (#+ import:)] - [abstract - ["." monad (#+ do)]] - [control - ["." exception (#+ exception:)]] - [data - [text - ["%" format (#+ format)]] - [collection - ["." list]]] - [math - [number - ["n" nat] - ["i" int]]] - [target - [jvm - ["." type (#+ Type) - ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] - ["." descriptor (#+ Descriptor)] - ["." signature (#+ Signature)]]]] - [tool - [compiler - ["." phase] - [meta - [archive (#+ Archive)]] - [language - [lux - [synthesis (#+ Synthesis)]]]]]] + [library + [lux (#- Type) + ["." ffi (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + [number + ["n" nat] + ["i" int]]] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." descriptor (#+ Descriptor)] + ["." signature (#+ Signature)]]]] + [tool + [compiler + ["." phase] + [meta + [archive (#+ Archive)]] + [language + [lux + [synthesis (#+ Synthesis)]]]]]]] [luxc [lang [host diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index e9f58a71b..185d2d9ba 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -1,60 +1,61 @@ (.module: - [lux (#- Definition) - [program (#+ program:)] - ["@" target] - ["." ffi (#+ import:)] - [abstract - [monad (#+ do)]] - [control - ["." io (#+ IO)] - ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." product] - [text - ["%" format (#+ format)]] - [collection - [array (#+ Array)] - ["." dictionary]]] - ["." world #_ - ["." file] - ["#/." program]] - [target - ["." jvm #_ - [bytecode (#+ Bytecode)] - ["#/." type - ["#/." box]]]] - [tool - [compiler - [reference (#+)] - ["." phase] - [default - ["." platform (#+ Platform)]] - [meta - [archive (#+ Archive)] - ["." packager #_ - ["#" jvm]]] - [language - [lux - ["$" synthesis (#+ Synthesis)] - ["." generation] - [analysis - [macro (#+ Expander)]] - [phase - [extension (#+ Phase Bundle Operation Handler Extender) - ["." analysis #_ - ["#" jvm]] - ## ["." generation #_ - ## ["#" jvm]] - ## ["." directive #_ - ## ["#" jvm]] - ] - [generation - ["." jvm #_ - ["#/." runtime] - ## ["#/." host] - ]]]]]]]] + [library + [lux (#- Definition) + [program (#+ program:)] + ["@" target] + ["." ffi (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + [array (#+ Array)] + ["." dictionary]]] + ["." world #_ + ["." file] + ["#/." program]] + [target + ["." jvm #_ + [bytecode (#+ Bytecode)] + ["#/." type + ["#/." box]]]] + [tool + [compiler + [reference (#+)] + ["." phase] + [default + ["." platform (#+ Platform)]] + [meta + [archive (#+ Archive)] + ["." packager #_ + ["#" jvm]]] + [language + [lux + ["$" synthesis (#+ Synthesis)] + ["." generation] + [analysis + [macro (#+ Expander)]] + [phase + [extension (#+ Phase Bundle Operation Handler Extender) + ["." analysis #_ + ["#" jvm]] + ## ["." generation #_ + ## ["#" jvm]] + ## ["." directive #_ + ## ["#" jvm]] + ] + [generation + ["." jvm #_ + ["#/." runtime] + ## ["#/." host] + ]]]]]]]]] [program ["/" compositor ["/." cli] diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 083c8ca0c..6c7719220 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -1,64 +1,65 @@ (.module: - [lux #* - [program (#+ program:)] - ["." ffi] - [abstract - ["." monad (#+ do)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO io)] - ["." function] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." maybe] - ["." text ("#\." hash) - ["%" format (#+ format)] - [encoding - ["." utf8]]] - [collection - ["." array (#+ Array)] - ["." list]]] - [macro - ["." template]] - [math - [number (#+ hex) - ["n" nat] - ["." i64]]] - ["." world #_ - ["." file] - ["#/." program]] - ["@" target - ["_" lua]] - [tool - [compiler - ["." phase (#+ Operation Phase)] - [reference - [variable (#+ Register)]] - [language - [lux - [program (#+ Program)] - [generation (#+ Context Host)] - [analysis - [macro (#+ Expander)]] - [phase - ["." extension (#+ Extender Handler) - ["#/." bundle] - ["." analysis #_ - ["#" lua]] - ["." generation #_ - ["#" lua]]] - [generation - ["." reference] - ["." lua - ["." runtime]]]]]] - [default - ["." platform (#+ Platform)]] - [meta - [archive (#+ Archive)] - ["." packager #_ - ["#" script]]]]]] + [library + [lux #* + [program (#+ program:)] + ["." ffi] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." maybe] + ["." text ("#\." hash) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." array (#+ Array)] + ["." list]]] + [macro + ["." template]] + [math + [number (#+ hex) + ["n" nat] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target + ["_" lua]] + [tool + [compiler + ["." phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" lua]] + ["." generation #_ + ["#" lua]]] + [generation + ["." reference] + ["." lua + ["." runtime]]]]]] + [default + ["." platform (#+ Platform)]] + [meta + [archive (#+ Archive)] + ["." packager #_ + ["#" script]]]]]]] [program ["/" compositor ["#." cli] diff --git a/lux-php/source/lux.lux b/lux-php/source/lux.lux new file mode 120000 index 000000000..73d05a22e --- /dev/null +++ b/lux-php/source/lux.lux @@ -0,0 +1 @@ +/home/eduardoejp/lux/stdlib/source/lux.lux \ No newline at end of file diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 2fc611fe4..f00594c99 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -1,66 +1,67 @@ (.module: - [lux #* - [program (#+ program:)] - ["." ffi (#+ import:)] - [abstract - [monad (#+ do)]] - [control - [pipe (#+ new>)] - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO io)] - ["." function] - [concurrency - ["." promise (#+ Promise)]]] - [data - ["." maybe] - ["." text ("#\." hash) - ["%" format (#+ format)] - [encoding - ["." utf8]]] - [collection - ["." array (#+ Array)] - ["." list]]] - [macro - ["." template]] - [math - [number - ["n" nat] - ["." i64]]] - ["." world #_ - ["." file] - ["#/." program]] - ["@" target - ["_" python]] - [tool - [compiler - ["." phase (#+ Operation Phase)] - [reference - [variable (#+ Register)]] - [language - [lux - [program (#+ Program)] - [generation (#+ Context Host)] - ["." synthesis] - [analysis - [macro (#+ Expander)]] - [phase - ["." extension (#+ Extender Handler) - ["#/." bundle] - ["." analysis #_ - ["#" python]] - ["." generation #_ - ["#" python]]] - [generation - ["." reference] - ["." python - ["." runtime]]]]]] - [default - ["." platform (#+ Platform)]] - [meta - [archive (#+ Archive)] - ["." packager #_ - ["#" script]]]]]] + [library + [lux #* + [program (#+ program:)] + ["." ffi (#+ import:)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ new>)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." maybe] + ["." text ("#\." hash) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." array (#+ Array)] + ["." list]]] + [macro + ["." template]] + [math + [number + ["n" nat] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target + ["_" python]] + [tool + [compiler + ["." phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + ["." synthesis] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" python]] + ["." generation #_ + ["#" python]]] + [generation + ["." reference] + ["." python + ["." runtime]]]]]] + [default + ["." platform (#+ Platform)]] + [meta + [archive (#+ Archive)] + ["." packager #_ + ["#" script]]]]]]] [program ["/" compositor ["/." cli] diff --git a/lux-ruby/source/program.lux b/lux-ruby/source/program.lux index 91d9980d2..a221e6529 100644 --- a/lux-ruby/source/program.lux +++ b/lux-ruby/source/program.lux @@ -1,73 +1,74 @@ (.module: - [lux #* - [program (#+ program:)] - ["." debug] - ["." ffi (#+ import:)] - ["." meta] - [abstract - ["." monad (#+ do)]] - [control - [pipe (#+ new>)] - ["." try (#+ Try)] - ["." exception (#+ exception:)] - ["." io (#+ IO io)] - ["." function] - [concurrency - ["." promise (#+ Promise)]] - ["<>" parser - ["<.>" code]]] - [data - ["." maybe] - ["." text ("#\." hash) - ["%" format (#+ format)] - [encoding - ["." utf8]]] - [collection - ["." array (#+ Array)] - ["." list]]] - ["." macro - [syntax (#+ syntax:)] - ["." template] - ["." code]] - [math - [number (#+ hex) - ["n" nat] - ["i" int] - ["." i64]]] - ["." world #_ - ["." file] - ["#/." program]] - ["@" target - ["_" ruby]] - [tool - [compiler - ["." phase (#+ Operation Phase)] - [reference - [variable (#+ Register)]] - [language - [lux - [program (#+ Program)] - [generation (#+ Context Host)] - ["." synthesis] - [analysis - [macro (#+ Expander)]] - [phase - ["." extension (#+ Extender Handler) - ["#/." bundle] - ["." analysis #_ - ["#" ruby]] - ["." generation #_ - ["#" ruby]]] - [generation - ["." reference] - ["." ruby - ["." runtime]]]]]] - [default - ["." platform (#+ Platform)]] - [meta - [archive (#+ Archive)] - ["." packager #_ - ["#" script]]]]]] + [library + [lux #* + [program (#+ program:)] + ["." debug] + ["." ffi (#+ import:)] + ["." meta] + [abstract + ["." monad (#+ do)]] + [control + [pipe (#+ new>)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["." function] + [concurrency + ["." promise (#+ Promise)]] + ["<>" parser + ["<.>" code]]] + [data + ["." maybe] + ["." text ("#\." hash) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." array (#+ Array)] + ["." list]]] + ["." macro + [syntax (#+ syntax:)] + ["." template] + ["." code]] + [math + [number (#+ hex) + ["n" nat] + ["i" int] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target + ["_" ruby]] + [tool + [compiler + ["." phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + ["." synthesis] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" ruby]] + ["." generation #_ + ["#" ruby]]] + [generation + ["." reference] + ["." ruby + ["." runtime]]]]]] + [default + ["." platform (#+ Platform)]] + [meta + [archive (#+ Archive)] + ["." packager #_ + ["#" script]]]]]]] [program ["/" compositor ["/." cli] diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux new file mode 100644 index 000000000..3a7fa442b --- /dev/null +++ b/stdlib/source/library/lux.lux @@ -0,0 +1,5958 @@ +("lux def" dummy_location + ["" 0 0] + [["" 0 0] (9 #1 (0 #0))] + #0) + +("lux def" double_quote + ("lux i64 char" +34) + [dummy_location (9 #1 (0 #0))] + #0) + +("lux def" \n + ("lux i64 char" +10) + [dummy_location (9 #1 (0 #0))] + #0) + +("lux def" __paragraph + ("lux text concat" \n \n) + [dummy_location (9 #1 (0 #0))] + #0) + +("lux def" prelude_module + "library/lux" + [dummy_location (9 #1 (0 #0))] + #1) + +## (type: Any +## (Ex [a] a)) +("lux def" Any + ("lux type check type" + (9 #1 [..prelude_module "Any"] + (8 #0 (0 #0) (4 #0 1)))) + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is irrelevant." __paragraph) + "It can be used to write functions or data-structures that can take, or return, anything."))]] + (0 #0)))] + #1) + +## (type: Nothing +## (All [a] a)) +("lux def" Nothing + ("lux type check type" + (9 #1 [..prelude_module "Nothing"] + (7 #0 (0 #0) (4 #0 1)))) + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 ("lux text concat" + ("lux text concat" "The type of things whose type is undefined." __paragraph) + "Useful for expressions that cause errors or other 'extraordinary' conditions."))]] + (0 #0)))] + #1) + +## (type: (List a) +## #Nil +## (#Cons a (List a))) +("lux def type tagged" List + (9 #1 [..prelude_module "List"] + (7 #0 (0 #0) + (1 #0 ## "lux.Nil" + Any + ## "lux.Cons" + (2 #0 (4 #0 1) + (9 #0 (4 #0 1) (4 #0 0)))))) + [dummy_location + (9 #1 (0 #1 [[dummy_location (7 #0 [..prelude_module "type-args"])] + [dummy_location (9 #0 (0 #1 [dummy_location (5 #0 "a")] (0 #0)))]] + (0 #1 [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "A potentially empty list of values.")]] + (0 #0))))] + ["Nil" "Cons"] + #1) + +("lux def" Bit + ("lux type check type" + (9 #1 [..prelude_module "Bit"] + (0 #0 "#Bit" #Nil))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill boolean values (as bits).")]] + #Nil))] + #1) + +("lux def" I64 + ("lux type check type" + (9 #1 [..prelude_module "I64"] + (7 #0 (0 #0) + (0 #0 "#I64" (#Cons (4 #0 1) #Nil))))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "64-bit integers without any semantics.")]] + #Nil))] + #1) + +("lux def" Nat + ("lux type check type" + (9 #1 [..prelude_module "Nat"] + (0 #0 "#I64" (#Cons (0 #0 "#Nat" #Nil) #Nil)))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 ("lux text concat" + ("lux text concat" "Natural numbers (unsigned integers)." __paragraph) + "They start at zero (0) and extend in the positive direction."))]] + #Nil))] + #1) + +("lux def" Int + ("lux type check type" + (9 #1 [..prelude_module "Int"] + (0 #0 "#I64" (#Cons (0 #0 "#Int" #Nil) #Nil)))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill integer numbers.")]] + #Nil))] + #1) + +("lux def" Rev + ("lux type check type" + (9 #1 [..prelude_module "Rev"] + (0 #0 "#I64" (#Cons (0 #0 "#Rev" #Nil) #Nil)))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 ("lux text concat" + ("lux text concat" "Fractional numbers that live in the interval [0,1)." __paragraph) + "Useful for probability, and other domains that work within that interval."))]] + #Nil))] + #1) + +("lux def" Frac + ("lux type check type" + (9 #1 [..prelude_module "Frac"] + (0 #0 "#Frac" #Nil))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill floating-point (fractional) numbers.")]] + #Nil))] + #1) + +("lux def" Text + ("lux type check type" + (9 #1 [..prelude_module "Text"] + (0 #0 "#Text" #Nil))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "Your standard, run-of-the-mill string values.")]] + #Nil))] + #1) + +("lux def" Name + ("lux type check type" + (9 #1 [..prelude_module "Name"] + (2 #0 Text Text))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "A name. It is used as part of Lux syntax to represent identifiers and tags.")]] + #Nil))] + #1) + +## (type: (Maybe a) +## #None +## (#Some a)) +("lux def type tagged" Maybe + (9 #1 [..prelude_module "Maybe"] + (7 #0 #Nil + (1 #0 ## "lux.None" + Any + ## "lux.Some" + (4 #0 1)))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "a")] #Nil))]] + (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "A potentially missing value.")]] + #Nil)))] + ["None" "Some"] + #1) + +## (type: #rec Type +## (#Primitive Text (List Type)) +## (#Sum Type Type) +## (#Product Type Type) +## (#Function Type Type) +## (#Parameter Nat) +## (#Var Nat) +## (#Ex Nat) +## (#UnivQ (List Type) Type) +## (#ExQ (List Type) Type) +## (#Apply Type Type) +## (#Named Name Type) +## ) +("lux def type tagged" Type + (9 #1 [..prelude_module "Type"] + ({Type + ({Type_List + ({Type_Pair + (9 #0 Nothing + (7 #0 #Nil + (1 #0 ## "lux.Primitive" + (2 #0 Text Type_List) + (1 #0 ## "lux.Sum" + Type_Pair + (1 #0 ## "lux.Product" + Type_Pair + (1 #0 ## "lux.Function" + Type_Pair + (1 #0 ## "lux.Parameter" + Nat + (1 #0 ## "lux.Var" + Nat + (1 #0 ## "lux.Ex" + Nat + (1 #0 ## "lux.UnivQ" + (2 #0 Type_List Type) + (1 #0 ## "lux.ExQ" + (2 #0 Type_List Type) + (1 #0 ## "lux.Apply" + Type_Pair + ## "lux.Named" + (2 #0 Name Type)))))))))))))} + ("lux type check type" (2 #0 Type Type)))} + ("lux type check type" (9 #0 Type List)))} + ("lux type check type" (9 #0 (4 #0 1) (4 #0 0))))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "This type represents the data-structures that are used to specify types themselves.")]] + (#Cons [[dummy_location (7 #0 [..prelude_module "type-rec?"])] + [dummy_location (0 #0 #1)]] + #Nil)))] + ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"] + #1) + +## (type: Location +## {#module Text +## #line Nat +## #column Nat}) +("lux def type tagged" Location + (#Named [..prelude_module "Location"] + (#Product Text (#Product Nat Nat))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "Locations are for specifying the location of Code nodes in Lux files during compilation.")]] + #Nil))] + ["module" "line" "column"] + #1) + +## (type: (Ann m v) +## {#meta m +## #datum v}) +("lux def type tagged" Ann + (#Named [..prelude_module "Ann"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product (#Parameter 3) + (#Parameter 1))))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "doc"])] + [dummy_location (5 #0 "The type of things that can be annotated with meta-data of arbitrary types.")]] + (#Cons [[dummy_location (7 #0 [..prelude_module "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "m")] (#Cons [dummy_location (5 #0 "v")] #Nil)))]] + #Nil)))] + ["meta" "datum"] + #1) + +## (type: (Code' w) +## (#Bit Bit) +## (#Nat Nat) +## (#Int Int) +## (#Rev Rev) +## (#Frac Frac) +## (#Text Text) +## (#Identifier Name) +## (#Tag Name) +## (#Form (List (w (Code' w)))) +## (#Tuple (List (w (Code' w)))) +## (#Record (List [(w (Code' w)) (w (Code' w))]))) +("lux def type tagged" Code' + (#Named [..prelude_module "Code'"] + ({Code + ({Code_List + (#UnivQ #Nil + (#Sum ## "lux.Bit" + Bit + (#Sum ## "lux.Nat" + Nat + (#Sum ## "lux.Int" + Int + (#Sum ## "lux.Rev" + Rev + (#Sum ## "lux.Frac" + Frac + (#Sum ## "lux.Text" + Text + (#Sum ## "lux.Identifier" + Name + (#Sum ## "lux.Tag" + Name + (#Sum ## "lux.Form" + Code_List + (#Sum ## "lux.Tuple" + Code_List + ## "lux.Record" + (#Apply (#Product Code Code) List) + )))))))))) + )} + ("lux type check type" (#Apply Code List)))} + ("lux type check type" (#Apply (#Apply (#Parameter 1) + (#Parameter 0)) + (#Parameter 1))))) + [dummy_location + (9 #1 (#Cons [[dummy_location (7 #0 [..prelude_module "type-args"])] + [dummy_location (9 #0 (#Cons [dummy_location (5 #0 "w")] #Nil))]] + #Nil))] + ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"] + #1) + +## (type: Code +## (Ann Location (Code' (Ann Location)))) +("lux def" Code + (#Named [..prelude_module "Code"] + ({w + (#Apply (#Apply w Code') w)} + ("lux type check type" (#Apply Location Ann)))) + [dummy_location + (#Record (#Cons [[dummy_location (#Tag [..prelude_module "doc"])] + [dummy_location (#Text "The type of Code nodes for Lux syntax.")]] + #Nil))] + #1) + +("lux def" _ann + ("lux type check" + (#Function (#Apply (#Apply Location Ann) + Code') + Code) + ([_ data] + [dummy_location data])) + [dummy_location (#Record #Nil)] + #0) + +("lux def" bit$ + ("lux type check" (#Function Bit Code) + ([_ value] (_ann (#Bit value)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" nat$ + ("lux type check" (#Function Nat Code) + ([_ value] (_ann (#Nat value)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" int$ + ("lux type check" (#Function Int Code) + ([_ value] (_ann (#Int value)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" rev$ + ("lux type check" (#Function Rev Code) + ([_ value] (_ann (#Rev value)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" frac$ + ("lux type check" (#Function Frac Code) + ([_ value] (_ann (#Frac value)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" text$ + ("lux type check" (#Function Text Code) + ([_ text] (_ann (#Text text)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" identifier$ + ("lux type check" (#Function Name Code) + ([_ name] (_ann (#Identifier name)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" local_identifier$ + ("lux type check" (#Function Text Code) + ([_ name] (_ann (#Identifier ["" name])))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" tag$ + ("lux type check" (#Function Name Code) + ([_ name] (_ann (#Tag name)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" local_tag$ + ("lux type check" (#Function Text Code) + ([_ name] (_ann (#Tag ["" name])))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" form$ + ("lux type check" (#Function (#Apply Code List) Code) + ([_ tokens] (_ann (#Form tokens)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" tuple$ + ("lux type check" (#Function (#Apply Code List) Code) + ([_ tokens] (_ann (#Tuple tokens)))) + [dummy_location (#Record #Nil)] + #0) + +("lux def" record$ + ("lux type check" (#Function (#Apply (#Product Code Code) List) Code) + ([_ tokens] (_ann (#Record tokens)))) + [dummy_location (#Record #Nil)] + #0) + +## (type: Definition +## [Bit Type Code Any]) +("lux def" Definition + ("lux type check type" + (#Named [..prelude_module "Definition"] + (#Product Bit (#Product Type (#Product Code Any))))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "Represents all the data associated with a definition: its type, its annotations, and its value.")] + #Nil)) + #1) + +## (type: Alias +## Name) +("lux def" Alias + ("lux type check type" + (#Named [..prelude_module "Alias"] + Name)) + (record$ #Nil) + #1) + +## (type: Global +## (#Alias Alias) +## (#Definition Definition)) +("lux def type tagged" Global + (#Named [..prelude_module "Global"] + (#Sum Alias + Definition)) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "Represents all the data associated with a global constant.")] + #Nil)) + ["Alias" "Definition"] + #1) + +## (type: (Bindings k v) +## {#counter Nat +## #mappings (List [k v])}) +("lux def type tagged" Bindings + (#Named [..prelude_module "Bindings"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Product ## "lux.counter" + Nat + ## "lux.mappings" + (#Apply (#Product (#Parameter 3) + (#Parameter 1)) + List))))) + (record$ (#Cons [(tag$ [..prelude_module "type-args"]) + (tuple$ (#Cons (text$ "k") (#Cons (text$ "v") #Nil)))] + #Nil)) + ["counter" "mappings"] + #1) + +## (type: #export Ref +## (#Local Nat) +## (#Captured Nat)) +("lux def type tagged" Ref + (#Named [..prelude_module "Ref"] + (#Sum ## Local + Nat + ## Captured + Nat)) + (record$ #Nil) + ["Local" "Captured"] + #1) + +## (type: Scope +## {#name (List Text) +## #inner Nat +## #locals (Bindings Text [Type Nat]) +## #captured (Bindings Text [Type Ref])}) +("lux def type tagged" Scope + (#Named [..prelude_module "Scope"] + (#Product ## name + (#Apply Text List) + (#Product ## inner + Nat + (#Product ## locals + (#Apply (#Product Type Nat) (#Apply Text Bindings)) + ## captured + (#Apply (#Product Type Ref) (#Apply Text Bindings)))))) + (record$ #Nil) + ["name" "inner" "locals" "captured"] + #1) + +("lux def" Code_List + ("lux type check type" + (#Apply Code List)) + (record$ #Nil) + #0) + +## (type: (Either l r) +## (#Left l) +## (#Right r)) +("lux def type tagged" Either + (#Named [..prelude_module "Either"] + (#UnivQ #Nil + (#UnivQ #Nil + (#Sum ## "lux.Left" + (#Parameter 3) + ## "lux.Right" + (#Parameter 1))))) + (record$ (#Cons [(tag$ [..prelude_module "type-args"]) + (tuple$ (#Cons (text$ "l") (#Cons (text$ "r") #Nil)))] + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "A choice between two values of different types.")] + #Nil))) + ["Left" "Right"] + #1) + +## (type: Source +## [Location Nat Text]) +("lux def" Source + ("lux type check type" + (#Named [..prelude_module "Source"] + (#Product Location (#Product Nat Text)))) + (record$ #Nil) + #1) + +## (type: Module_State +## #Active +## #Compiled +## #Cached) +("lux def type tagged" Module_State + (#Named [..prelude_module "Module_State"] + (#Sum + ## #Active + Any + (#Sum + ## #Compiled + Any + ## #Cached + Any))) + (record$ #Nil) + ["Active" "Compiled" "Cached"] + #1) + +## (type: Module +## {#module_hash Nat +## #module_aliases (List [Text Text]) +## #definitions (List [Text Global]) +## #imports (List Text) +## #tags (List [Text [Nat (List Name) Bit Type]]) +## #types (List [Text [(List Name) Bit Type]]) +## #module_annotations (Maybe Code) +## #module_state Module_State}) +("lux def type tagged" Module + (#Named [..prelude_module "Module"] + (#Product ## "lux.module_hash" + Nat + (#Product ## "lux.module_aliases" + (#Apply (#Product Text Text) List) + (#Product ## "lux.definitions" + (#Apply (#Product Text Global) List) + (#Product ## "lux.imports" + (#Apply Text List) + (#Product ## "lux.tags" + (#Apply (#Product Text + (#Product Nat + (#Product (#Apply Name List) + (#Product Bit + Type)))) + List) + (#Product ## "lux.types" + (#Apply (#Product Text + (#Product (#Apply Name List) + (#Product Bit + Type))) + List) + (#Product ## "lux.module_annotations" + (#Apply Code Maybe) + Module_State)) + )))))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "All the information contained within a Lux module.")] + #Nil)) + ["module_hash" "module_aliases" "definitions" "imports" "tags" "types" "module_annotations" "module_state"] + #1) + +## (type: Type_Context +## {#ex_counter Nat +## #var_counter Nat +## #var_bindings (List [Nat (Maybe Type)])}) +("lux def type tagged" Type_Context + (#Named [..prelude_module "Type_Context"] + (#Product ## ex_counter + Nat + (#Product ## var_counter + Nat + ## var_bindings + (#Apply (#Product Nat (#Apply Type Maybe)) + List)))) + (record$ #Nil) + ["ex_counter" "var_counter" "var_bindings"] + #1) + +## (type: Mode +## #Build +## #Eval +## #Interpreter) +("lux def type tagged" Mode + (#Named [..prelude_module "Mode"] + (#Sum ## Build + Any + (#Sum ## Eval + Any + ## Interpreter + Any))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "A sign that shows the conditions under which the compiler is running.")] + #Nil)) + ["Build" "Eval" "Interpreter"] + #1) + +## (type: Info +## {#target Text +## #version Text +## #mode Mode}) +("lux def type tagged" Info + (#Named [..prelude_module "Info"] + (#Product + ## target + Text + (#Product + ## version + Text + ## mode + Mode))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "Information about the current version and type of compiler that is running.")] + #Nil)) + ["target" "version" "mode"] + #1) + +## (type: Lux +## {#info Info +## #source Source +## #location Location +## #current_module (Maybe Text) +## #modules (List [Text Module]) +## #scopes (List Scope) +## #type_context Type_Context +## #expected (Maybe Type) +## #seed Nat +## #scope_type_vars (List Nat) +## #extensions Any +## #host Any}) +("lux def type tagged" Lux + (#Named [..prelude_module "Lux"] + (#Product ## "lux.info" + Info + (#Product ## "lux.source" + Source + (#Product ## "lux.location" + Location + (#Product ## "lux.current_module" + (#Apply Text Maybe) + (#Product ## "lux.modules" + (#Apply (#Product Text Module) List) + (#Product ## "lux.scopes" + (#Apply Scope List) + (#Product ## "lux.type_context" + Type_Context + (#Product ## "lux.expected" + (#Apply Type Maybe) + (#Product ## "lux.seed" + Nat + (#Product ## scope_type_vars + (#Apply Nat List) + (#Product ## extensions + Any + ## "lux.host" + Any)))))))))))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "Represents the state of the Lux compiler during a run." __paragraph) + ("lux text concat" + ("lux text concat" "It is provided to macros during their invocation, so they can access compiler data." __paragraph) + "Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")))] + #Nil)) + ["info" "source" "location" "current_module" "modules" "scopes" "type_context" "expected" "seed" "scope_type_vars" "extensions" "host"] + #1) + +## (type: (Meta a) +## (-> Lux (Either Text [Lux a]))) +("lux def" Meta + ("lux type check type" + (#Named [..prelude_module "Meta"] + (#UnivQ #Nil + (#Function Lux + (#Apply (#Product Lux (#Parameter 1)) + (#Apply Text Either)))))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "Computations that can have access to the state of the compiler." __paragraph) + "These computations may fail, or modify the state of the compiler."))] + (#Cons [(tag$ [..prelude_module "type-args"]) + (tuple$ (#Cons (text$ "a") #Nil))] + #Nil))) + #1) + +## (type: Macro' +## (-> (List Code) (Meta (List Code)))) +("lux def" Macro' + ("lux type check type" + (#Named [..prelude_module "Macro'"] + (#Function Code_List (#Apply Code_List Meta)))) + (record$ #Nil) + #1) + +## (type: Macro +## (primitive "#Macro")) +("lux def" Macro + ("lux type check type" + (#Named [..prelude_module "Macro"] + (#Primitive "#Macro" #Nil))) + (record$ (#Cons [(tag$ [..prelude_module "doc"]) + (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] + #Nil)) + #1) + +## Base functions & macros +("lux def" return + ("lux type check" + (#UnivQ #Nil + (#Function (#Parameter 1) + (#Function Lux + (#Apply (#Product Lux + (#Parameter 1)) + (#Apply Text Either))))) + ([_ val] + ([_ state] + (#Right state val)))) + (record$ #Nil) + #0) + +("lux def" fail + ("lux type check" + (#UnivQ #Nil + (#Function Text + (#Function Lux + (#Apply (#Product Lux + (#Parameter 1)) + (#Apply Text Either))))) + ([_ msg] + ([_ state] + (#Left msg)))) + (record$ #Nil) + #0) + +("lux def" let'' + ("lux macro" + ([_ tokens] + ({(#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (record$ (#Cons [lhs body] #Nil)) (#Cons rhs #Nil))) + #Nil)) + + _ + (fail "Wrong syntax for let''")} + tokens))) + (record$ #.Nil) + #0) + +("lux def" function'' + ("lux macro" + ([_ tokens] + ({(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) + (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier ["" ""])) + (#Cons arg #Nil)))) + (#Cons ({#Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Identifier [..prelude_module "function''"])) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))} + args') + #Nil)))) + #Nil)) + + (#Cons [_ (#Identifier ["" self])] (#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil))) + (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier ["" self])) + (#Cons arg #Nil)))) + (#Cons ({#Nil + body + + _ + (_ann (#Form (#Cons (_ann (#Identifier [..prelude_module "function''"])) + (#Cons (_ann (#Tuple args')) + (#Cons body #Nil)))))} + args') + #Nil)))) + #Nil)) + + _ + (fail "Wrong syntax for function''")} + tokens))) + (record$ #.Nil) + #0) + +("lux def" location_code + ("lux type check" Code + (tuple$ (#Cons (text$ "") (#Cons (nat$ 0) (#Cons (nat$ 0) #Nil))))) + (record$ #Nil) + #0) + +("lux def" meta_code + ("lux type check" (#Function Name (#Function Code Code)) + ([_ tag] + ([_ value] + (tuple$ (#Cons location_code + (#Cons (form$ (#Cons (tag$ tag) (#Cons value #Nil))) + #Nil)))))) + (record$ #Nil) + #0) + +("lux def" flag_meta + ("lux type check" (#Function Text Code) + ([_ tag] + (tuple$ (#Cons [(meta_code [..prelude_module "Tag"] (tuple$ (#Cons (text$ ..prelude_module) (#Cons (text$ tag) #Nil)))) + (#Cons [(meta_code [..prelude_module "Bit"] (bit$ #1)) + #Nil])])))) + (record$ #Nil) + #0) + +("lux def" doc_meta + ("lux type check" (#Function Text (#Product Code Code)) + (function'' [doc] [(tag$ [..prelude_module "doc"]) (text$ doc)])) + (record$ #Nil) + #0) + +("lux def" as_def + ("lux type check" (#Function Code (#Function Code (#Function Code (#Function Bit Code)))) + (function'' [name value annotations exported?] + (form$ (#Cons (text$ "lux def") (#Cons name (#Cons value (#Cons annotations (#Cons (bit$ exported?) #Nil)))))))) + (record$ #Nil) + #0) + +("lux def" as_checked + ("lux type check" (#Function Code (#Function Code Code)) + (function'' [type value] + (form$ (#Cons (text$ "lux type check") (#Cons type (#Cons value #Nil)))))) + (record$ #Nil) + #0) + +("lux def" as_function + ("lux type check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) + (function'' [self inputs output] + (form$ (#Cons (identifier$ [..prelude_module "function''"]) + (#Cons self + (#Cons (tuple$ inputs) + (#Cons output #Nil))))))) + (record$ #Nil) + #0) + +("lux def" as_macro + ("lux type check" (#Function Code Code) + (function'' [expression] + (form$ (#Cons (text$ "lux macro") + (#Cons expression + #Nil))))) + (record$ #Nil) + #0) + +("lux def" def:'' + ("lux macro" + (function'' [tokens] + ({(#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + #1) + #Nil])) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(as_def name (as_checked type body) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + #1) + #Nil])) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(as_def name (as_checked type (as_function name args body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + #0) + #Nil])) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(as_def name (as_checked type body) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + #0) + #Nil])) + + _ + (fail "Wrong syntax for def''")} + tokens))) + (record$ #.Nil) + #0) + +("lux def" macro:' + ("lux macro" + (function'' [tokens] + ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (as_def name (as_macro (as_function name args body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons (tag$ [..prelude_module "Nil"]) + #Nil))) + #0) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (as_def name (as_macro (as_function name args body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons (tag$ [..prelude_module "Nil"]) + #Nil))) + #1) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta_data (#Cons body #Nil)))) + (return (#Cons (as_def name (as_macro (as_function name args body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta_data + #Nil))) + #1) + #Nil)) + + _ + (fail "Wrong syntax for macro:'")} + tokens))) + (record$ #.Nil) + #0) + +(macro:' #export (comment tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Throws away any code given to it." __paragraph) + ("lux text concat" + ("lux text concat" "## Great for commenting-out code, while retaining syntax high-lighting and formatting in your text editor." __paragraph) + "(comment +1 +2 +3 +4)")))] + #Nil) + (return #Nil)) + +(macro:' ($' tokens) + ({(#Cons x #Nil) + (return tokens) + + (#Cons x (#Cons y xs)) + (return (#Cons (form$ (#Cons (identifier$ [..prelude_module "$'"]) + (#Cons (form$ (#Cons (tag$ [..prelude_module "Apply"]) + (#Cons y (#Cons x #Nil)))) + xs))) + #Nil)) + + _ + (fail "Wrong syntax for $'")} + tokens)) + +(def:'' (list\map f xs) + #Nil + (#UnivQ #Nil + (#UnivQ #Nil + (#Function (#Function (#Parameter 3) (#Parameter 1)) + (#Function ($' List (#Parameter 3)) + ($' List (#Parameter 1)))))) + ({#Nil + #Nil + + (#Cons x xs') + (#Cons (f x) (list\map f xs'))} + xs)) + +(def:'' RepEnv + #Nil + Type + ($' List (#Product Text Code))) + +(def:'' (make_env xs ys) + #Nil + (#Function ($' List Text) (#Function ($' List Code) RepEnv)) + ({[(#Cons x xs') (#Cons y ys')] + (#Cons [x y] (make_env xs' ys')) + + _ + #Nil} + [xs ys])) + +(def:'' (text\= reference sample) + #Nil + (#Function Text (#Function Text Bit)) + ("lux text =" reference sample)) + +(def:'' (get_rep key env) + #Nil + (#Function Text (#Function RepEnv ($' Maybe Code))) + ({#Nil + #None + + (#Cons [k v] env') + ({#1 + (#Some v) + + #0 + (get_rep key env')} + (text\= k key))} + env)) + +(def:'' (replace_syntax reps syntax) + #Nil + (#Function RepEnv (#Function Code Code)) + ({[_ (#Identifier "" name)] + ({(#Some replacement) + replacement + + #None + syntax} + (get_rep name reps)) + + [meta (#Form parts)] + [meta (#Form (list\map (replace_syntax reps) parts))] + + [meta (#Tuple members)] + [meta (#Tuple (list\map (replace_syntax reps) members))] + + [meta (#Record slots)] + [meta (#Record (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [slot] + ({[k v] + [(replace_syntax reps k) (replace_syntax reps v)]} + slot))) + slots))] + + _ + syntax} + syntax)) + +(def:'' (n/* param subject) + (#.Cons (doc_meta "Nat(ural) multiplication.") #.Nil) + (#Function Nat (#Function Nat Nat)) + ("lux type as" Nat + ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int subject)))) + +(def:'' (update_parameters code) + #Nil + (#Function Code Code) + ({[_ (#Tuple members)] + (tuple$ (list\map update_parameters members)) + + [_ (#Record pairs)] + (record$ (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [pair] + (let'' [name val] pair + [name (update_parameters val)]))) + pairs)) + + [_ (#Form (#Cons [_ (#Tag "library/lux" "Parameter")] (#Cons [_ (#Nat idx)] #Nil)))] + (form$ (#Cons (tag$ [..prelude_module "Parameter"]) (#Cons (nat$ ("lux i64 +" 2 idx)) #Nil))) + + [_ (#Form members)] + (form$ (list\map update_parameters members)) + + _ + code} + code)) + +(def:'' (parse_quantified_args args next) + #Nil + ## (-> (List Code) (-> (List Text) (Meta (List Code))) (Meta (List Code))) + (#Function ($' List Code) + (#Function (#Function ($' List Text) (#Apply ($' List Code) Meta)) + (#Apply ($' List Code) Meta) + )) + ({#Nil + (next #Nil) + + (#Cons [_ (#Identifier "" arg_name)] args') + (parse_quantified_args args' (function'' [names] (next (#Cons arg_name names)))) + + _ + (fail "Expected identifier.")} + args)) + +(def:'' (make_parameter idx) + #Nil + (#Function Nat Code) + (form$ (#Cons (tag$ [..prelude_module "Parameter"]) (#Cons (nat$ idx) #Nil)))) + +(def:'' (list\fold f init xs) + #Nil + ## (All [a b] (-> (-> b a a) a (List b) a)) + (#UnivQ #Nil (#UnivQ #Nil (#Function (#Function (#Parameter 1) + (#Function (#Parameter 3) + (#Parameter 3))) + (#Function (#Parameter 3) + (#Function ($' List (#Parameter 1)) + (#Parameter 3)))))) + ({#Nil + init + + (#Cons x xs') + (list\fold f (f x init) xs')} + xs)) + +(def:'' (list\size list) + #Nil + (#UnivQ #Nil + (#Function ($' List (#Parameter 1)) Nat)) + (list\fold (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) + +(macro:' #export (All tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Universal quantification." __paragraph) + ("lux text concat" + ("lux text concat" "(All [a] (-> a a))" __paragraph) + ("lux text concat" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) + "(All List [a] (| Any [a (List a)]))"))))] + #Nil) + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] + + _ + ["" tokens]} + tokens) + ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse_quantified_args args + (function'' [names] + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ [..prelude_module "UnivQ"]) + (#Cons (tag$ [..prelude_module "Nil"]) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) + body + names) + (return (#Cons ({[#1 _] + body' + + [_ #Nil] + body' + + [#0 _] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #Nil) + body')} + [(text\= "" self_name) names]) + #Nil))))) + + _ + (fail "Wrong syntax for All")} + tokens))) + +(macro:' #export (Ex tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Existential quantification." __paragraph) + ("lux text concat" + ("lux text concat" "(Ex [a] [(Codec Text a) a])" __paragraph) + ("lux text concat" + ("lux text concat" "## A name can be provided, to specify a recursive type." __paragraph) + "(Ex Self [a] [(Codec Text a) a (List (Self a))])"))))] + #Nil) + (let'' [self_name tokens] ({(#Cons [_ (#Identifier "" self_name)] tokens) + [self_name tokens] + + _ + ["" tokens]} + tokens) + ({(#Cons [_ (#Tuple args)] (#Cons body #Nil)) + (parse_quantified_args args + (function'' [names] + (let'' body' (list\fold ("lux type check" (#Function Text (#Function Code Code)) + (function'' [name' body'] + (form$ (#Cons (tag$ [..prelude_module "ExQ"]) + (#Cons (tag$ [..prelude_module "Nil"]) + (#Cons (replace_syntax (#Cons [name' (make_parameter 1)] #Nil) + (update_parameters body')) #Nil)))))) + body + names) + (return (#Cons ({[#1 _] + body' + + [_ #Nil] + body' + + [#0 _] + (replace_syntax (#Cons [self_name (make_parameter (n/* 2 ("lux i64 -" 1 (list\size names))))] + #Nil) + body')} + [(text\= "" self_name) names]) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")} + tokens))) + +(def:'' (list\reverse list) + #Nil + (All [a] (#Function ($' List a) ($' List a))) + (list\fold ("lux type check" (All [a] (#Function a (#Function ($' List a) ($' List a)))) + (function'' [head tail] (#Cons head tail))) + #Nil + list)) + +(macro:' #export (-> tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Function types:" __paragraph) + ("lux text concat" + ("lux text concat" "(-> Int Int Int)" __paragraph) + "## This is the type of a function that takes 2 Ints and returns an Int.")))] + #Nil) + ({(#Cons output inputs) + (return (#Cons (list\fold ("lux type check" (#Function Code (#Function Code Code)) + (function'' [i o] (form$ (#Cons (tag$ [..prelude_module "Function"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->")} + (list\reverse tokens))) + +(macro:' #export (list xs) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## List-construction macro." __paragraph) + "(list +1 +2 +3)"))] + #Nil) + (return (#Cons (list\fold (function'' [head tail] + (form$ (#Cons (tag$ [..prelude_module "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) + (tag$ [..prelude_module "Nil"]) + (list\reverse xs)) + #Nil))) + +(macro:' #export (list& xs) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## List-construction macro, with the last element being a tail-list." __paragraph) + ("lux text concat" + ("lux text concat" "## In other words, this macro prepends elements to another list." __paragraph) + "(list& +1 +2 +3 (list +4 +5 +6))")))] + #Nil) + ({(#Cons last init) + (return (list (list\fold (function'' [head tail] + (form$ (list (tag$ [..prelude_module "Cons"]) + (tuple$ (list head tail))))) + last + init))) + + _ + (fail "Wrong syntax for list&")} + (list\reverse xs))) + +(macro:' #export (& tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Tuple types:" __paragraph) + ("lux text concat" + ("lux text concat" "(& Text Int Bit)" __paragraph) + ("lux text concat" + ("lux text concat" "## Any." __paragraph) + "(&)"))))] + #Nil) + ({#Nil + (return (list (identifier$ [..prelude_module "Any"]))) + + (#Cons last prevs) + (return (list (list\fold (function'' [left right] (form$ (list (tag$ [..prelude_module "Product"]) left right))) + last + prevs)))} + (list\reverse tokens))) + +(macro:' #export (| tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Variant types:" __paragraph) + ("lux text concat" + ("lux text concat" "(| Text Int Bit)" __paragraph) + ("lux text concat" + ("lux text concat" "## Nothing." __paragraph) + "(|)"))))] + #Nil) + ({#Nil + (return (list (identifier$ [..prelude_module "Nothing"]))) + + (#Cons last prevs) + (return (list (list\fold (function'' [left right] (form$ (list (tag$ [..prelude_module "Sum"]) left right))) + last + prevs)))} + (list\reverse tokens))) + +(macro:' (function' tokens) + (let'' [name tokens'] ({(#Cons [[_ (#Identifier ["" name])] tokens']) + [name tokens'] + + _ + ["" tokens]} + tokens) + ({(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) + ({#Nil + (fail "function' requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list (form$ (list (tuple$ (list (local_identifier$ name) + harg)) + (list\fold (function'' [arg body'] + (form$ (list (tuple$ (list (local_identifier$ "") + arg)) + body'))) + body + (list\reverse targs))))))} + args) + + _ + (fail "Wrong syntax for function'")} + tokens'))) + +(macro:' (def:''' tokens) + ({(#Cons [[_ (#Tag ["" "export"])] + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + (form$ (list (identifier$ [..prelude_module "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + (bit$ #1))))) + + (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + (bit$ #1))))) + + (#Cons [[_ (#Form (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") + type + (form$ (list (identifier$ [..prelude_module "function'"]) + name + (tuple$ args) + body)))) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + (bit$ #0))))) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (text$ "lux def") + name + (form$ (list (text$ "lux type check") type body)) + (form$ (#Cons (identifier$ [..prelude_module "record$"]) + (#Cons meta + #Nil))) + (bit$ #0))))) + + _ + (fail "Wrong syntax for def:'''")} + tokens)) + +(def:''' (as_pairs xs) + #Nil + (All [a] (-> ($' List a) ($' List (& a a)))) + ({(#Cons x (#Cons y xs')) + (#Cons [x y] (as_pairs xs')) + + _ + #Nil} + xs)) + +(macro:' (let' tokens) + ({(#Cons [[_ (#Tuple bindings)] (#Cons [body #Nil])]) + (return (list (list\fold ("lux type check" (-> (& Code Code) Code + Code) + (function' [binding body] + ({[label value] + (form$ (list (record$ (list [label body])) value))} + binding))) + body + (list\reverse (as_pairs bindings))))) + + _ + (fail "Wrong syntax for let'")} + tokens)) + +(def:''' (any? p xs) + #Nil + (All [a] + (-> (-> a Bit) ($' List a) Bit)) + ({#Nil + #0 + + (#Cons x xs') + ({#1 #1 + #0 (any? p xs')} + (p x))} + xs)) + +(def:''' (wrap_meta content) + #Nil + (-> Code Code) + (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) + content))) + +(def:''' (untemplate_list tokens) + #Nil + (-> ($' List Code) Code) + ({#Nil + (_ann (#Tag [..prelude_module "Nil"])) + + (#Cons [token tokens']) + (_ann (#Form (list (_ann (#Tag [..prelude_module "Cons"])) token (untemplate_list tokens'))))} + tokens)) + +(def:''' (list\compose xs ys) + #Nil + (All [a] (-> ($' List a) ($' List a) ($' List a))) + ({(#Cons x xs') + (#Cons x (list\compose xs' ys)) + + #Nil + ys} + xs)) + +(def:''' (_$_joiner op a1 a2) + #Nil + (-> Code Code Code Code) + ({[_ (#Form parts)] + (form$ (list\compose parts (list a1 a2))) + + _ + (form$ (list op a1 a2))} + op)) + +(def:''' (function/flip func) + #Nil + (All [a b c] + (-> (-> a b c) (-> b a c))) + (function' [right left] + (func left right))) + +(macro:' #export (_$ tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Left-association for the application of binary functions over variadic arguments." ..\n) + ("lux text concat" + ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..\n) + ("lux text concat" + ("lux text concat" "## =>" ..\n) + "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] + #Nil) + ({(#Cons op tokens') + ({(#Cons first nexts) + (return (list (list\fold (function/flip (_$_joiner op)) first nexts))) + + _ + (fail "Wrong syntax for _$")} + tokens') + + _ + (fail "Wrong syntax for _$")} + tokens)) + +(macro:' #export ($_ tokens) + (#Cons [(tag$ [..prelude_module "doc"]) + (text$ ("lux text concat" + ("lux text concat" "## Right-association for the application of binary functions over variadic arguments." ..\n) + ("lux text concat" + ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..\n) + ("lux text concat" + ("lux text concat" "## =>" ..\n) + "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] + #Nil) + ({(#Cons op tokens') + ({(#Cons last prevs) + (return (list (list\fold (_$_joiner op) last prevs))) + + _ + (fail "Wrong syntax for $_")} + (list\reverse tokens')) + + _ + (fail "Wrong syntax for $_")} + tokens)) + +## (interface: (Monad m) +## (: (All [a] (-> a (m a))) +## wrap) +## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) +## bind)) +("lux def type tagged" Monad + (#Named [..prelude_module "Monad"] + (All [m] + (& (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b)))))) + (record$ (list)) + ["wrap" "bind"] + #0) + +(def:''' maybe_monad + #Nil + ($' Monad Maybe) + {#wrap + (function' [x] (#Some x)) + + #bind + (function' [f ma] + ({#None #None + (#Some a) (f a)} + ma))}) + +(def:''' meta_monad + #Nil + ($' Monad Meta) + {#wrap + (function' [x] + (function' [state] + (#Right state x))) + + #bind + (function' [f ma] + (function' [state] + ({(#Left msg) + (#Left msg) + + (#Right [state' a]) + (f a state')} + (ma state))))}) + +(macro:' (do tokens) + ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) + (let' [g!wrap (local_identifier$ "wrap") + g!bind (local_identifier$ " bind ") + body' (list\fold ("lux type check" (-> (& Code Code) Code Code) + (function' [binding body'] + (let' [[var value] binding] + ({[_ (#Tag "" "let")] + (form$ (list (identifier$ [..prelude_module "let'"]) value body')) + + _ + (form$ (list g!bind + (form$ (list (tuple$ (list (local_identifier$ "") var)) body')) + value))} + var)))) + body + (list\reverse (as_pairs bindings)))] + (return (list (form$ (list (record$ (list [(record$ (list [(tag$ [..prelude_module "wrap"]) g!wrap] [(tag$ [..prelude_module "bind"]) g!bind])) + body'])) + monad))))) + + _ + (fail "Wrong syntax for do")} + tokens)) + +(def:''' (monad\map 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] + ({#Nil + (wrap #Nil) + + (#Cons x xs') + (do m + [y (f x) + ys (monad\map m f xs')] + (wrap (#Cons y ys)))} + xs))) + +(def:''' (monad\fold m f y xs) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a b (m b)) b (List a) (m b))) + (All [m a b] + (-> ($' Monad m) + (-> a b ($' m b)) + b + ($' List a) + ($' m b))) + (let' [{#wrap wrap #bind _} m] + ({#Nil + (wrap y) + + (#Cons x xs') + (do m + [y' (f x y)] + (monad\fold m f y' xs'))} + xs))) + +(macro:' #export (if tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "Picks which expression to evaluate based on a bit test value." __paragraph + "(if #1 ''Oh, yeah!'' ''Aw hell naw!'')" __paragraph + "=> ''Oh, yeah!''"))]) + ({(#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (record$ (list [(bit$ #1) then] + [(bit$ #0) else])) + test)))) + + _ + (fail "Wrong syntax for if")} + tokens)) + +(def:''' (get k plist) + #Nil + (All [a] + (-> Text ($' List (& Text a)) ($' Maybe a))) + ({(#Cons [[k' v] plist']) + (if (text\= k k') + (#Some v) + (get k plist')) + + #Nil + #None} + plist)) + +(def:''' (put k v dict) + #Nil + (All [a] + (-> Text a ($' List (& Text a)) ($' List (& Text a)))) + ({#Nil + (list [k v]) + + (#Cons [[k' v'] dict']) + (if (text\= k k') + (#Cons [[k' v] dict']) + (#Cons [[k' v'] (put k v dict')]))} + dict)) + +(def:''' (text\compose x y) + #Nil + (-> Text Text Text) + ("lux text concat" x y)) + +(def:''' (name\encode full_name) + #Nil + (-> Name Text) + (let' [[module name] full_name] + ({"" name + _ ($_ text\compose module "." name)} + module))) + +(def:''' (get_meta tag def_meta) + #Nil + (-> Name Code ($' Maybe Code)) + (let' [[prefix name] tag] + ({[_ (#Record def_meta)] + ({(#Cons [key value] def_meta') + ({[_ (#Tag [prefix' name'])] + ({[#1 #1] + (#Some value) + + _ + (get_meta tag (record$ def_meta'))} + [(text\= prefix prefix') + (text\= name name')]) + + _ + (get_meta tag (record$ def_meta'))} + key) + + #Nil + #None} + def_meta) + + _ + #None} + def_meta))) + +(def:''' (resolve_global_identifier full_name state) + #Nil + (-> Name ($' Meta Name)) + (let' [[module name] full_name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} state] + ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _}) + ({(#Some constant) + ({(#Left real_name) + (#Right [state real_name]) + + (#Right [exported? def_type def_meta def_value]) + (#Right [state full_name])} + constant) + + #None + (#Left ($_ text\compose "Unknown definition: " (name\encode full_name)))} + (get name definitions)) + + #None + (#Left ($_ text\compose "Unknown module: " module " @ " (name\encode full_name)))} + (get module modules)))) + +(def:''' (as_code_list expression) + #Nil + (-> Code Code) + (let' [type (form$ (list (tag$ [..prelude_module "Apply"]) + (identifier$ [..prelude_module "Code"]) + (identifier$ [..prelude_module "List"])))] + (form$ (list (text$ "lux type check") type expression)))) + +(def:''' (splice replace? untemplate elems) + #Nil + (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) + ({#1 + ({#Nil + (return (tag$ [..prelude_module "Nil"])) + + (#Cons lastI inits) + (do meta_monad + [lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + (wrap (as_code_list spliced)) + + _ + (do meta_monad + [lastO (untemplate lastI)] + (wrap (as_code_list (form$ (list (tag$ [..prelude_module "Cons"]) + (tuple$ (list lastO (tag$ [..prelude_module "Nil"]))))))))} + lastI)] + (monad\fold meta_monad + (function' [leftI rightO] + ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + (let' [g!in-module (form$ (list (text$ "lux in-module") + (text$ ..prelude_module) + (identifier$ [..prelude_module "list\compose"])))] + (wrap (form$ (list g!in-module (as_code_list spliced) rightO)))) + + _ + (do meta_monad + [leftO (untemplate leftI)] + (wrap (form$ (list (tag$ [..prelude_module "Cons"]) (tuple$ (list leftO rightO))))))} + leftI)) + lastO + inits))} + (list\reverse elems)) + #0 + (do meta_monad + [=elems (monad\map meta_monad untemplate elems)] + (wrap (untemplate_list =elems)))} + replace?)) + +(def:''' (untemplate_text value) + #Nil + (-> Text Code) + (wrap_meta (form$ (list (tag$ [..prelude_module "Text"]) (text$ value))))) + +(def:''' (untemplate replace? subst token) + #Nil + (-> Bit Text Code ($' Meta Code)) + ({[_ [_ (#Bit value)]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Bit"]) (bit$ value))))) + + [_ [_ (#Nat value)]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Nat"]) (nat$ value))))) + + [_ [_ (#Int value)]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Int"]) (int$ value))))) + + [_ [_ (#Rev value)]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Rev"]) (rev$ value))))) + + [_ [_ (#Frac value)]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Frac"]) (frac$ value))))) + + [_ [_ (#Text value)]] + (return (untemplate_text value)) + + [#0 [_ (#Tag [module name])]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) + + [#1 [_ (#Tag [module name])]] + (let' [module' ({"" + subst + + _ + module} + module)] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Tag"]) (tuple$ (list (text$ module') (text$ name)))))))) + + [#1 [_ (#Identifier [module name])]] + (do meta_monad + [real_name ({"" + (if (text\= "" subst) + (wrap [module name]) + (resolve_global_identifier [subst name])) + + _ + (wrap [module name])} + module) + #let [[module name] real_name]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [#0 [_ (#Identifier [module name])]] + (return (wrap_meta (form$ (list (tag$ [..prelude_module "Identifier"]) (tuple$ (list (text$ module) (text$ name))))))) + + [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))]] + (return (form$ (list (text$ "lux type check") + (identifier$ [..prelude_module "Code"]) + unquoted))) + + [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]] + (do meta_monad + [independent (untemplate replace? subst dependent)] + (wrap (wrap_meta (form$ (list (tag$ [..prelude_module "Form"]) + (untemplate_list (list (untemplate_text "lux in-module") + (untemplate_text subst) + independent))))))) + + [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep_quoted #Nil])]))]] + (untemplate #0 subst keep_quoted) + + [_ [meta (#Form elems)]] + (do meta_monad + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap_meta (form$ (list (tag$ [..prelude_module "Form"]) output)))]] + (wrap [meta output'])) + + [_ [meta (#Tuple elems)]] + (do meta_monad + [output (splice replace? (untemplate replace? subst) elems) + #let [[_ output'] (wrap_meta (form$ (list (tag$ [..prelude_module "Tuple"]) output)))]] + (wrap [meta output'])) + + [_ [_ (#Record fields)]] + (do meta_monad + [=fields (monad\map meta_monad + ("lux type check" (-> (& Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do meta_monad + [=k (untemplate replace? subst k) + =v (untemplate replace? subst v)] + (wrap (tuple$ (list =k =v))))))) + fields)] + (wrap (wrap_meta (form$ (list (tag$ [..prelude_module "Record"]) (untemplate_list =fields))))))} + [replace? token])) + +(macro:' #export (primitive tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Macro to treat define new primitive types." __paragraph + "(primitive ''java.lang.Object'')" __paragraph + "(primitive ''java.util.List'' [(primitive ''java.lang.Long'')])"))]) + ({(#Cons [_ (#Text class_name)] #Nil) + (return (list (form$ (list (tag$ [..prelude_module "Primitive"]) (text$ class_name) (tag$ [..prelude_module "Nil"]))))) + + (#Cons [_ (#Text class_name)] (#Cons [_ (#Tuple params)] #Nil)) + (return (list (form$ (list (tag$ [..prelude_module "Primitive"]) (text$ class_name) (untemplate_list params))))) + + _ + (fail "Wrong syntax for primitive")} + tokens)) + +(def:'' (current_module_name state) + #Nil + ($' Meta Text) + ({{#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} + ({(#Some module_name) + (#Right [state module_name]) + + _ + (#Left "Cannot get the module name without a module!")} + current_module)} + state)) + +(macro:' #export (` tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph + "## 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." __paragraph + "(` (def: (~ name) (function ((~' _) (~+ args)) (~ body))))"))]) + ({(#Cons template #Nil) + (do meta_monad + [current_module current_module_name + =template (untemplate #1 current_module template)] + (wrap (list (form$ (list (text$ "lux type check") + (identifier$ [..prelude_module "Code"]) + =template))))) + + _ + (fail "Wrong syntax for `")} + tokens)) + +(macro:' #export (`' tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~+) must also be used as forms." __paragraph + "(`' (def: (~ name) (function (_ (~+ args)) (~ body))))"))]) + ({(#Cons template #Nil) + (do meta_monad + [=template (untemplate #1 "" template)] + (wrap (list (form$ (list (text$ "lux type check") (identifier$ [..prelude_module "Code"]) =template))))) + + _ + (fail "Wrong syntax for `")} + tokens)) + +(macro:' #export (' tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Quotation as a macro." __paragraph + "(' YOLO)"))]) + ({(#Cons template #Nil) + (do meta_monad + [=template (untemplate #0 "" template)] + (wrap (list (form$ (list (text$ "lux type check") (identifier$ [..prelude_module "Code"]) =template))))) + + _ + (fail "Wrong syntax for '")} + tokens)) + +(macro:' #export (|> tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Piping macro." __paragraph + "(|> elems (list\map int\encode) (interpose '' '') (fold text\compose ''''))" __paragraph + "## =>" __paragraph + "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) + ({(#Cons [init apps]) + (return (list (list\fold ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ (#Tuple parts)] + (tuple$ (list\compose parts (list acc))) + + [_ (#Form parts)] + (form$ (list\compose parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) + + _ + (fail "Wrong syntax for |>")} + tokens)) + +(macro:' #export (<| tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Reverse piping macro." __paragraph + "(<| (fold text\compose '''') (interpose '' '') (list\map int\encode) elems)" __paragraph + "## =>" __paragraph + "(fold text\compose '''' (interpose '' '' (list\map int\encode elems)))"))]) + ({(#Cons [init apps]) + (return (list (list\fold ("lux type check" (-> Code Code Code) + (function' [app acc] + ({[_ (#Tuple parts)] + (tuple$ (list\compose parts (list acc))) + + [_ (#Form parts)] + (form$ (list\compose parts (list acc))) + + _ + (` ((~ app) (~ acc)))} + app))) + init + apps))) + + _ + (fail "Wrong syntax for <|")} + (list\reverse tokens))) + +(def:''' (compose f g) + (list [(tag$ [..prelude_module "doc"]) + (text$ "Function composition.")]) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (function' [x] (f (g x)))) + +(def:''' (get_name x) + #Nil + (-> Code ($' Maybe Name)) + ({[_ (#Identifier sname)] + (#Some sname) + + _ + #None} + x)) + +(def:''' (get_tag x) + #Nil + (-> Code ($' Maybe Name)) + ({[_ (#Tag sname)] + (#Some sname) + + _ + #None} + x)) + +(def:''' (get_short x) + #Nil + (-> Code ($' Maybe Text)) + ({[_ (#Identifier "" sname)] + (#Some sname) + + _ + #None} + x)) + +(def:''' (tuple->list tuple) + #Nil + (-> Code ($' Maybe ($' List Code))) + ({[_ (#Tuple members)] + (#Some members) + + _ + #None} + tuple)) + +(def:''' (apply_template env template) + #Nil + (-> RepEnv Code Code) + ({[_ (#Identifier "" sname)] + ({(#Some subst) + subst + + _ + template} + (get_rep sname env)) + + [meta (#Tuple elems)] + [meta (#Tuple (list\map (apply_template env) elems))] + + [meta (#Form elems)] + [meta (#Form (list\map (apply_template env) elems))] + + [meta (#Record members)] + [meta (#Record (list\map ("lux type check" (-> (& Code Code) (& Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(apply_template env slot) (apply_template env value)]))) + members))] + + _ + template} + template)) + +(def:''' (every? p xs) + #Nil + (All [a] + (-> (-> a Bit) ($' List a) Bit)) + (list\fold (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) + +(def:''' (high_bits value) + (list) + (-> ($' I64 Any) I64) + ("lux i64 right-shift" 32 value)) + +(def:''' low_mask + (list) + I64 + (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) + +(def:''' (low_bits value) + (list) + (-> ($' I64 Any) I64) + ("lux i64 and" low_mask value)) + +(def:''' (n/< reference sample) + (list) + (-> Nat Nat Bit) + (let' [referenceH (high_bits reference) + sampleH (high_bits sample)] + (if ("lux i64 <" referenceH sampleH) + #1 + (if ("lux i64 =" referenceH sampleH) + ("lux i64 <" + (low_bits reference) + (low_bits sample)) + #0)))) + +(def:''' (n/<= reference sample) + (list) + (-> Nat Nat Bit) + (if (n/< reference sample) + #1 + ("lux i64 =" reference sample))) + +(def:''' (list\join xs) + #Nil + (All [a] + (-> ($' List ($' List a)) ($' List a))) + (list\fold list\compose #Nil (list\reverse xs))) + +(macro:' #export (template tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary." __paragraph + "(template [ ]" ..\n + " " "[(def: #export (-> Int Int) (+ ))]" __paragraph + " " "[inc +1]" ..\n + " " "[dec -1]"))]) + ({(#Cons [[_ (#Tuple bindings)] (#Cons [[_ (#Tuple templates)] data])]) + ({[(#Some bindings') (#Some data')] + (let' [apply ("lux type check" (-> RepEnv ($' List Code)) + (function' [env] (list\map (apply_template env) templates))) + num_bindings (list\size bindings')] + (if (every? (function' [size] ("lux i64 =" num_bindings size)) + (list\map list\size data')) + (|> data' + (list\map (compose apply (make_env bindings'))) + list\join + return) + (fail "Irregular arguments tuples for template."))) + + _ + (fail "Wrong syntax for template")} + [(monad\map maybe_monad get_short bindings) + (monad\map maybe_monad tuple->list data)]) + + _ + (fail "Wrong syntax for template")} + tokens)) + +(def:''' (n// param subject) + (list) + (-> Nat Nat Nat) + (if ("lux i64 <" +0 ("lux type as" Int param)) + (if (n/< param subject) + 0 + 1) + (let' [quotient (|> subject + ("lux i64 right-shift" 1) + ("lux i64 /" ("lux type as" Int param)) + ("lux i64 left-shift" 1)) + flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int quotient)) + remainder ("lux i64 -" flat subject)] + (if (n/< param remainder) + quotient + ("lux i64 +" 1 quotient))))) + +(def:''' (n/% param subject) + (list) + (-> Nat Nat Nat) + (let' [flat ("lux i64 *" + ("lux type as" Int param) + ("lux type as" Int (n// param subject)))] + ("lux i64 -" flat subject))) + +(def:''' (n/min left right) + (list) + (-> Nat Nat Nat) + (if (n/< right left) + left + right)) + +(def:''' (bit\encode x) + #Nil + (-> Bit Text) + (if x "#1" "#0")) + +(def:''' (digit::format digit) + #Nil + (-> Nat Text) + ({0 "0" + 1 "1" 2 "2" 3 "3" + 4 "4" 5 "5" 6 "6" + 7 "7" 8 "8" 9 "9" + _ ("lux io error" "@digit::format Undefined behavior.")} + digit)) + +(def:''' (nat\encode value) + #Nil + (-> Nat Text) + ({0 + "0" + + _ + (let' [loop ("lux type check" (-> Nat Text Text) + (function' recur [input output] + (if ("lux i64 =" 0 input) + output + (recur (n// 10 input) + (text\compose (|> input (n/% 10) digit::format) + output)))))] + (loop value ""))} + value)) + +(def:''' (int\abs value) + #Nil + (-> Int Int) + (if ("lux i64 <" +0 value) + ("lux i64 *" -1 value) + value)) + +(def:''' (int\encode value) + #Nil + (-> Int Text) + (if ("lux i64 =" +0 value) + "+0" + (let' [sign (if ("lux i64 <" value +0) + "+" + "-")] + (("lux type check" (-> Int Text Text) + (function' recur [input output] + (if ("lux i64 =" +0 input) + (text\compose sign output) + (recur ("lux i64 /" +10 input) + (text\compose (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) + output))))) + (|> value ("lux i64 /" +10) int\abs) + (|> value ("lux i64 %" +10) int\abs ("lux type as" Nat) digit::format))))) + +(def:''' (frac\encode x) + #Nil + (-> Frac Text) + ("lux f64 encode" x)) + +(def:''' (multiple? div n) + #Nil + (-> Nat Nat Bit) + (|> n (n/% div) ("lux i64 =" 0))) + +(def:''' #export (not x) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Bit negation." __paragraph + "(not #1) => #0" __paragraph + "(not #0) => #1"))]) + (-> Bit Bit) + (if x #0 #1)) + +(def:''' (macro_type? type) + (list) + (-> Type Bit) + ({(#Named ["library/lux" "Macro"] (#Primitive "#Macro" #Nil)) + #1 + + _ + #0} + type)) + +(def:''' (find_macro' modules current_module module name) + #Nil + (-> ($' List (& Text Module)) + Text Text Text + ($' Maybe Macro)) + (do maybe_monad + [$module (get module modules) + gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux type check" Module $module)] + (get name bindings))] + ({(#Left [r_module r_name]) + (find_macro' modules current_module r_module r_name) + + (#Right [exported? def_type def_meta def_value]) + (if (macro_type? def_type) + (if exported? + (#Some ("lux type as" Macro def_value)) + (if (text\= module current_module) + (#Some ("lux type as" Macro def_value)) + #None)) + #None)} + ("lux type check" Global gdef)))) + +(def:''' (normalize name) + #Nil + (-> Name ($' Meta Name)) + ({["" name] + (do meta_monad + [module_name current_module_name] + (wrap [module_name name])) + + _ + (return name)} + name)) + +(def:''' (find_macro full_name) + #Nil + (-> Name ($' Meta ($' Maybe Macro))) + (do meta_monad + [current_module current_module_name] + (let' [[module name] full_name] + (function' [state] + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected + #location location #extensions extensions + #scope_type_vars scope_type_vars} + (#Right state (find_macro' modules current_module module name))} + state))))) + +(def:''' (macro? name) + #Nil + (-> Name ($' Meta Bit)) + (do meta_monad + [name (normalize name) + output (find_macro name)] + (wrap ({(#Some _) #1 + #None #0} + output)))) + +(def:''' (interpose sep xs) + #Nil + (All [a] + (-> a ($' List a) ($' List a))) + ({#Nil + xs + + (#Cons [x #Nil]) + xs + + (#Cons [x xs']) + (list& x sep (interpose sep xs'))} + xs)) + +(def:''' (macro_expand_once token) + #Nil + (-> Code ($' Meta ($' List Code))) + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] + ({(#Some macro) + (("lux type as" Macro' macro) args) + + #None + (return (list token))} + ?macro)) + + _ + (return (list token))} + token)) + +(def:''' (macro_expand token) + #Nil + (-> Code ($' Meta ($' List Code))) + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] + ({(#Some macro) + (do meta_monad + [expansion (("lux type as" Macro' macro) args) + expansion' (monad\map meta_monad macro_expand expansion)] + (wrap (list\join expansion'))) + + #None + (return (list token))} + ?macro)) + + _ + (return (list token))} + token)) + +(def:''' (macro_expand_all syntax) + #Nil + (-> Code ($' Meta ($' List Code))) + ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] + (do meta_monad + [macro_name' (normalize macro_name) + ?macro (find_macro macro_name')] + ({(#Some macro) + (do meta_monad + [expansion (("lux type as" Macro' macro) args) + expansion' (monad\map meta_monad macro_expand_all expansion)] + (wrap (list\join expansion'))) + + #None + (do meta_monad + [args' (monad\map meta_monad macro_expand_all args)] + (wrap (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} + ?macro)) + + [_ (#Form members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] + (wrap (list (form$ (list\join members'))))) + + [_ (#Tuple members)] + (do meta_monad + [members' (monad\map meta_monad macro_expand_all members)] + (wrap (list (tuple$ (list\join members'))))) + + [_ (#Record pairs)] + (do meta_monad + [pairs' (monad\map meta_monad + (function' [kv] + (let' [[key val] kv] + (do meta_monad + [val' (macro_expand_all val)] + ({(#Cons val'' #Nil) + (return [key val'']) + + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")} + val')))) + pairs)] + (wrap (list (record$ pairs')))) + + _ + (return (list syntax))} + syntax)) + +(def:''' (walk_type type) + #Nil + (-> Code Code) + ({[_ (#Form (#Cons [_ (#Tag tag)] parts))] + (form$ (#Cons [(tag$ tag) (list\map walk_type parts)])) + + [_ (#Tuple members)] + (` (& (~+ (list\map walk_type members)))) + + [_ (#Form (#Cons [_ (#Text "lux in-module")] + (#Cons [_ (#Text module)] + (#Cons type' + #Nil))))] + (` ("lux in-module" (~ (text$ module)) (~ (walk_type type')))) + + [_ (#Form (#Cons [_ (#Identifier ["" ":~"])] (#Cons expression #Nil)))] + expression + + [_ (#Form (#Cons type_fn args))] + (list\fold ("lux type check" (-> Code Code Code) + (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) + (walk_type type_fn) + (list\map walk_type args)) + + _ + type} + type)) + +(macro:' #export (type tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Takes a type expression and returns it's representation as data-structure." __paragraph + "(type (All [a] (Maybe (List a))))"))]) + ({(#Cons type #Nil) + (do meta_monad + [type+ (macro_expand_all type)] + ({(#Cons type' #Nil) + (wrap (list (walk_type type'))) + + _ + (fail "The expansion of the type-syntax had to yield a single element.")} + type+)) + + _ + (fail "Wrong syntax for type")} + tokens)) + +(macro:' #export (: tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## The type-annotation macro." __paragraph + "(: (List Int) (list +1 +2 +3))"))]) + ({(#Cons type (#Cons value #Nil)) + (return (list (` ("lux type check" (type (~ type)) (~ value))))) + + _ + (fail "Wrong syntax for :")} + tokens)) + +(macro:' #export (:as tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## The type-coercion macro." __paragraph + "(:as Dinosaur (list +1 +2 +3))"))]) + ({(#Cons type (#Cons value #Nil)) + (return (list (` ("lux type as" (type (~ type)) (~ value))))) + + _ + (fail "Wrong syntax for :as")} + tokens)) + +(def:''' (empty? xs) + #Nil + (All [a] (-> ($' List a) Bit)) + ({#Nil #1 + _ #0} + xs)) + +(template [ ] + [(def:''' ( xy) + #Nil + (All [a b] (-> (& a b) )) + (let' [[x y] xy] ))] + + [first a x] + [second b y]) + +(def:''' (unfold_type_def type_codes) + #Nil + (-> ($' List Code) ($' Meta (& Code ($' Maybe ($' List Text))))) + ({(#Cons [_ (#Record pairs)] #Nil) + (do meta_monad + [members (monad\map meta_monad + (: (-> [Code Code] (Meta [Text Code])) + (function' [pair] + ({[[_ (#Tag "" member_name)] member_type] + (return [member_name member_type]) + + _ + (fail "Wrong syntax for variant case.")} + pair))) + pairs)] + (return [(` (& (~+ (list\map second members)))) + (#Some (list\map first members))])) + + (#Cons type #Nil) + ({[_ (#Tag "" member_name)] + (return [(` .Any) (#Some (list member_name))]) + + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [(` (& (~+ member_types))) (#Some (list member_name))]) + + _ + (return [type #None])} + type) + + (#Cons case cases) + (do meta_monad + [members (monad\map meta_monad + (: (-> Code (Meta [Text Code])) + (function' [case] + ({[_ (#Tag "" member_name)] + (return [member_name (` .Any)]) + + [_ (#Form (#Cons [_ (#Tag "" member_name)] (#Cons member_type #Nil)))] + (return [member_name member_type]) + + [_ (#Form (#Cons [_ (#Tag "" member_name)] member_types))] + (return [member_name (` (& (~+ member_types)))]) + + _ + (fail "Wrong syntax for variant case.")} + case))) + (list& case cases))] + (return [(` (| (~+ (list\map second members)))) + (#Some (list\map first members))])) + + _ + (fail "Improper type-definition syntax")} + type_codes)) + +(def:''' (gensym prefix state) + #Nil + (-> Text ($' Meta Code)) + ({{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected + #location location #extensions extensions + #scope_type_vars scope_type_vars} + (#Right {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed ("lux i64 +" 1 seed) #expected expected + #location location #extensions extensions + #scope_type_vars scope_type_vars} + (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encode seed))))} + state)) + +(macro:' #export (Rec tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Parameter-less recursive types." __paragraph + "## A name has to be given to the whole type, to use it within its body." __paragraph + "(Rec Self [Int (List Self)])"))]) + ({(#Cons [_ (#Identifier "" name)] (#Cons body #Nil)) + (let' [body' (replace_syntax (list [name (` (#.Apply (~ (make_parameter 1)) (~ (make_parameter 0))))]) + (update_parameters body))] + (return (list (` (#.Apply .Nothing (#.UnivQ #.Nil (~ body'))))))) + + _ + (fail "Wrong syntax for Rec")} + tokens)) + +(macro:' #export (exec tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Sequential execution of expressions (great for side-effects)." __paragraph + "(exec" ..\n + " " "(log! ''#1'')" ..\n + " " "(log! ''#2'')" ..\n + " " "(log! ''#3'')" ..\n + "''YOLO'')"))]) + ({(#Cons value actions) + (let' [dummy (local_identifier$ "")] + (return (list (list\fold ("lux type check" (-> Code Code Code) + (function' [pre post] (` ({(~ dummy) (~ post)} + (~ pre))))) + value + actions)))) + + _ + (fail "Wrong syntax for exec")} + (list\reverse tokens))) + +(macro:' (def:' tokens) + (let' [[export? tokens'] ({(#Cons [_ (#Tag ["" "export"])] tokens') + [#1 tokens'] + + _ + [#0 tokens]} + tokens) + parts (: (Maybe [Code (List Code) (Maybe Code) Code]) + ({(#Cons [_ (#Form (#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 [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (#Some name args #None body) + + (#Cons name (#Cons body #Nil)) + (#Some name #Nil #None body) + + _ + #None} + tokens'))] + ({(#Some name args ?type body) + (let' [body' ({#Nil + body + + _ + (` (function' (~ name) [(~+ args)] (~ body)))} + args) + body'' ({(#Some type) + (` (: (~ type) (~ body'))) + + #None + body'} + ?type)] + (return (list (` ("lux def" (~ name) + (~ body'') + [(~ location_code) + (#.Record #.Nil)] + (~ (bit$ export?))))))) + + #None + (fail "Wrong syntax for def'")} + parts))) + +(def:' (rejoin_pair pair) + (-> [Code Code] (List Code)) + (let' [[left right] pair] + (list left right))) + +(def:' (text\encode original) + (-> Text Text) + ($_ text\compose ..double_quote original ..double_quote)) + +(def:' (code\encode code) + (-> Code Text) + ({[_ (#Bit value)] + (bit\encode value) + + [_ (#Nat value)] + (nat\encode value) + + [_ (#Int value)] + (int\encode value) + + [_ (#Rev value)] + ("lux io error" "@code\encode Undefined behavior.") + + [_ (#Frac value)] + (frac\encode value) + + [_ (#Text value)] + (text\encode value) + + [_ (#Identifier [prefix name])] + (if (text\= "" prefix) + name + ($_ text\compose prefix "." name)) + + [_ (#Tag [prefix name])] + (if (text\= "" prefix) + ($_ text\compose "#" name) + ($_ text\compose "#" prefix "." name)) + + [_ (#Form xs)] + ($_ text\compose "(" (|> xs + (list\map code\encode) + (interpose " ") + list\reverse + (list\fold text\compose "")) ")") + + [_ (#Tuple xs)] + ($_ text\compose "[" (|> xs + (list\map code\encode) + (interpose " ") + list\reverse + (list\fold text\compose "")) "]") + + [_ (#Record kvs)] + ($_ text\compose "{" (|> kvs + (list\map (function' [kv] ({[k v] ($_ text\compose (code\encode k) " " (code\encode v))} + kv))) + (interpose " ") + list\reverse + (list\fold text\compose "")) "}")} + code)) + +(def:' (expander branches) + (-> (List Code) (Meta (List Code))) + ({(#Cons [_ (#Form (#Cons [_ (#Identifier macro_name)] macro_args))] + (#Cons body + branches')) + (do meta_monad + [??? (macro? macro_name)] + (if ??? + (do meta_monad + [init_expansion (macro_expand_once (form$ (list& (identifier$ macro_name) (form$ macro_args) body branches')))] + (expander init_expansion)) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& (form$ (list& (identifier$ macro_name) macro_args)) + body + sub_expansion))))) + + (#Cons pattern (#Cons body branches')) + (do meta_monad + [sub_expansion (expander branches')] + (wrap (list& pattern body sub_expansion))) + + #Nil + (do meta_monad [] (wrap (list))) + + _ + (fail ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches + (list\map code\encode) + (interpose " ") + list\reverse + (list\fold text\compose ""))))} + branches)) + +(macro:' #export (case tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## The pattern-matching macro." ..\n + "## Allows the usage of macros within the patterns to provide custom syntax." ..\n + "(case (: (List Int) (list +1 +2 +3))" ..\n + " " "(#Cons x (#Cons y (#Cons z #Nil)))" ..\n + " " "(#Some ($_ * x y z))" __paragraph + " " "_" ..\n + " " "#None)"))]) + ({(#Cons value branches) + (do meta_monad + [expansion (expander branches)] + (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) + + _ + (fail "Wrong syntax for case")} + tokens)) + +(macro:' #export (^ tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Macro-expanding patterns." ..\n + "## It's a special macro meant to be used with 'case'." ..\n + "(case (: (List Int) (list +1 +2 +3))" ..\n + " (^ (list x y z))" ..\n + " (#Some ($_ * x y z))" + __paragraph + " _" ..\n + " #None)"))]) + (case tokens + (#Cons [_ (#Form (#Cons pattern #Nil))] (#Cons body branches)) + (do meta_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 [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Or-patterns." ..\n + "## It's a special macro meant to be used with 'case'." ..\n + "(type: Weekday #Monday #Tuesday #Wednesday #Thursday #Friday #Saturday #Sunday)" + __paragraph + "(def: (weekend? day)" ..\n + " (-> Weekday Bit)" ..\n + " (case day" ..\n + " (^or #Saturday #Sunday)" ..\n + " #1" + __paragraph + " _" ..\n + " #0))"))]) + (case tokens + (^ (list& [_ (#Form patterns)] body branches)) + (case patterns + #Nil + (fail "^or cannot have 0 patterns") + + _ + (let' [pairs (|> patterns + (list\map (function' [pattern] (list pattern body))) + (list\join))] + (return (list\compose pairs branches)))) + _ + (fail "Wrong syntax for ^or"))) + +(def:' (identifier? code) + (-> Code Bit) + (case code + [_ (#Identifier _)] + #1 + + _ + #0)) + +(macro:' #export (let tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Creates local bindings." ..\n + "## Can (optionally) use pattern-matching macros when binding." ..\n + "(let [x (foo bar)" ..\n + " y (baz quux)]" ..\n + " (op x y))"))]) + (case tokens + (^ (list [_ (#Tuple bindings)] body)) + (if (multiple? 2 (list\size bindings)) + (|> bindings as_pairs list\reverse + (list\fold (: (-> [Code Code] Code Code) + (function' [lr body'] + (let' [[l r] lr] + (if (identifier? l) + (` ({(~ l) (~ body')} (~ r))) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + return) + (fail "let requires an even number of parts")) + + _ + (fail "Wrong syntax for let"))) + +(macro:' #export (function tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Syntax for creating functions." ..\n + "## Allows for giving the function itself a name, for the sake of recursion." ..\n + "(: (All [a b] (-> a b a))" ..\n + " (function (_ x y) x))" + __paragraph + "(: (All [a b] (-> a b a))" ..\n + " (function (const x y) x))"))]) + (case (: (Maybe [Text Code (List Code) Code]) + (case tokens + (^ (list [_ (#Form (list& [_ (#Identifier ["" name])] head tail))] body)) + (#Some name head tail body) + + _ + #None)) + (#Some g!name head tail body) + (let [g!blank (local_identifier$ "") + nest (: (-> Code (-> Code Code Code)) + (function' [g!name] + (function' [arg body'] + (if (identifier? arg) + (` ([(~ g!name) (~ arg)] (~ body'))) + (` ([(~ g!name) (~ g!blank)] + (.case (~ g!blank) (~ arg) (~ body'))))))))] + (return (list (nest (..local_identifier$ g!name) head + (list\fold (nest g!blank) body (list\reverse tail)))))) + + #None + (fail "Wrong syntax for function"))) + +(def:' (process_def_meta_value code) + (-> Code Code) + (case code + [_ (#Bit value)] + (meta_code [..prelude_module "Bit"] (bit$ value)) + + [_ (#Nat value)] + (meta_code [..prelude_module "Nat"] (nat$ value)) + + [_ (#Int value)] + (meta_code [..prelude_module "Int"] (int$ value)) + + [_ (#Rev value)] + (meta_code [..prelude_module "Rev"] (rev$ value)) + + [_ (#Frac value)] + (meta_code [..prelude_module "Frac"] (frac$ value)) + + [_ (#Text value)] + (meta_code [..prelude_module "Text"] (text$ value)) + + [_ (#Tag [prefix name])] + (meta_code [..prelude_module "Tag"] (` [(~ (text$ prefix)) (~ (text$ name))])) + + (^or [_ (#Form _)] [_ (#Identifier _)]) + code + + [_ (#Tuple xs)] + (|> xs + (list\map process_def_meta_value) + untemplate_list + (meta_code [..prelude_module "Tuple"])) + + [_ (#Record kvs)] + (|> kvs + (list\map (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))])))) + untemplate_list + (meta_code [..prelude_module "Record"])) + )) + +(def:' (process_def_meta kvs) + (-> (List [Code Code]) Code) + (untemplate_list (list\map (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))]))) + kvs))) + +(def:' (with_func_args args meta) + (-> (List Code) Code Code) + (case args + #Nil + meta + + _ + (` (#.Cons [[(~ location_code) (#.Tag [..prelude_module "func-args"])] + [(~ location_code) (#.Tuple (.list (~+ (list\map (function (_ arg) + (` [(~ location_code) (#.Text (~ (text$ (code\encode arg))))])) + args))))]] + (~ meta))))) + +(def:' (with_type_args args) + (-> (List Code) Code) + (` {#.type-args [(~+ (list\map (function (_ arg) (text$ (code\encode arg))) + args))]})) + +(def:' (export^ tokens) + (-> (List Code) [Bit (List Code)]) + (case tokens + (#Cons [_ (#Tag [_ "export"])] tokens') + [#1 tokens'] + + _ + [#0 tokens])) + +(def:' (export ?) + (-> Bit (List Code)) + (if ? + (list (' #export)) + (list))) + +(macro:' #export (def: tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Defines global constants/functions." ..\n + "(def: (rejoin_pair pair)" ..\n + " (-> [Code Code] (List Code))" ..\n + " (let [[left right] pair]" ..\n + " (list left right)))" + __paragraph + "(def: branching_exponent" ..\n + " Int" ..\n + " +5)"))]) + (let [[exported? tokens'] (export^ tokens) + parts (: (Maybe [Code (List Code) (Maybe Code) Code (List [Code Code])]) + (case tokens' + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] type body)) + (#Some [name args (#Some type) body meta_kvs]) + + (^ (list name [_ (#Record meta_kvs)] type body)) + (#Some [name #Nil (#Some type) body meta_kvs]) + + (^ (list [_ (#Form (#Cons name args))] [_ (#Record meta_kvs)] body)) + (#Some [name args #None body meta_kvs]) + + (^ (list name [_ (#Record meta_kvs)] body)) + (#Some [name #Nil #None body meta_kvs]) + + (^ (list [_ (#Form (#Cons name args))] type body)) + (#Some [name args (#Some type) body #Nil]) + + (^ (list name type body)) + (#Some [name #Nil (#Some type) body #Nil]) + + (^ (list [_ (#Form (#Cons name args))] body)) + (#Some [name args #None body #Nil]) + + (^ (list name body)) + (#Some [name #Nil #None body #Nil]) + + _ + #None))] + (case parts + (#Some name args ?type body meta) + (let [body (case args + #Nil + body + + _ + (` (function ((~ name) (~+ args)) (~ body)))) + body (case ?type + (#Some type) + (` (: (~ type) (~ body))) + + #None + body) + =meta (process_def_meta meta)] + (return (list (` ("lux def" (~ name) + (~ body) + [(~ location_code) + (#.Record (~ (with_func_args args =meta)))] + (~ (bit$ exported?))))))) + + #None + (fail "Wrong syntax for def:")))) + +(def: (meta_code_add addition meta) + (-> [Code Code] Code Code) + (case [addition meta] + [[name value] [location (#Record pairs)]] + [location (#Record (#Cons [name value] pairs))] + + _ + meta)) + +(def: (meta_code_merge addition base) + (-> Code Code Code) + (case addition + [location (#Record pairs)] + (list\fold meta_code_add base pairs) + + _ + base)) + +(macro:' #export (macro: tokens) + (list [(tag$ [..prelude_module "doc"]) + (text$ ($_ "lux text concat" + "## Macro-definition macro." ..\n + "(macro: #export (name_of tokens)" ..\n + " (case tokens" ..\n + " (^template []" ..\n + " [(^ (list [_ ( [prefix name])]))" ..\n + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..\n + " ([#Identifier] [#Tag])" + __paragraph + " _" ..\n + " (fail ''Wrong syntax for name_of'')))"))]) + (let [[exported? tokens] (export^ tokens) + name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) + (case tokens + (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] body)) + (#Some [name args (list) body]) + + (^ (list [_ (#Identifier name)] body)) + (#Some [name #Nil (list) body]) + + (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta_rec_parts)] body)) + (#Some [name args meta_rec_parts body]) + + (^ (list [_ (#Identifier name)] [_ (#Record meta_rec_parts)] body)) + (#Some [name #Nil meta_rec_parts body]) + + _ + #None))] + (case name+args+meta+body?? + (#Some [name args meta body]) + (let [name (identifier$ name) + body (case args + #Nil + body + + _ + (` ("lux macro" + (function ((~ name) (~+ args)) (~ body))))) + =meta (process_def_meta meta)] + (return (list (` ("lux def" (~ name) + (~ body) + [(~ location_code) + (#Record (~ =meta))] + (~ (bit$ exported?))))))) + + #None + (fail "Wrong syntax for macro:")))) + +(macro: #export (interface: tokens) + {#.doc (text$ ($_ "lux text concat" + "## Definition of signatures ala ML." ..\n + "(interface: #export (Ord a)" ..\n + " (: (Equivalence a)" ..\n + " eq)" ..\n + " (: (-> a a Bit)" ..\n + " <)" ..\n + " (: (-> a a Bit)" ..\n + " <=)" ..\n + " (: (-> a a Bit)" ..\n + " >)" ..\n + " (: (-> a a Bit)" ..\n + " >=))"))} + (let [[exported? tokens'] (export^ tokens) + ?parts (: (Maybe [Name (List Code) Code (List Code)]) + (case tokens' + (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name args [meta_rec_location (#Record meta_rec_parts)] sigs) + + (^ (list& [_ (#Identifier name)] [meta_rec_location (#Record meta_rec_parts)] sigs)) + (#Some name #Nil [meta_rec_location (#Record meta_rec_parts)] sigs) + + (^ (list& [_ (#Form (list& [_ (#Identifier name)] args))] sigs)) + (#Some name args (` {}) sigs) + + (^ (list& [_ (#Identifier name)] sigs)) + (#Some name #Nil (` {}) sigs) + + _ + #None))] + (case ?parts + (#Some name args meta sigs) + (do meta_monad + [name+ (normalize name) + sigs' (monad\map meta_monad macro_expand sigs) + members (: (Meta (List [Text Code])) + (monad\map meta_monad + (: (-> Code (Meta [Text Code])) + (function (_ token) + (case token + (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) + (wrap [name type]) + + _ + (fail "Signatures require typed members!")))) + (list\join sigs'))) + #let [[_module _name] name+ + def_name (identifier$ name) + sig_type (record$ (list\map (: (-> [Text Code] [Code Code]) + (function (_ [m_name m_type]) + [(local_tag$ m_name) m_type])) + members)) + sig_meta (meta_code_merge (` {#.sig? #1}) + meta) + usage (case args + #Nil + def_name + + _ + (` ((~ def_name) (~+ args))))]] + (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) + + #None + (fail "Wrong syntax for interface:")))) + +(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)))) + +(template [
] + [(macro: #export ( tokens) + {#.doc } + (case (list\reverse tokens) + (^ (list& last init)) + (return (list (list\fold (: (-> Code Code Code) + (function (_ pre post) (` ))) + last + init))) + + _ + (fail )))] + + [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] + [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) + +(def: (index_of part text) + (-> Text Text (Maybe Nat)) + ("lux text index" 0 part text)) + +(def: #export (error! message) + {#.doc (text$ ($_ "lux text concat" + "## Causes an error, with the given error message." ..\n + "(error! ''OH NO!'')"))} + (-> Text Nothing) + ("lux io error" message)) + +(macro: (default tokens state) + {#.doc (text$ ($_ "lux text concat" + "## Allows you to provide a default value that will be used" ..\n + "## if a (Maybe x) value turns out to be #.None." + __paragraph + "(default +20 (#.Some +10)) ## => +10" + __paragraph + "(default +20 #.None) ## => +20"))} + (case tokens + (^ (list else maybe)) + (let [g!temp (: Code [dummy_location (#Identifier ["" ""])]) + code (` (case (~ maybe) + (#.Some (~ g!temp)) + (~ g!temp) + + #.None + (~ else)))] + (#Right [state (list code)])) + + _ + (#Left "Wrong syntax for default"))) + +(def: (text\split_all_with splitter input) + (-> Text Text (List Text)) + (case (..index_of splitter input) + #None + (list input) + + (#Some idx) + (list& ("lux text clip" 0 idx input) + (text\split_all_with splitter + (let [after_offset ("lux i64 +" 1 idx) + after_length ("lux i64 -" + after_offset + ("lux text size" input))] + ("lux text clip" after_offset after_length input)))))) + +(def: (nth idx xs) + (All [a] + (-> Nat (List a) (Maybe a))) + (case xs + #Nil + #None + + (#Cons x xs') + (if ("lux i64 =" 0 idx) + (#Some x) + (nth ("lux i64 -" 1 idx) xs') + ))) + +(def: (beta_reduce env type) + (-> (List Type) Type Type) + (case type + (#Sum left right) + (#Sum (beta_reduce env left) (beta_reduce env right)) + + (#Product left right) + (#Product (beta_reduce env left) (beta_reduce env right)) + + (#Apply arg func) + (#Apply (beta_reduce env arg) (beta_reduce env func)) + + (#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) + + (#Function ?input ?output) + (#Function (beta_reduce env ?input) (beta_reduce env ?output)) + + (#Parameter idx) + (case (nth idx env) + (#Some parameter) + parameter + + _ + type) + + (#Named 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)) + + (#Apply A F) + (do maybe_monad + [type_fn* (apply_type F A)] + (apply_type type_fn* param)) + + (#Named name type) + (apply_type type param) + + _ + #None)) + +(template [ ] + [(def: ( type) + (-> Type (List Type)) + (case type + ( left right) + (list& left ( right)) + + _ + (list type)))] + + [flatten_variant #Sum] + [flatten_tuple #Product] + [flatten_lambda #Function] + ) + +(def: (flatten_app type) + (-> Type [Type (List Type)]) + (case type + (#Apply head func') + (let [[func tail] (flatten_app func')] + [func (#Cons head tail)]) + + _ + [type (list)])) + +(def: (resolve_struct_type type) + (-> Type (Maybe (List Type))) + (case type + (#Product _) + (#Some (flatten_tuple type)) + + (#Apply arg func) + (do maybe_monad + [output (apply_type func arg)] + (resolve_struct_type output)) + + (#UnivQ _ body) + (resolve_struct_type body) + + (#ExQ _ body) + (resolve_struct_type body) + + (#Named name type) + (resolve_struct_type type) + + (#Sum _) + #None + + _ + (#Some (list type)))) + +(def: (find_module name) + (-> Text (Meta Module)) + (function (_ state) + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} state] + (case (get name modules) + (#Some module) + (#Right state module) + + _ + (#Left ($_ text\compose "Unknown module: " name)))))) + +(def: get_current_module + (Meta Module) + (do meta_monad + [module_name current_module_name] + (find_module module_name))) + +(def: (resolve_tag [module name]) + (-> Name (Meta [Nat (List Name) Bit Type])) + (do meta_monad + [=module (find_module module) + #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] + (case (get name tags_table) + (#Some output) + (return output) + + _ + (fail (text\compose "Unknown tag: " (name\encode [module name])))))) + +(def: (resolve_type_tags type) + (-> Type (Meta (Maybe [(List Name) (List Type)]))) + (case type + (#Apply arg func) + (resolve_type_tags func) + + (#UnivQ env body) + (resolve_type_tags body) + + (#ExQ env body) + (resolve_type_tags body) + + (#Named [module name] unnamed) + (do meta_monad + [=module (find_module module) + #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] + (case (get name types) + (#Some [tags exported? (#Named _ _type)]) + (case (resolve_struct_type _type) + (#Some members) + (return (#Some [tags members])) + + _ + (return #None)) + + _ + (resolve_type_tags unnamed))) + + _ + (return #None))) + +(def: get_expected_type + (Meta Type) + (function (_ state) + (let [{#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} state] + (case expected + (#Some type) + (#Right state type) + + #None + (#Left "Not expecting any type."))))) + +(macro: #export (implementation tokens) + {#.doc "Not meant to be used directly. Prefer 'implementation:'."} + (do meta_monad + [tokens' (monad\map meta_monad macro_expand tokens) + struct_type get_expected_type + tags+type (resolve_type_tags struct_type) + tags (: (Meta (List Name)) + (case tags+type + (#Some [tags _]) + (return tags) + + _ + (fail "No tags available for type."))) + #let [tag_mappings (: (List [Text Code]) + (list\map (function (_ tag) [(second tag) (tag$ tag)]) + tags))] + members (monad\map meta_monad + (: (-> Code (Meta [Code Code])) + (function (_ token) + (case token + (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta [_ (#Bit #0)]))]) + (case (get tag_name tag_mappings) + (#Some tag) + (wrap [tag value]) + + _ + (fail (text\compose "Unknown implementation member: " tag_name))) + + _ + (fail "Invalid implementation member.")))) + (list\join tokens'))] + (wrap (list (record$ members))))) + +(def: (text\join_with separator parts) + (-> Text (List Text) Text) + (case parts + #Nil + "" + + (#Cons head tail) + (list\fold (function (_ right left) + ($_ text\compose left separator right)) + head + tail))) + +(macro: #export (implementation: tokens) + {#.doc (text$ ($_ "lux text concat" + "## Definition of structures ala ML." ..\n + "(implementation: #export order (Order Int)" ..\n + " (def: &equivalence equivalence)" ..\n + " (def: (< test subject)" ..\n + " (< test subject))" ..\n + " (def: (<= test subject)" ..\n + " (or (< test subject)" ..\n + " (= test subject)))" ..\n + " (def: (> test subject)" ..\n + " (> test subject))" ..\n + " (def: (>= test subject)" ..\n + " (or (> test subject)" ..\n + " (= test subject))))"))} + (let [[exported? tokens'] (export^ tokens) + ?parts (: (Maybe [Code (List Code) Code Code (List Code)]) + (case tokens' + (^ (list& [_ (#Form (list& name args))] [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name args type [meta_rec_location (#Record meta_rec_parts)] definitions) + + (^ (list& name [meta_rec_location (#Record meta_rec_parts)] type definitions)) + (#Some name #Nil type [meta_rec_location (#Record meta_rec_parts)] definitions) + + (^ (list& [_ (#Form (list& name args))] type definitions)) + (#Some name args type (` {}) definitions) + + (^ (list& name type definitions)) + (#Some name #Nil type (` {}) definitions) + + _ + #None))] + (case ?parts + (#Some [name args type meta definitions]) + (let [usage (case args + #Nil + name + + _ + (` ((~ name) (~+ args))))] + (return (list (` (..def: (~+ (export exported?)) (~ usage) + (~ (meta_code_merge (` {#.implementation? #1}) + meta)) + (~ type) + (implementation (~+ definitions))))))) + + #None + (fail "Wrong syntax for implementation:")))) + +(def: (function\identity x) (All [a] (-> a a)) x) + +(macro: #export (type: tokens) + {#.doc (text$ ($_ "lux text concat" + "## The type-definition macro." ..\n + "(type: (List a) #Nil (#Cons a (List a)))"))} + (let [[exported? tokens'] (export^ tokens) + [rec? tokens'] (case tokens' + (#Cons [_ (#Tag [_ "rec"])] tokens') + [#1 tokens'] + + _ + [#0 tokens']) + parts (: (Maybe [Text (List Code) (List [Code Code]) (List Code)]) + (case tokens' + (^ (list [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name #Nil meta_parts (list [type_location (#Record type_parts)])]) + + (^ (list& [_ (#Identifier "" name)] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name #Nil meta_parts (#Cons type_code1 type_codes)]) + + (^ (list& [_ (#Identifier "" name)] type_codes)) + (#Some [name #Nil (list) type_codes]) + + (^ (list [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] [type_location (#Record type_parts)])) + (#Some [name args meta_parts (list [type_location (#Record type_parts)])]) + + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] [meta_location (#Record meta_parts)] type_code1 type_codes)) + (#Some [name args meta_parts (#Cons type_code1 type_codes)]) + + (^ (list& [_ (#Form (#Cons [_ (#Identifier "" name)] args))] type_codes)) + (#Some [name args (list) type_codes]) + + _ + #None))] + (case parts + (#Some name args meta type_codes) + (do meta_monad + [type+tags?? (unfold_type_def type_codes) + module_name current_module_name] + (let [type_name (local_identifier$ name) + [type tags??] type+tags?? + type' (: (Maybe Code) + (if rec? + (if (empty? args) + (let [g!param (local_identifier$ "") + prime_name (local_identifier$ name) + type+ (replace_syntax (list [name (` ((~ prime_name) .Nothing))]) type)] + (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) + .Nothing)))) + #None) + (case args + #Nil + (#Some type) + + _ + (#Some (` (.All (~ type_name) [(~+ args)] (~ type))))))) + total_meta (let [meta (process_def_meta meta) + meta (if rec? + (` (#.Cons (~ (flag_meta "type-rec?")) (~ meta))) + meta)] + (` [(~ location_code) + (#.Record (~ meta))]))] + (case type' + (#Some type'') + (let [typeC (` (#.Named [(~ (text$ module_name)) + (~ (text$ name))] + (.type (~ type''))))] + (return (list (case tags?? + (#Some tags) + (` ("lux def type tagged" (~ type_name) + (~ typeC) + (~ total_meta) + [(~+ (list\map text$ tags))] + (~ (bit$ exported?)))) + + _ + (` ("lux def" (~ type_name) + ("lux type check type" + (~ typeC)) + (~ total_meta) + (~ (bit$ exported?)))))))) + + #None + (fail "Wrong syntax for type:")))) + + #None + (fail "Wrong syntax for type:")) + )) + +(template [ ] + [(def: #export ( value) + (-> (I64 Any) ) + (:as value))] + + [i64 I64] + [nat Nat] + [int Int] + [rev Rev] + ) + +(type: Referrals + #All + (#Only (List Text)) + (#Exclude (List Text)) + #Ignore + #Nothing) + +(type: Openings + [Text (List Text)]) + +(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 Code) (Meta (List Text))) + (monad\map meta_monad + (: (-> Code (Meta Text)) + (function (_ def) + (case def + [_ (#Identifier ["" name])] + (return name) + + _ + (fail "#only/#+ and #exclude/#- require identifiers.")))) + defs)) + +(def: (parse_referrals tokens) + (-> (List Code) (Meta [Referrals (List Code)])) + (case tokens + (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "+"])] defs))] tokens')) + (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) + (do meta_monad + [defs' (extract_defs defs)] + (wrap [(#Only defs') tokens'])) + + (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) + (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) + (do meta_monad + [defs' (extract_defs defs)] + (wrap [(#Exclude defs') tokens'])) + + (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) + (^ (list& [_ (#Tag ["" "all"])] tokens'))) + (return [#All tokens']) + + (^or (^ (list& [_ (#Tag ["" "_"])] tokens')) + (^ (list& [_ (#Tag ["" "nothing"])] tokens'))) + (return [#Ignore tokens']) + + _ + (return [#Nothing tokens]))) + +(def: (parse_openings parts) + (-> (List Code) (Meta [(List Openings) (List Code)])) + (case parts + #.Nil + (return [#.Nil #.Nil]) + + (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) + (do meta_monad + [structs' (monad\map meta_monad + (function (_ struct) + (case struct + [_ (#Identifier ["" struct_name])] + (return struct_name) + + _ + (fail "Expected all implementations of opening form to be identifiers."))) + structs) + next+remainder (parse_openings parts')] + (let [[next remainder] next+remainder] + (return [(#.Cons [prefix structs'] next) + remainder]))) + + _ + (return [#.Nil parts]))) + +(def: (text\split! at x) + (-> Nat Text [Text Text]) + [("lux text clip" 0 at x) + ("lux text clip" at (|> x "lux text size" ("lux i64 -" at)) x)]) + +(def: (text\split_with token sample) + (-> Text Text (Maybe [Text Text])) + (do ..maybe_monad + [index (..index_of token sample) + #let [[pre post'] (text\split! index sample) + [_ post] (text\split! ("lux text size" token) post')]] + (wrap [pre post]))) + +(def: (replace_all pattern replacement template) + (-> Text Text Text Text) + ((: (-> Text Text Text) + (function (recur left right) + (case (..text\split_with pattern right) + (#.Some [pre post]) + (recur ($_ "lux text concat" left pre replacement) post) + + #.None + ("lux text concat" left right)))) + "" template)) + +(def: contextual_reference "#") +(def: self_reference ".") + +(def: (de_alias context self aliased) + (-> Text Text Text Text) + (|> aliased + (replace_all ..self_reference self) + (replace_all ..contextual_reference context))) + +(def: #export module_separator + "/") + +(def: parallel_hierarchy_sigil + "\") + +(def: (normalize_parallel_path' hierarchy root) + (-> Text Text Text) + (case [(text\split_with ..module_separator hierarchy) + (text\split_with ..parallel_hierarchy_sigil root)] + [(#.Some [_ hierarchy']) + (#.Some ["" root'])] + (normalize_parallel_path' hierarchy' root') + + _ + (case root + "" hierarchy + _ ($_ text\compose root ..module_separator hierarchy)))) + +(def: (normalize_parallel_path hierarchy root) + (-> Text Text (Maybe Text)) + (case (text\split_with ..parallel_hierarchy_sigil root) + (#.Some ["" root']) + (#.Some (normalize_parallel_path' hierarchy root')) + + _ + #.None)) + +(def: (count_relatives relatives input) + (-> Nat Text Nat) + (case ("lux text index" relatives ..module_separator input) + #None + relatives + + (#Some found) + (if ("lux i64 =" relatives found) + (count_relatives ("lux i64 +" 1 relatives) input) + relatives))) + +(def: (list\take amount list) + (All [a] (-> Nat (List a) (List a))) + (case [amount list] + (^or [0 _] [_ #Nil]) + #Nil + + [_ (#Cons head tail)] + (#Cons head (list\take ("lux i64 -" 1 amount) tail)))) + +(def: (list\drop amount list) + (All [a] (-> Nat (List a) (List a))) + (case [amount list] + (^or [0 _] [_ #Nil]) + list + + [_ (#Cons _ tail)] + (list\drop ("lux i64 -" 1 amount) tail))) + +(def: (clean_module nested? relative_root module) + (-> Bit Text Text (Meta Text)) + (case (count_relatives 0 module) + 0 + (return (if nested? + ($_ "lux text concat" relative_root ..module_separator module) + module)) + + relatives + (let [parts (text\split_all_with ..module_separator relative_root) + jumps ("lux i64 -" 1 relatives)] + (if (n/< (list\size parts) jumps) + (let [prefix (|> parts + list\reverse + (list\drop jumps) + list\reverse + (interpose ..module_separator) + (text\join_with "")) + clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) + output (case ("lux text size" clean) + 0 prefix + _ ($_ text\compose prefix ..module_separator clean))] + (return output)) + (fail ($_ "lux text concat" + "Cannot climb the module hierarchy..." ..\n + "Importing module: " module ..\n + " Relative Root: " relative_root ..\n)))))) + +(def: (alter_domain alteration domain import) + (-> Nat Text Importation Importation) + (let [[import_name import_alias import_refer] import + original (text\split_all_with ..module_separator import_name) + truncated (list\drop (.nat alteration) original) + parallel (case domain + "" + truncated + + _ + (list& domain truncated))] + {#import_name (text\join_with ..module_separator parallel) + #import_alias import_alias + #import_refer import_refer})) + +(def: (parse_imports nested? relative_root context_alias imports) + (-> Bit Text Text (List Code) (Meta (List Importation))) + (do meta_monad + [imports' (monad\map meta_monad + (: (-> Code (Meta (List Importation))) + (function (_ token) + (case token + ## Simple + [_ (#Identifier ["" m_name])] + (do meta_monad + [m_name (clean_module nested? relative_root m_name)] + (wrap (list {#import_name m_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) + + ## Nested + (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (case (normalize_parallel_path relative_root m_name) + (#.Some parallel_path) + (wrap parallel_path) + + #.None + (clean_module nested? relative_root m_name)) + referral+extra (parse_referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse_openings extra) + #let [[openings extra] openings+extra] + sub_imports (parse_imports #1 import_name context_alias extra)] + (wrap (case [referral openings] + [#Nothing #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) + (do meta_monad + [import_name (case (normalize_parallel_path relative_root m_name) + (#.Some parallel_path) + (wrap parallel_path) + + #.None + (clean_module nested? relative_root m_name)) + referral+extra (parse_referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse_openings extra) + #let [[openings extra] openings+extra + de_aliased (de_alias context_alias m_name alias)] + sub_imports (parse_imports #1 import_name de_aliased extra)] + (wrap (case [referral openings] + [#Ignore #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias (#Some de_aliased) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + ## Unrecognized syntax. + _ + (do meta_monad + [current_module current_module_name] + (fail ($_ text\compose + "Wrong syntax for import @ " current_module + ..\n (code\encode token))))))) + imports)] + (wrap (list\join imports')))) + +(def: (exported_definitions module state) + (-> Text (Meta (List Text))) + (let [[current_module modules] (case state + {#info info #source source #current_module current_module #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} + [current_module modules])] + (case (get module modules) + (#Some =module) + (let [to_alias (list\map (: (-> [Text Global] + (List Text)) + (function (_ [name definition]) + (case definition + (#Left _) + (list) + + (#Right [exported? def_type def_meta def_value]) + (if exported? + (list name) + (list))))) + (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] + definitions))] + (#Right state (list\join to_alias))) + + #None + (#Left ($_ text\compose + "Unknown module: " (text\encode module) ..\n + "Current module: " (case current_module + (#Some current_module) + (text\encode current_module) + + #None + "???") ..\n + "Known modules: " (|> modules + (list\map (function (_ [name module]) + (text$ name))) + tuple$ + code\encode)))) + )) + +(def: (filter p xs) + (All [a] (-> (-> a Bit) (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 Bit) + (let [output (list\fold (function (_ case prev) + (or prev + (text\= case name))) + #0 + 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 Lux (Maybe Type)) + (case state + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} + (find (: (-> Scope (Maybe Type)) + (function (_ env) + (case env + {#name _ + #inner _ + #locals {#counter _ #mappings locals} + #captured {#counter _ #mappings closure}} + (try_both (find (: (-> [Text [Type Any]] (Maybe Type)) + (function (_ [bname [type _]]) + (if (text\= name bname) + (#Some type) + #None)))) + (: (List [Text [Type Any]]) locals) + (: (List [Text [Type Any]]) closure))))) + scopes))) + +(def: (find_def_type name state) + (-> Name Lux (Maybe Type)) + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) + #None + #None + + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) + #None + #None + + (#Some definition) + (case definition + (#Left de_aliased) + (find_def_type de_aliased state) + + (#Right [exported? def_type def_meta def_value]) + (#Some def_type)))))) + +(def: (find_def_value name state) + (-> Name (Meta [Type Any])) + (let [[v_prefix v_name] name + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} state] + (case (get v_prefix modules) + #None + (#Left (text\compose "Unknown definition: " (name\encode name))) + + (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) + (case (get v_name definitions) + #None + (#Left (text\compose "Unknown definition: " (name\encode name))) + + (#Some definition) + (case definition + (#Left de_aliased) + (find_def_value de_aliased state) + + (#Right [exported? def_type def_meta def_value]) + (#Right [state [def_type def_value]])))))) + +(def: (find_type_var idx bindings) + (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) + (case bindings + #Nil + #Nil + + (#Cons [var bound] bindings') + (if ("lux i64 =" idx var) + bound + (find_type_var idx bindings')))) + +(def: (find_type full_name) + (-> Name (Meta Type)) + (do meta_monad + [#let [[module name] full_name] + current_module current_module_name] + (function (_ compiler) + (let [temp (if (text\= "" module) + (case (find_in_env name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) + + _ + (case (find_def_type [current_module name] compiler) + (#Some struct_type) + (#Right [compiler struct_type]) + + _ + (#Left ($_ text\compose "Unknown var: " (name\encode full_name))))) + (case (find_def_type full_name compiler) + (#Some struct_type) + (#Right [compiler struct_type]) + + _ + (#Left ($_ text\compose "Unknown var: " (name\encode full_name)))))] + (case temp + (#Right [compiler (#Var type_id)]) + (let [{#info _ #source _ #current_module _ #modules _ + #scopes _ #type_context type_context #host _ + #seed _ #expected _ #location _ #extensions extensions + #scope_type_vars _} compiler + {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] + (case (find_type_var type_id var_bindings) + #None + temp + + (#Some actualT) + (#Right [compiler actualT]))) + + _ + temp)) + ))) + +(def: (zip/2 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] (zip/2 xs' ys')) + + _ + (list)) + + _ + (list))) + +(def: (type\encode type) + (-> Type Text) + (case type + (#Primitive name params) + (case params + #Nil + name + + _ + ($_ text\compose "(" name " " (|> params (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")")) + + (#Sum _) + ($_ text\compose "(| " (|> (flatten_variant type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + + (#Product _) + ($_ text\compose "[" (|> (flatten_tuple type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) "]") + + (#Function _) + ($_ text\compose "(-> " (|> (flatten_lambda type) (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) ")") + + (#Parameter id) + (nat\encode id) + + (#Var id) + ($_ text\compose "⌈v:" (nat\encode id) "⌋") + + (#Ex id) + ($_ text\compose "⟨e:" (nat\encode id) "⟩") + + (#UnivQ env body) + ($_ text\compose "(All " (type\encode body) ")") + + (#ExQ env body) + ($_ text\compose "(Ex " (type\encode body) ")") + + (#Apply _) + (let [[func args] (flatten_app type)] + ($_ text\compose + "(" (type\encode func) " " + (|> args (list\map type\encode) (interpose " ") list\reverse (list\fold text\compose "")) + ")")) + + (#Named name _) + (name\encode name) + )) + +(macro: #export (^open tokens) + {#.doc (text$ ($_ "lux text concat" + "## Same as the 'open' macro, but meant to be used as a pattern-matching macro for generating local bindings." ..\n + "## Takes an 'alias' text for the generated local bindings." ..\n + "(def: #export (range (^open ''.'') from to)" ..\n + " (All [a] (-> (Enum a) a a (List a)))" ..\n + " (range' <= succ from to))"))} + (case tokens + (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) + (do meta_monad + [g!temp (gensym "temp")] + (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) + + (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) + (do meta_monad + [init_type (find_type name) + struct_evidence (resolve_type_tags init_type)] + (case struct_evidence + #None + (fail (text\compose "Can only 'open' structs: " (type\encode init_type))) + + (#Some tags&members) + (do meta_monad + [full_body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) + (function (recur source [tags members] target) + (let [locals (list\map (function (_ [t_module t_name]) + ["" (de_alias "" t_name alias)]) + tags) + pattern (tuple$ (list\map identifier$ locals))] + (do meta_monad + [enhanced_target (monad\fold meta_monad + (function (_ [m_local m_type] enhanced_target) + (do meta_monad + [m_implementation (resolve_type_tags m_type)] + (case m_implementation + (#Some m_tags&members) + (recur m_local + m_tags&members + enhanced_target) + + #None + (wrap enhanced_target)))) + target + (zip/2 locals members))] + (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) + name tags&members body)] + (wrap (list full_body))))) + + _ + (fail "Wrong syntax for ^open"))) + +(macro: #export (cond tokens) + {#.doc (text$ ($_ "lux text concat" + "## Branching structures with multiple test conditions." ..\n + "(cond (even? num) ''even''" ..\n + " (odd? num) ''odd''" + __paragraph + " ## else_branch" ..\n + " ''???'')"))} + (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) + (fail "cond requires an uneven number of arguments.") + (case (list\reverse tokens) + (^ (list& else branches')) + (return (list (list\fold (: (-> [Code Code] Code Code) + (function (_ branch else) + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) + else + (as_pairs branches')))) + + _ + (fail "Wrong syntax for cond")))) + +(def: (enumeration' idx xs) + (All [a] (-> Nat (List a) (List [Nat a]))) + (case xs + (#Cons x xs') + (#Cons [idx x] (enumeration' ("lux i64 +" 1 idx) xs')) + + #Nil + #Nil)) + +(def: (enumeration xs) + (All [a] (-> (List a) (List [Nat a]))) + (enumeration' 0 xs)) + +(macro: #export (get@ tokens) + {#.doc (text$ ($_ "lux text concat" + "## Accesses the value of a record at a given tag." ..\n + "(get@ #field my_record)" + __paragraph + "## Can also work with multiple levels of nesting:" ..\n + "(get@ [#foo #bar #baz] my_record)" + __paragraph + "## And, if only the slot/path is given, generates an accessor function:" ..\n + "(let [getter (get@ [#foo #bar #baz])]" ..\n + " (getter my_record))"))} + (case tokens + (^ (list [_ (#Tag slot')] record)) + (do meta_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$ (list\map (: (-> [Name [Nat Type]] [Code Code]) + (function (_ [[r_prefix r_name] [r_idx r_type]]) + [(tag$ [r_prefix r_name]) + (if ("lux i64 =" idx r_idx) + g!output + g!_)])) + (zip/2 tags (enumeration members))))] + (return (list (` ({(~ pattern) (~ g!output)} (~ record)))))) + + _ + (fail "get@ can only use records."))) + + (^ (list [_ (#Tuple slots)] record)) + (return (list (list\fold (: (-> Code Code Code) + (function (_ slot inner) + (` (..get@ (~ slot) (~ inner))))) + record + slots))) + + (^ (list selector)) + (do meta_monad + [g!_ (gensym "_") + g!record (gensym "record")] + (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) + + _ + (fail "Wrong syntax for get@"))) + +(def: (open_field alias tags my_tag_index [module short] source type) + (-> Text (List Name) Nat Name Code Type (Meta (List Code))) + (do meta_monad + [output (resolve_type_tags type) + g!_ (gensym "g!_") + #let [g!output (local_identifier$ short) + pattern (|> tags + enumeration + (list\map (function (_ [tag_idx tag]) + (if ("lux i64 =" my_tag_index tag_idx) + g!output + g!_))) + tuple$) + source+ (` ({(~ pattern) (~ g!output)} (~ source)))]] + (case output + (#Some [tags' members']) + (do meta_monad + [decls' (monad\map meta_monad + (: (-> [Nat Name Type] (Meta (List Code))) + (function (_ [sub_tag_index sname stype]) + (open_field alias tags' sub_tag_index sname source+ stype))) + (enumeration (zip/2 tags' members')))] + (return (list\join decls'))) + + _ + (return (list (` ("lux def" (~ (local_identifier$ (de_alias "" short alias))) + (~ source+) + [(~ location_code) (#.Record #Nil)] + #0))))))) + +(macro: #export (open: tokens) + {#.doc (text$ ($_ "lux text concat" + "## Opens a implementation and generates a definition for each of its members (including nested members)." + __paragraph + "## For example:" ..\n + "(open: ''i:.'' number)" + __paragraph + "## Will generate:" ..\n + "(def: i:+ (\ number +))" ..\n + "(def: i:- (\ number -))" ..\n + "(def: i:* (\ number *))" ..\n + "..."))} + (case tokens + (^ (list [_ (#Text alias)] struct)) + (case struct + [_ (#Identifier struct_name)] + (do meta_monad + [struct_type (find_type struct_name) + output (resolve_type_tags struct_type) + #let [source (identifier$ struct_name)]] + (case output + (#Some [tags members]) + (do meta_monad + [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) + (function (_ [tag_index sname stype]) + (open_field alias tags tag_index sname source stype))) + (enumeration (zip/2 tags members)))] + (return (list\join decls'))) + + _ + (fail (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) + + _ + (do meta_monad + [g!struct (gensym "struct")] + (return (list (` ("lux def" (~ g!struct) (~ struct) + [(~ location_code) (#.Record #Nil)] + #0)) + (` (..open: (~ (text$ alias)) (~ g!struct))))))) + + _ + (fail "Wrong syntax for open:"))) + +(macro: #export (|>> tokens) + {#.doc (text$ ($_ "lux text concat" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n + "(|>> (list\map int\encode) (interpose '' '') (fold text\compose ''''))" ..\n + "## =>" ..\n + "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} + (do meta_monad + [g!_ (gensym "_") + g!arg (gensym "arg")] + (return (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) + +(macro: #export (<<| tokens) + {#.doc (text$ ($_ "lux text concat" + "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n + "(<<| (fold text\compose '''') (interpose '' '') (list\map int\encode))" ..\n + "## =>" ..\n + "(function (_ ) (fold text\compose '''' (interpose '' '' (list\map int\encode ))))"))} + (do meta_monad + [g!_ (gensym "_") + g!arg (gensym "arg")] + (return (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) + +(def: (imported_by? import_name module_name) + (-> Text Text (Meta Bit)) + (do meta_monad + [module (find_module module_name) + #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] + (wrap (is_member? imports import_name)))) + +(def: (read_refer module_name options) + (-> Text (List Code) (Meta Refer)) + (do meta_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] + (case options + #Nil + (wrap {#refer_defs referral + #refer_open openings}) + + _ + (fail ($_ text\compose "Wrong syntax for refer @ " current_module + ..\n (|> options + (list\map code\encode) + (interpose " ") + (list\fold text\compose ""))))))) + +(def: (write_refer module_name [r_defs r_opens]) + (-> Text Refer (Meta (List Code))) + (do meta_monad + [current_module current_module_name + #let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) + (function (_ module_name all_defs referred_defs) + (monad\map meta_monad + (: (-> Text (Meta Any)) + (function (_ _def) + (if (is_member? all_defs _def) + (return []) + (fail ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) + referred_defs)))] + defs' (case r_defs + #All + (exported_definitions module_name) + + (#Only +defs) + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs +defs)] + (wrap +defs)) + + (#Exclude _defs) + (do meta_monad + [*defs (exported_definitions module_name) + _ (test_referrals module_name *defs _defs)] + (wrap (filter (|>> (is_member? _defs) not) *defs))) + + #Ignore + (wrap (list)) + + #Nothing + (wrap (list))) + #let [defs (list\map (: (-> Text Code) + (function (_ def) + (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) + defs') + openings (|> r_opens + (list\map (: (-> Openings (List Code)) + (function (_ [alias structs]) + (list\map (function (_ name) + (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) + structs)))) + list\join)]] + (wrap (list\compose defs openings)) + )) + +(macro: #export (refer tokens) + (case tokens + (^ (list& [_ (#Text module_name)] options)) + (do meta_monad + [=refer (read_refer module_name options)] + (write_refer module_name =refer)) + + _ + (fail "Wrong syntax for refer"))) + +(def: (refer_to_code module_name module_alias' [r_defs r_opens]) + (-> Text (Maybe Text) Refer Code) + (let [module_alias (..default module_name module_alias') + localizations (: (List Code) + (case r_defs + #All + (list (' #*)) + + (#Only defs) + (list (form$ (list& (' #+) (list\map local_identifier$ defs)))) + + (#Exclude defs) + (list (form$ (list& (' #-) (list\map local_identifier$ defs)))) + + #Ignore + (list) + + #Nothing + (list))) + openings (list\map (function (_ [alias structs]) + (form$ (list& (text$ (..replace_all ..contextual_reference module_alias alias)) + (list\map local_identifier$ structs)))) + r_opens)] + (` (..refer (~ (text$ module_name)) + (~+ localizations) + (~+ openings))))) + +(macro: #export (module: tokens) + {#.doc (text$ ($_ "lux text concat" + "## Module_definition macro." + __paragraph + "## Can take optional annotations and allows the specification of modules to import." + __paragraph + "## Example" ..\n + "(.module: {#.doc ''Some documentation...''}" ..\n + " [lux #*" ..\n + " [control" ..\n + " [''M'' monad #*]]" ..\n + " [data" ..\n + " maybe" ..\n + " [''.'' name (''#/.'' codec)]]" ..\n + " [macro" ..\n + " code]]" ..\n + " [//" ..\n + " [type (''.'' equivalence)]])"))} + (do meta_monad + [#let [[_meta _imports] (: [(List [Code Code]) (List Code)] + (case tokens + (^ (list& [_ (#Record _meta)] _imports)) + [_meta _imports] + + _ + [(list) tokens]))] + current_module current_module_name + imports (parse_imports #0 current_module "" _imports) + #let [=imports (|> imports + (list\map (: (-> Importation Code) + (function (_ [m_name m_alias =refer]) + (` [(~ (text$ m_name)) (~ (text$ (default "" m_alias)))])))) + tuple$) + =refers (list\map (: (-> Importation Code) + (function (_ [m_name m_alias =refer]) + (refer_to_code m_name m_alias =refer))) + imports) + =module (` ("lux def module" [(~ location_code) + (#.Record (~ (process_def_meta _meta)))] + (~ =imports)))]] + (wrap (#Cons =module =refers)))) + +(macro: #export (\ tokens) + {#.doc (text$ ($_ "lux text concat" + "## Allows accessing the value of a implementation's member." ..\n + "(\ codec encode)" + __paragraph + "## Also allows using that value as a function." ..\n + "(\ codec encode +123)"))} + (case tokens + (^ (list struct [_ (#Identifier member)])) + (return (list (` (let [(^open (~ (text$ ..self_reference))) (~ struct)] (~ (identifier$ member)))))) + + (^ (list& struct member args)) + (return (list (` ((..\ (~ struct) (~ member)) (~+ args))))) + + _ + (fail "Wrong syntax for \"))) + +(macro: #export (set@ tokens) + {#.doc (text$ ($_ "lux text concat" + "## Sets the value of a record at a given tag." ..\n + "(set@ #name ''Lux'' lang)" + __paragraph + "## Can also work with multiple levels of nesting:" ..\n + "(set@ [#foo #bar #baz] value my_record)" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..\n + "(let [setter (set@ [#foo #bar #baz] value)] (setter my_record))" ..\n + "(let [setter (set@ [#foo #bar #baz])] (setter value my_record))"))} + (case tokens + (^ (list [_ (#Tag slot')] value record)) + (do meta_monad + [slot (normalize slot') + output (resolve_tag slot) + #let [[idx tags exported? type] output]] + (case (resolve_struct_type type) + (#Some members) + (do meta_monad + [pattern' (monad\map meta_monad + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (gensym "")] + (return [r_slot_name r_idx g!slot])))) + (zip/2 tags (enumeration members)))] + (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) + pattern')) + output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) + value + r_var)])) + pattern'))] + (return (list (` ({(~ pattern) (~ output)} (~ record))))))) + + _ + (fail "set@ can only use records."))) + + (^ (list [_ (#Tuple slots)] value record)) + (case slots + #Nil + (fail "Wrong syntax for set@") + + _ + (do meta_monad + [bindings (monad\map meta_monad + (: (-> Code (Meta Code)) + (function (_ _) (gensym "temp"))) + slots) + #let [pairs (zip/2 slots bindings) + update_expr (list\fold (: (-> [Code Code] Code Code) + (function (_ [s b] v) + (` (..set@ (~ s) (~ v) (~ b))))) + value + (list\reverse pairs)) + [_ accesses'] (list\fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) + (function (_ [new_slot new_binding] [old_record accesses']) + [(` (get@ (~ new_slot) (~ new_binding))) + (#Cons (list new_binding old_record) accesses')])) + [record (: (List (List Code)) #Nil)] + pairs) + accesses (list\join (list\reverse accesses'))]] + (wrap (list (` (let [(~+ accesses)] + (~ update_expr))))))) + + (^ (list selector value)) + (do meta_monad + [g!_ (gensym "_") + g!record (gensym "record")] + (wrap (list (` (function ((~ g!_) (~ g!record)) + (..set@ (~ selector) (~ value) (~ g!record))))))) + + (^ (list selector)) + (do meta_monad + [g!_ (gensym "_") + g!value (gensym "value") + g!record (gensym "record")] + (wrap (list (` (function ((~ g!_) (~ g!value) (~ g!record)) + (..set@ (~ selector) (~ g!value) (~ g!record))))))) + + _ + (fail "Wrong syntax for set@"))) + +(macro: #export (update@ tokens) + {#.doc (text$ ($_ "lux text concat" + "## Modifies the value of a record at a given tag, based on some function." ..\n + "(update@ #age inc person)" + __paragraph + "## Can also work with multiple levels of nesting:" ..\n + "(update@ [#foo #bar #baz] func my_record)" + __paragraph + "## And, if only the slot/path and (optionally) the value are given, generates a mutator function:" ..\n + "(let [updater (update@ [#foo #bar #baz] func)] (updater my_record))" ..\n + "(let [updater (update@ [#foo #bar #baz])] (updater func my_record))"))} + (case tokens + (^ (list [_ (#Tag slot')] fun record)) + (do meta_monad + [slot (normalize slot') + output (resolve_tag slot) + #let [[idx tags exported? type] output]] + (case (resolve_struct_type type) + (#Some members) + (do meta_monad + [pattern' (monad\map meta_monad + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (gensym "")] + (return [r_slot_name r_idx g!slot])))) + (zip/2 tags (enumeration members)))] + (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) + pattern')) + output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + (if ("lux i64 =" idx r_idx) + (` ((~ fun) (~ r_var))) + r_var)])) + pattern'))] + (return (list (` ({(~ pattern) (~ output)} (~ record))))))) + + _ + (fail "update@ can only use records."))) + + (^ (list [_ (#Tuple slots)] fun record)) + (case slots + #Nil + (fail "Wrong syntax for update@") + + _ + (do meta_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 meta_monad + [g!_ (gensym "_") + g!record (gensym "record")] + (wrap (list (` (function ((~ g!_) (~ g!record)) + (..update@ (~ selector) (~ fun) (~ g!record))))))) + + (^ (list selector)) + (do meta_monad + [g!_ (gensym "_") + g!fun (gensym "fun") + g!record (gensym "record")] + (wrap (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) + (..update@ (~ selector) (~ g!fun) (~ g!record))))))) + + _ + (fail "Wrong syntax for update@"))) + +(macro: #export (^template tokens) + {#.doc (text$ ($_ "lux text concat" + "## It's similar to template, but meant to be used during pattern-matching." ..\n + "(def: (beta_reduce env type)" ..\n + " (-> (List Type) Type Type)" ..\n + " (case type" ..\n + " (#.Primitive name params)" ..\n + " (#.Primitive name (list\map (beta_reduce env) params))" + __paragraph + " (^template []" ..\n + " [( left right)" ..\n + " ( (beta_reduce env left) (beta_reduce env right))])" ..\n + " ([#.Sum] [#.Product])" + __paragraph + " (^template []" ..\n + " [( left right)" ..\n + " ( (beta_reduce env left) (beta_reduce env right))])" ..\n + " ([#.Function] [#.Apply])" + __paragraph + " (^template []" ..\n + " [( old_env def)" ..\n + " (case old_env" ..\n + " #.Nil" ..\n + " ( env def)" + __paragraph + " _" ..\n + " type)])" ..\n + " ([#.UnivQ] [#.ExQ])" + __paragraph + " (#.Parameter idx)" ..\n + " (default type (list.nth idx env))" + __paragraph + " _" ..\n + " type" ..\n + " ))"))} + (case tokens + (^ (list& [_ (#Form (list [_ (#Tuple bindings)] + [_ (#Tuple templates)]))] + [_ (#Form data)] + branches)) + (case (: (Maybe (List Code)) + (do maybe_monad + [bindings' (monad\map maybe_monad get_short bindings) + data' (monad\map maybe_monad tuple->list data)] + (let [num_bindings (list\size bindings')] + (if (every? (|>> ("lux i64 =" num_bindings)) + (list\map list\size data')) + (let [apply (: (-> RepEnv (List Code)) + (function (_ env) (list\map (apply_template env) templates)))] + (|> data' + (list\map (compose apply (make_env bindings'))) + list\join + wrap)) + #None)))) + (#Some output) + (return (list\compose output branches)) + + #None + (fail "Wrong syntax for ^template")) + + _ + (fail "Wrong syntax for ^template"))) + +(def: (find_baseline_column code) + (-> Code Nat) + (case code + (^template [] + [[[_ _ column] ( _)] + column]) + ([#Bit] + [#Nat] + [#Int] + [#Rev] + [#Frac] + [#Text] + [#Identifier] + [#Tag]) + + (^template [] + [[[_ _ column] ( parts)] + (list\fold n/min column (list\map find_baseline_column parts))]) + ([#Form] + [#Tuple]) + + [[_ _ column] (#Record pairs)] + (list\fold n/min column + (list\compose (list\map (|>> first find_baseline_column) pairs) + (list\map (|>> second find_baseline_column) pairs))) + )) + +(type: Doc_Fragment + (#Doc_Comment Text) + (#Doc_Example Code)) + +(def: (identify_doc_fragment code) + (-> Code Doc_Fragment) + (case code + [_ (#Text comment)] + (#Doc_Comment comment) + + _ + (#Doc_Example code))) + +(template [ ] + [(def: #export + {#.doc } + (All [s] (-> (I64 s) (I64 s))) + (|>> ( 1)))] + + [inc "lux i64 +" "Increment function."] + [dec "lux i64 -" "Decrement function."] + ) + +(def: tag\encode + (-> Name Text) + (|>> name\encode (text\compose "#"))) + +(def: (repeat n x) + (All [a] (-> Int a (List a))) + (if ("lux i64 <" n +0) + (#Cons x (repeat ("lux i64 +" -1 n) x)) + #Nil)) + +(def: (location_padding baseline [_ old_line old_column] [_ new_line new_column]) + (-> Nat Location Location Text) + (if ("lux i64 =" old_line new_line) + (text\join_with "" (repeat (.int ("lux i64 -" old_column new_column)) " ")) + (let [extra_lines (text\join_with "" (repeat (.int ("lux i64 -" old_line new_line)) ..\n)) + space_padding (text\join_with "" (repeat (.int ("lux i64 -" baseline new_column)) " "))] + (text\compose extra_lines space_padding)))) + +(def: (text\size x) + (-> Text Nat) + ("lux text size" x)) + +(def: (update_location [file line column] code_text) + (-> Location Text Location) + [file line ("lux i64 +" column (text\size code_text))]) + +(def: (delim_update_location [file line column]) + (-> Location Location) + [file line (inc column)]) + +(def: rejoin_all_pairs + (-> (List [Code Code]) (List Code)) + (|>> (list\map rejoin_pair) list\join)) + +(def: (doc_example->Text prev_location baseline example) + (-> Location Nat Code [Location Text]) + (case example + (^template [ ] + [[new_location ( value)] + (let [as_text ( value)] + [(update_location new_location as_text) + (text\compose (location_padding baseline prev_location new_location) + as_text)])]) + ([#Bit bit\encode] + [#Nat nat\encode] + [#Int int\encode] + [#Frac frac\encode] + [#Text text\encode] + [#Identifier name\encode] + [#Tag tag\encode]) + + (^template [ ] + [[group_location ( parts)] + (let [[group_location' parts_text] (list\fold (function (_ part [last_location text_accum]) + (let [[part_location part_text] (doc_example->Text last_location baseline part)] + [part_location (text\compose text_accum part_text)])) + [(delim_update_location group_location) ""] + ( parts))] + [(delim_update_location group_location') + ($_ text\compose (location_padding baseline prev_location group_location) + + parts_text + )])]) + ([#Form "(" ")" ..function\identity] + [#Tuple "[" "]" ..function\identity] + [#Record "{" "}" rejoin_all_pairs]) + + [new_location (#Rev value)] + ("lux io error" "@doc_example->Text Undefined behavior.") + )) + +(def: (with_baseline baseline [file line column]) + (-> Nat Location Location) + [file line baseline]) + +(def: (doc_fragment->Text fragment) + (-> Doc_Fragment Text) + (case fragment + (#Doc_Comment comment) + (|> comment + (text\split_all_with ..\n) + (list\map (function (_ line) ($_ text\compose "## " line ..\n))) + (text\join_with "")) + + (#Doc_Example example) + (let [baseline (find_baseline_column example) + [location _] example + [_ text] (doc_example->Text (with_baseline baseline location) baseline example)] + (text\compose text __paragraph)))) + +(macro: #export (doc tokens) + {#.doc (text$ ($_ "lux text concat" + "## Creates code documentation, embedding text as comments and properly formatting the forms it's being given." + __paragraph + "## For Example:" ..\n + "(doc ''Allows arbitrary looping, using the 'recur' form to re-start the loop.''" ..\n + " ''Can be used in monadic code to create monadic loops.''" ..\n + " (loop [count +0" ..\n + " x init]" ..\n + " (if (< +10 count)" ..\n + " (recur (inc count) (f x))" ..\n + " x)))"))} + (return (list (` [(~ location_code) + (#.Text (~ (|> tokens + (list\map (|>> identify_doc_fragment doc_fragment->Text)) + (text\join_with "") + 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_to_code type) + (-> Type Code) + (case type + (#Primitive name params) + (` (#.Primitive (~ (text$ name)) (~ (untemplate_list (list\map type_to_code params))))) + + (^template [] + [( left right) + (` ( (~ (type_to_code left)) (~ (type_to_code right))))]) + ([#.Sum] [#.Product] + [#.Function] + [#.Apply]) + + (^template [] + [( id) + (` ( (~ (nat$ id))))]) + ([#.Parameter] [#.Var] [#.Ex]) + + (^template [] + [( env type) + (let [env' (untemplate_list (list\map type_to_code env))] + (` ( (~ env') (~ (type_to_code type)))))]) + ([#.UnivQ] [#.ExQ]) + + (#Named [module name] anonymous) + ## TODO: Generate the explicit type definition instead of using + ## the "identifier$" shortcut below. + ## (` (#.Named [(~ (text$ module)) (~ (text$ name))] + ## (~ (type_to_code anonymous)))) + (identifier$ [module name]))) + +(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)) + + "Loops can also be given custom names." + (loop my_loop + [count +0 + x init] + (if (< +10 count) + (my_loop (inc count) (f x)) + x)))} + (let [?params (case tokens + (^ (list name [_ (#Tuple bindings)] body)) + (#.Some [name bindings body]) + + (^ (list [_ (#Tuple bindings)] body)) + (#.Some [(local_identifier$ "recur") bindings body]) + + _ + #.None)] + (case ?params + (#.Some [name bindings body]) + (let [pairs (as_pairs bindings) + vars (list\map first pairs) + inits (list\map second pairs)] + (if (every? identifier? inits) + (do meta_monad + [inits' (: (Meta (List Name)) + (case (monad\map maybe_monad get_name inits) + (#Some inits') (return inits') + #None (fail "Wrong syntax for loop"))) + init_types (monad\map meta_monad find_type inits') + expected get_expected_type] + (return (list (` (("lux type check" + (-> (~+ (list\map type_to_code init_types)) + (~ (type_to_code expected))) + (function ((~ name) (~+ vars)) + (~ body))) + (~+ inits)))))) + (do meta_monad + [aliases (monad\map meta_monad + (: (-> Code (Meta Code)) + (function (_ _) (gensym ""))) + inits)] + (return (list (` (let [(~+ (interleave aliases inits))] + (.loop (~ name) + [(~+ (interleave vars aliases))] + (~ body))))))))) + + #.None + (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& [_ (#Form (list [_ (#Tuple (list& hslot' tslots'))]))] body branches)) + (do meta_monad + [slots (: (Meta [Name (List Name)]) + (case (: (Maybe [Name (List Name)]) + (do maybe_monad + [hslot (get_tag hslot') + tslots (monad\map maybe_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 (monad\map meta_monad normalize tslots) + output (resolve_tag hslot) + g!_ (gensym "_") + #let [[idx tags exported? type] output + slot_pairings (list\map (: (-> Name [Text Code]) + (function (_ [module name]) + [name (local_identifier$ name)])) + (list& hslot tslots)) + pattern (record$ (list\map (: (-> Name [Code Code]) + (function (_ [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 Code) Code (Maybe (List Code))) + (case target + (^or [_ (#Bit _)] [_ (#Nat _)] [_ (#Int _)] [_ (#Rev _)] [_ (#Frac _)] [_ (#Text _)] [_ (#Tag _)]) + (#Some (list target)) + + [_ (#Identifier [prefix name])] + (if (and (text\= "" prefix) + (text\= label name)) + (#Some tokens) + (#Some (list target))) + + (^template [] + [[location ( elems)] + (do maybe_monad + [placements (monad\map maybe_monad (place_tokens label tokens) elems)] + (wrap (list [location ( (list\join placements))])))]) + ([#Tuple] + [#Form]) + + [location (#Record pairs)] + (do maybe_monad + [=pairs (monad\map maybe_monad + (: (-> [Code Code] (Maybe [Code Code])) + (function (_ [slot value]) + (do maybe_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 [location (#Record =pairs)]))) + )) + +(macro: #export (with_expansions tokens) + {#.doc (doc "Controlled macro-expansion." + "Bind an arbitraty number of Code nodes resulting from macro-expansion to local bindings." + "Wherever a binding appears, the bound Code nodes will be spliced in there." + (test: "Code operations & implementations" + (with_expansions + [ (template [ ] + [(compare (\ Code/encode encode ))] + + [(bit #1) "#1"] + [(int +123) "+123"] + [(frac +123.0) "+123.0"] + [(text "123") "'123'"] + [(tag ["yolo" "lol"]) "#yolo.lol"] + [(identifier ["yolo" "lol"]) "yolo.lol"] + [(form (list (bit #1))) "(#1)"] + [(tuple (list (bit #1))) "[#1]"] + [(record (list [(bit #1) (int +123)])) "{#1 +123}"] + )] + (test_all ))))} + (case tokens + (^ (list& [_ (#Tuple bindings)] bodies)) + (case bindings + (^ (list& [_ (#Identifier ["" var_name])] macro_expr bindings')) + (do meta_monad + [expansion (macro_expand_once macro_expr)] + (case (place_tokens var_name expansion (` (.with_expansions + [(~+ bindings')] + (~+ bodies)))) + (#Some output) + (wrap output) + + _ + (fail "[with_expansions] Improper macro expansion."))) + + #Nil + (return bodies) + + _ + (fail "Wrong syntax for with_expansions")) + + _ + (fail "Wrong syntax for with_expansions"))) + +(def: (flatten_alias type) + (-> Type Type) + (case type + (^template [] + [(#Named ["library/lux" ] _) + type]) + (["Bit"] + ["Nat"] + ["Int"] + ["Rev"] + ["Frac"] + ["Text"]) + + (#Named _ type') + (flatten_alias type') + + _ + type)) + +(def: (anti_quote_def name) + (-> Name (Meta Code)) + (do meta_monad + [type+value (find_def_value name) + #let [[type value] type+value]] + (case (flatten_alias type) + (^template [ ] + [(#Named ["library/lux" ] _) + (wrap ( (:as value)))]) + (["Bit" Bit bit$] + ["Nat" Nat nat$] + ["Int" Int int$] + ["Rev" Rev rev$] + ["Frac" Frac frac$] + ["Text" Text text$]) + + _ + (fail (text\compose "Cannot anti-quote type: " (name\encode name)))))) + +(def: (anti_quote token) + (-> Code (Meta Code)) + (case token + [_ (#Identifier [def_prefix def_name])] + (if (text\= "" def_prefix) + (do meta_monad + [current_module current_module_name] + (anti_quote_def [current_module def_name])) + (anti_quote_def [def_prefix def_name])) + + (^template [] + [[meta ( parts)] + (do meta_monad + [=parts (monad\map meta_monad anti_quote parts)] + (wrap [meta ( =parts)]))]) + ([#Form] + [#Tuple]) + + [meta (#Record pairs)] + (do meta_monad + [=pairs (monad\map meta_monad + (: (-> [Code Code] (Meta [Code Code])) + (function (_ [slot value]) + (do meta_monad + [=value (anti_quote value)] + (wrap [slot =value])))) + pairs)] + (wrap [meta (#Record =pairs)])) + + _ + (\ meta_monad return token) + ## TODO: Figure out why this doesn't work: + ## (\ meta_monad wrap token) + )) + +(macro: #export (static tokens) + (case tokens + (^ (list pattern)) + (do meta_monad + [pattern' (anti_quote pattern)] + (wrap (list pattern'))) + + _ + (fail "Wrong syntax for 'static'."))) + +(type: Multi_Level_Case + [Code (List [Code Code])]) + +(def: (case_level^ level) + (-> Code (Meta [Code Code])) + (case level + (^ [_ (#Tuple (list expr binding))]) + (return [expr binding]) + + _ + (return [level (` #1)]) + )) + +(def: (multi_level_case^ levels) + (-> (List Code) (Meta Multi_Level_Case)) + (case levels + #Nil + (fail "Multi-level patterns cannot be empty.") + + (#Cons init extras) + (do meta_monad + [extras' (monad\map meta_monad case_level^ extras)] + (wrap [init extras'])))) + +(def: (multi_level_case$ g!_ [[init_pattern levels] body]) + (-> Code [Multi_Level_Case Code] (List Code)) + (let [inner_pattern_body (list\fold (function (_ [calculation pattern] success) + (let [bind? (case pattern + [_ (#.Identifier _)] + #1 + + _ + #0)] + (` (case (~ calculation) + (~ pattern) + (~ success) + + (~+ (if bind? + (list) + (list g!_ (` #.None)))))))) + (` (#.Some (~ body))) + (: (List [Code Code]) (list\reverse levels)))] + (list init_pattern inner_pattern_body))) + +(macro: #export (^multi 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) + (^multi (#.Some [chunk uri']) [(text\= static chunk) #1]) + (match_uri endpoint? parts' uri') + + _ + (#.Left (format "Static part " (%t static) " does not match URI: " uri))) + + "Short-cuts can be taken when using bit tests." + "The example above can be rewritten as..." + (case (split (size static) uri) + (^multi (#.Some [chunk uri']) (text\= static chunk)) + (match_uri endpoint? parts' uri') + + _ + (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} + (case tokens + (^ (list& [_meta (#Form levels)] body next_branches)) + (do meta_monad + [mlc (multi_level_case^ levels) + #let [initial_bind? (case mlc + [[_ (#.Identifier _)] _] + #1 + + _ + #0)] + expected get_expected_type + g!temp (gensym "temp")] + (let [output (list g!temp + (` ({(#Some (~ g!temp)) + (~ g!temp) + + #None + (case (~ g!temp) + (~+ next_branches))} + ("lux type check" (#.Apply (~ (type_to_code expected)) Maybe) + (case (~ g!temp) + (~+ (multi_level_case$ g!temp [mlc body])) + + (~+ (if initial_bind? + (list) + (list g!temp (` #.None)))))))))] + (wrap output))) + + _ + (fail "Wrong syntax for ^multi"))) + +## TODO: Allow asking the compiler for the name of the definition +## currently being defined. That name can then be fed into +## 'wrong_syntax_error' for easier maintenance of the error_messages. +(def: wrong_syntax_error + (-> Name Text) + (|>> name\encode + (text\compose "Wrong syntax for "))) + +(macro: #export (name_of tokens) + {#.doc (doc "Given an identifier or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." + (name_of #.doc) + "=>" + [..prelude_module "doc"])} + (case tokens + (^template [] + [(^ (list [_ ( [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))]) + ([#Identifier] [#Tag]) + + _ + (fail (..wrong_syntax_error [..prelude_module "name_of"])))) + +(def: (get_scope_type_vars state) + (Meta (List Nat)) + (case state + {#info info #source source #current_module _ #modules modules + #scopes scopes #type_context types #host host + #seed seed #expected expected #location location #extensions extensions + #scope_type_vars scope_type_vars} + (#Right state scope_type_vars) + )) + +(def: (list_at idx xs) + (All [a] (-> Nat (List a) (Maybe a))) + (case xs + #Nil + #None + + (#Cons x xs') + (if ("lux i64 =" 0 idx) + (#Some x) + (list_at (dec idx) xs')))) + +(macro: #export ($ tokens) + {#.doc (doc "Allows you to refer to the type-variables in a polymorphic function's type, by their index." + "In the example below, 0 corresponds to the 'a' variable." + (def: #export (from_list list) + (All [a] (-> (List a) (Row a))) + (list\fold add + (: (Row ($ 0)) + empty) + list)))} + (case tokens + (^ (list [_ (#Nat idx)])) + (do meta_monad + [stvs get_scope_type_vars] + (case (list_at idx (list\reverse stvs)) + (#Some var_id) + (wrap (list (` (#Ex (~ (nat$ var_id)))))) + + #None + (fail (text\compose "Indexed-type does not exist: " (nat\encode idx))))) + + _ + (fail (..wrong_syntax_error (name_of ..$))))) + +(def: #export (is? reference sample) + {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." + "This one should succeed:" + (let [value +5] + (is? value value)) + + "This one should fail:" + (is? +5 (+ +2 +3)))} + (All [a] (-> a a Bit)) + ("lux is" reference sample)) + +(macro: #export (^@ tokens) + {#.doc (doc "Allows you to simultaneously bind and de-structure a value." + (def: (hash (^@ set [Hash _])) + (list\fold (function (_ elem acc) (+ (\ Hash hash elem) acc)) + 0 + (to_list set))))} + (case tokens + (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] pattern))] body branches)) + (let [g!whole (local_identifier$ name)] + (return (list& g!whole + (` (case (~ g!whole) (~ pattern) (~ body))) + branches))) + + _ + (fail (..wrong_syntax_error (name_of ..^@))))) + +(macro: #export (^|> tokens) + {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." + (case input + (^|> value [inc (% 10) (max 1)]) + (foo value)))} + (case tokens + (^ (list& [_meta (#Form (list [_ (#Identifier ["" name])] [_ (#Tuple steps)]))] body branches)) + (let [g!name (local_identifier$ name)] + (return (list& g!name + (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] + (~ body))) + branches))) + + _ + (fail (..wrong_syntax_error (name_of ..^|>))))) + +(macro: #export (:assume tokens) + {#.doc (doc "Coerces the given expression to the type of whatever is expected." + (: Dinosaur (:assume (list +1 +2 +3))))} + (case tokens + (^ (list expr)) + (do meta_monad + [type get_expected_type] + (wrap (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) + + _ + (fail (..wrong_syntax_error (name_of ..:assume))))) + +(def: location + {#.doc "The location of the current expression being analyzed."} + (Meta Location) + (function (_ compiler) + (#Right [compiler (get@ #location compiler)]))) + +(macro: #export (undefined tokens) + {#.doc (doc "Meant to be used as a stand-in for functions with undefined implementations." + "Undefined expressions will type-check against everything, so they make good dummy implementations." + "However, if an undefined expression is ever evaluated, it will raise a runtime error." + (def: (square x) + (-> Int Int) + (undefined)))} + (case tokens + #Nil + (do meta_monad + [location ..location + #let [[module line column] location + location ($_ "lux text concat" (text\encode module) "," (nat\encode line) "," (nat\encode column)) + message ($_ "lux text concat" "Undefined behavior @ " location)]] + (wrap (list (` (..error! (~ (text$ message))))))) + + _ + (fail (..wrong_syntax_error (name_of ..undefined))))) + +(macro: #export (:of tokens) + {#.doc (doc "Generates the type corresponding to a given expression." + "Example #1:" + (let [my_num +123] + (:of my_num)) + "==" + Int + "-------------------" + "Example #2:" + (:of +123) + "==" + Int)} + (case tokens + (^ (list [_ (#Identifier var_name)])) + (do meta_monad + [var_type (find_type var_name)] + (wrap (list (type_to_code var_type)))) + + (^ (list expression)) + (do meta_monad + [g!temp (gensym "g!temp")] + (wrap (list (` (let [(~ g!temp) (~ expression)] + (..:of (~ g!temp))))))) + + _ + (fail (..wrong_syntax_error (name_of ..:of))))) + +(def: (parse_complex_declaration tokens) + (-> (List Code) (Meta [[Text (List Text)] (List Code)])) + (case tokens + (^ (list& [_ (#Form (list& [_ (#Identifier ["" name])] args'))] tokens')) + (do meta_monad + [args (monad\map meta_monad + (function (_ arg') + (case arg' + [_ (#Identifier ["" arg_name])] + (wrap arg_name) + + _ + (fail "Could not parse an argument."))) + args')] + (wrap [[name args] tokens'])) + + _ + (fail "Could not parse a complex declaration.") + )) + +(def: (parse_any tokens) + (-> (List Code) (Meta [Code (List Code)])) + (case tokens + (^ (list& token tokens')) + (return [token tokens']) + + _ + (fail "Could not parse anything.") + )) + +(def: (parse_many tokens) + (-> (List Code) (Meta [(List Code) (List Code)])) + (case tokens + (^ (list& head tail)) + (return [tokens (list)]) + + _ + (fail "Could not parse anything.") + )) + +(def: (parse_end tokens) + (-> (List Code) (Meta Any)) + (case tokens + (^ (list)) + (return []) + + _ + (fail "Expected input Codes to be empty.") + )) + +(def: (parse_anns tokens) + (-> (List Code) (Meta [Code (List Code)])) + (case tokens + (^ (list& [_ (#Record _anns)] tokens')) + (return [(record$ _anns) tokens']) + + _ + (return [(' {}) tokens]) + )) + +(macro: #export (template: tokens) + {#.doc (doc "Define macros in the style of template and ^template." + "For simple macros that do not need any fancy features." + (template: (square x) + (* x x)))} + (do meta_monad + [#let [[export? tokens] (export^ tokens)] + name+args|tokens (parse_complex_declaration tokens) + #let [[[name args] tokens] name+args|tokens] + anns|tokens (parse_anns tokens) + #let [[anns tokens] anns|tokens] + input_templates|tokens (parse_many tokens) + #let [[input_templates tokens] input_templates|tokens] + _ (parse_end tokens) + g!tokens (gensym "tokens") + g!compiler (gensym "compiler") + g!_ (gensym "_") + #let [rep_env (list\map (function (_ arg) + [arg (` ((~' ~) (~ (local_identifier$ arg))))]) + args)] + this_module current_module_name] + (wrap (list (` (macro: (~+ (export export?)) + ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) + (~ anns) + (case (~ g!tokens) + (^ (list (~+ (list\map local_identifier$ args)))) + (#.Right [(~ g!compiler) + (list (~+ (list\map (function (_ template) + (` (`' (~ (replace_syntax rep_env template))))) + input_templates)))]) + + (~ g!_) + (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) + ))))) + )) + +(macro: #export (as_is tokens compiler) + (#Right [compiler tokens])) + +(macro: #export (char tokens compiler) + (case tokens + (^multi (^ (list [_ (#Text input)])) + (|> input "lux text size" ("lux i64 =" 1))) + (|> input ("lux text char" 0) + nat$ list + [compiler] #Right) + + _ + (#Left (..wrong_syntax_error (name_of ..char))))) + +(def: target + (Meta Text) + (function (_ compiler) + (#Right [compiler (get@ [#info #target] compiler)]))) + +(def: (resolve_target choice) + (-> Code (Meta Text)) + (case choice + [_ (#Text platform)] + (..return platform) + + [_ (#Identifier identifier)] + (do meta_monad + [identifier (..resolve_global_identifier identifier) + type+value (..find_def_value identifier) + #let [[type value] type+value]] + (case (..flatten_alias type) + (^or (#Primitive "#Text" #Nil) + (#Named ["library/lux" "Text"] (#Primitive "#Text" #Nil))) + (wrap (:as ..Text value)) + + _ + (fail ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) + + _ + (fail ($_ text\compose + "Invalid target platform syntax: " (..code\encode choice) + ..\n "Must be either a text literal or an identifier.")))) + +(def: (target_pick target options default) + (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) + (case options + #Nil + (case default + #.None + (fail ($_ text\compose "No code for target platform: " target)) + + (#.Some default) + (return (list default))) + + (#Cons [key pick] options') + (do meta_monad + [platform (..resolve_target key)] + (if (text\= target platform) + (return (list pick)) + (target_pick target options' default))))) + +(macro: #export (for tokens) + (do meta_monad + [target ..target] + (case tokens + (^ (list [_ (#Record options)])) + (target_pick target options #.None) + + (^ (list [_ (#Record options)] default)) + (target_pick target options (#.Some default)) + + _ + (fail (..wrong_syntax_error (name_of ..for)))))) + +(template [ ] + [(def: ( xy) + (All [a b] (-> [a b] )) + (let [[x y] xy] + ))] + + [left a x] + [right b y]) + +(def: (label_code code) + (-> Code (Meta [(List [Code Code]) Code])) + (case code + (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) + (do meta_monad + [g!expansion (gensym "g!expansion")] + (wrap [(list [g!expansion expansion]) g!expansion])) + + (^template [] + [[ann ( parts)] + (do meta_monad + [=parts (monad\map meta_monad label_code parts)] + (wrap [(list\fold list\compose (list) (list\map left =parts)) + [ann ( (list\map right =parts))]]))]) + ([#Form] [#Tuple]) + + [ann (#Record kvs)] + (do meta_monad + [=kvs (monad\map meta_monad + (function (_ [key val]) + (do meta_monad + [=key (label_code key) + =val (label_code val) + #let [[key_labels key_labelled] =key + [val_labels val_labelled] =val]] + (wrap [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) + kvs)] + (wrap [(list\fold list\compose (list) (list\map left =kvs)) + [ann (#Record (list\map right =kvs))]])) + + _ + (return [(list) code]))) + +(macro: #export (`` tokens) + (case tokens + (^ (list raw)) + (do meta_monad + [=raw (label_code raw) + #let [[labels labelled] =raw]] + (wrap (list (` (with_expansions [(~+ (|> labels + (list\map (function (_ [label expansion]) (list label expansion))) + list\join))] + (~ labelled)))))) + + _ + (fail (..wrong_syntax_error (name_of ..``))) + )) + +(def: (name$ [module name]) + (-> Name Code) + (` [(~ (text$ module)) (~ (text$ name))])) + +(def: (untemplate_list& last inits) + (-> Code (List Code) Code) + (case inits + #Nil + last + + (#Cons [init inits']) + (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) + +(def: (untemplate_record g!meta untemplate_pattern fields) + (-> Code (-> Code (Meta Code)) + (-> (List [Code Code]) (Meta Code))) + (do meta_monad + [=fields (monad\map meta_monad + (function (_ [key value]) + (do meta_monad + [=key (untemplate_pattern key) + =value (untemplate_pattern value)] + (wrap (` [(~ =key) (~ =value)])))) + fields)] + (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))])))) + +(template [ ] + [(def: ( g!meta untemplate_pattern elems) + (-> Code (-> Code (Meta Code)) + (-> (List Code) (Meta Code))) + (case (list\reverse elems) + (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + inits) + (do meta_monad + [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits))] + (wrap (` [(~ g!meta) ( (~ (untemplate_list& spliced =inits)))]))) + + _ + (do meta_monad + [=elems (monad\map meta_monad untemplate_pattern elems)] + (wrap (` [(~ g!meta) ( (~ (untemplate_list =elems)))])))))] + + [#.Tuple untemplate_tuple] + [#.Form untemplate_form] + ) + +(def: (untemplate_pattern pattern) + (-> Code (Meta Code)) + (do meta_monad + [g!meta (gensym "g!meta")] + (case pattern + (^template [ ] + [[_ ( value)] + (wrap (` [(~ g!meta) ( (~ ( value)))]))]) + ([#.Bit bit$] + [#.Nat nat$] + [#.Int int$] + [#.Rev rev$] + [#.Frac frac$] + [#.Text text$] + [#.Tag name$] + [#.Identifier name$]) + + [_ (#Form (#Cons [[_ (#Identifier ["" "~"])] (#Cons [unquoted #Nil])]))] + (return unquoted) + + [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") + + (^template [ ] + [[_ ( elems)] + ( g!meta untemplate_pattern elems)]) + ([#.Tuple ..untemplate_tuple] + [#.Form ..untemplate_form]) + + [_ (#Record fields)] + (..untemplate_record g!meta untemplate_pattern fields) + ))) + +(macro: #export (^code tokens) + (case tokens + (^ (list& [_meta (#Form (list template))] body branches)) + (do meta_monad + [pattern (untemplate_pattern template)] + (wrap (list& pattern body branches))) + + (^ (list template)) + (do meta_monad + [pattern (untemplate_pattern template)] + (wrap (list pattern))) + + _ + (fail (..wrong_syntax_error (name_of ..^code))))) + +(template [ ] + [(def: #export #0) + (def: #export #1)] + + [false true] + [no yes] + [off on] + ) + +(macro: #export (:let tokens) + (case tokens + (^ (list [_ (#Tuple bindings)] bodyT)) + (if (multiple? 2 (list\size bindings)) + (return (list (` (..with_expansions [(~+ (|> bindings + ..as_pairs + (list\map (function (_ [localT valueT]) + (list localT (` (..as_is (~ valueT)))))) + (list\fold list\compose (list))))] + (~ bodyT))))) + (..fail ":let requires an even number of parts")) + + _ + (..fail (..wrong_syntax_error (name_of ..:let))))) + +(macro: #export (try tokens) + {#.doc (doc (case (try (risky_computation input)) + (#.Right success) + (do_something success) + + (#.Left error) + (recover_from_failure error)))} + (case tokens + (^ (list expression)) + (do meta_monad + [g!_ (gensym "g!_")] + (wrap (list (` ("lux try" + (.function ((~ g!_) (~ g!_)) + (~ expression))))))) + + _ + (..fail (..wrong_syntax_error (name_of ..try))))) diff --git a/stdlib/source/library/lux/abstract/algebra.lux b/stdlib/source/library/lux/abstract/algebra.lux new file mode 100644 index 000000000..8e611b513 --- /dev/null +++ b/stdlib/source/library/lux/abstract/algebra.lux @@ -0,0 +1,17 @@ +(.module: + [library + [lux #* + [control + [functor (#+ Fix)]]]]) + +(type: #export (Algebra f a) + (-> (f a) a)) + +(type: #export (CoAlgebra f a) + (-> a (f a))) + +(type: #export (RAlgebra f a) + (-> (f (& (Fix f) a)) a)) + +(type: #export (RCoAlgebra f a) + (-> a (f (| (Fix f) a)))) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux new file mode 100644 index 000000000..0f63efc65 --- /dev/null +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -0,0 +1,37 @@ +(.module: + [library + [lux #*]] + [// + [monad (#+ Monad)] + ["." functor (#+ Functor)]]) + +(interface: #export (Apply f) + {#.doc "Applicative functors."} + (: (Functor f) + &functor) + (: (All [a b] + (-> (f (-> a b)) (f a) (f b))) + apply)) + +(implementation: #export (compose f-monad f-apply g-apply) + {#.doc "Applicative functor composition."} + (All [F G] + (-> (Monad F) (Apply F) (Apply G) + ## TODO: Replace (All [a] (F (G a))) with (functor.Then F G) + (Apply (All [a] (F (G a)))))) + + (def: &functor (functor.compose (get@ #&functor f-apply) (get@ #&functor g-apply))) + + (def: (apply fgf fgx) + ## TODO: Switch from this version to the one below (in comments) ASAP. + (let [fgf' (\ f-apply apply + (\ f-monad wrap (\ g-apply apply)) + fgf)] + (\ f-apply apply fgf' fgx)) + ## (let [applyF (\ f-apply apply) + ## applyG (\ g-apply apply)] + ## ($_ applyF + ## (\ f-monad wrap applyG) + ## fgf + ## fgx)) + )) diff --git a/stdlib/source/library/lux/abstract/codec.lux b/stdlib/source/library/lux/abstract/codec.lux new file mode 100644 index 000000000..2d734673f --- /dev/null +++ b/stdlib/source/library/lux/abstract/codec.lux @@ -0,0 +1,29 @@ +(.module: + [library + [lux #* + [control + ["." try (#+ Try)]]]] + [// + [monad (#+ do)] + ["." functor]]) + +(interface: #export (Codec m a) + {#.doc "A way to move back-and-forth between a type and an alternative representation for it."} + (: (-> a m) + encode) + (: (-> m (Try a)) + decode)) + +(implementation: #export (compose cb-codec ba-codec) + {#.doc "Codec composition."} + (All [a b c] + (-> (Codec c b) (Codec b a) + (Codec c a))) + (def: encode + (|>> (\ ba-codec encode) + (\ cb-codec encode))) + + (def: (decode cy) + (do try.monad + [by (\ cb-codec decode cy)] + (\ ba-codec decode by)))) diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux new file mode 100644 index 000000000..362556f50 --- /dev/null +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -0,0 +1,79 @@ +(.module: + [library + [lux #* + [data + [collection + ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]] + [meta + ["." location]]]] + [// + [functor (#+ Functor)]]) + +(interface: #export (CoMonad w) + {#.doc (doc "CoMonads are the opposite/complement to monads." + "CoMonadic structures are often infinite in size and built upon lazily-evaluated functions.")} + (: (Functor w) + &functor) + (: (All [a] + (-> (w a) a)) + unwrap) + (: (All [a] + (-> (w a) (w (w a)))) + split)) + +(macro: #export (be tokens state) + {#.doc (doc "A co-monadic parallel to the 'do' macro." + (let [square (function (_ n) (* n n))] + (be comonad + [inputs (iterate inc +2)] + (square (head inputs)))))} + (case (: (Maybe [(Maybe Text) Code (List Code) Code]) + (case tokens + (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] comonad]))] [_ (#.Tuple bindings)] body)) + (#.Some [(#.Some name) comonad bindings body]) + + (^ (list comonad [_ (#.Tuple bindings)] body)) + (#.Some [#.None comonad bindings body]) + + _ + #.None)) + (#.Some [?name comonad bindings body]) + (if (|> bindings list.size (n.% 2) (n.= 0)) + (let [[module short] (name_of ..be) + gensym (: (-> Text Code) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) + g!_ (gensym "_") + g!map (gensym "map") + g!split (gensym "split") + body' (list\fold (: (-> [Code Code] Code Code) + (function (_ binding body') + (let [[var value] binding] + (case var + [_ (#.Tag ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) (~ g!split) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))))) + )))) + body + (list.reverse (list.as_pairs bindings)))] + (#.Right [state (list (case ?name + (#.Some name) + (let [name [location.dummy (#.Identifier ["" name])]] + (` ({(~ name) + ({[(~ g!map) (~' unwrap) (~ g!split)] + (~ body')} + (~ name))} + (~ comonad)))) + + #.None + (` ({[(~ g!map) (~' unwrap) (~ g!split)] + (~ body')} + (~ comonad)))))])) + (#.Left "'be' bindings must have an even number of parts.")) + + #.None + (#.Left "Wrong syntax for 'be'"))) diff --git a/stdlib/source/library/lux/abstract/comonad/cofree.lux b/stdlib/source/library/lux/abstract/comonad/cofree.lux new file mode 100644 index 000000000..c0236f079 --- /dev/null +++ b/stdlib/source/library/lux/abstract/comonad/cofree.lux @@ -0,0 +1,28 @@ +(.module: + [library + [lux #*]] + [// (#+ CoMonad) + [// + [functor (#+ Functor)]]]) + +(type: #export (CoFree F a) + {#.doc "The CoFree CoMonad."} + [a (F (CoFree F a))]) + +(implementation: #export (functor dsl) + (All [F] (-> (Functor F) (Functor (CoFree F)))) + + (def: (map f [head tail]) + [(f head) (\ dsl map (map f) tail)])) + +(implementation: #export (comonad dsl) + (All [F] (-> (Functor F) (CoMonad (CoFree F)))) + + (def: &functor (..functor dsl)) + + (def: (unwrap [head tail]) + head) + + (def: (split [head tail]) + [[head tail] + (\ dsl map split tail)])) diff --git a/stdlib/source/library/lux/abstract/enum.lux b/stdlib/source/library/lux/abstract/enum.lux new file mode 100644 index 000000000..e80975172 --- /dev/null +++ b/stdlib/source/library/lux/abstract/enum.lux @@ -0,0 +1,26 @@ +(.module: + [library + [lux #*]] + [// + ["." order (#+ Order)]]) + +(interface: #export (Enum e) + {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."} + (: (Order e) &order) + (: (-> e e) succ) + (: (-> e e) pred)) + +(def: #export (range enum from to) + {#.doc "An inclusive [from, to] range of values."} + (All [a] (-> (Enum a) a a (List a))) + (let [(^open "/\.") enum] + (loop [end to + output #.Nil] + (cond (/\< end from) + (recur (/\pred end) (#.Cons end output)) + + (/\< from end) + (recur (/\succ end) (#.Cons end output)) + + ## (/\= end from) + (#.Cons end output))))) diff --git a/stdlib/source/library/lux/abstract/equivalence.lux b/stdlib/source/library/lux/abstract/equivalence.lux new file mode 100644 index 000000000..bb21f7711 --- /dev/null +++ b/stdlib/source/library/lux/abstract/equivalence.lux @@ -0,0 +1,25 @@ +(.module: + [library + [lux #*]] + [// + [functor + ["." contravariant]]]) + +(interface: #export (Equivalence a) + {#.doc "Equivalence for a type's instances."} + (: (-> a a Bit) + =)) + +(def: #export (rec sub) + (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a))) + (implementation + (def: (= left right) + (sub = left right)))) + +(implementation: #export functor + (contravariant.Functor Equivalence) + + (def: (map f equivalence) + (implementation + (def: (= reference sample) + (\ equivalence = (f reference) (f sample)))))) diff --git a/stdlib/source/library/lux/abstract/fold.lux b/stdlib/source/library/lux/abstract/fold.lux new file mode 100644 index 000000000..168d743be --- /dev/null +++ b/stdlib/source/library/lux/abstract/fold.lux @@ -0,0 +1,17 @@ +(.module: + [library + [lux #*]] + [// + [monoid (#+ Monoid)]]) + +(interface: #export (Fold F) + {#.doc "Iterate over a structure's values to build a summary value."} + (: (All [a b] + (-> (-> b a a) a (F b) a)) + fold)) + +(def: #export (with-monoid monoid fold value) + (All [F a] + (-> (Monoid a) (Fold F) (F a) a)) + (let [(^open "/\.") monoid] + (fold /\compose /\identity value))) diff --git a/stdlib/source/library/lux/abstract/functor.lux b/stdlib/source/library/lux/abstract/functor.lux new file mode 100644 index 000000000..fb56625e8 --- /dev/null +++ b/stdlib/source/library/lux/abstract/functor.lux @@ -0,0 +1,45 @@ +(.module: [library + lux]) + +(interface: #export (Functor f) + (: (All [a b] + (-> (-> a b) + (-> (f a) (f b)))) + map)) + +(type: #export (Fix f) + (f (Fix f))) + +(type: #export (Or f g) + (All [a] (| (f a) (g a)))) + +(def: #export (sum (^open "f\.") (^open "g\.")) + (All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G)))) + (implementation + (def: (map f fa|ga) + (case fa|ga + (#.Left fa) + (#.Left (f\map f fa)) + + (#.Right ga) + (#.Right (g\map f ga)))))) + +(type: #export (And f g) + (All [a] (& (f a) (g a)))) + +(def: #export (product (^open "f\.") (^open "g\.")) + (All [F G] (-> (Functor F) (Functor G) (Functor (..And F G)))) + (implementation + (def: (map f [fa ga]) + [(f\map f fa) + (g\map f ga)]))) + +(type: #export (Then f g) + (All [a] (f (g a)))) + +(def: #export (compose (^open "f\.") (^open "g\.")) + {#.doc "Functor composition."} + (All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G)))) + (implementation + (def: (map f fga) + (f\map (g\map f) fga)))) diff --git a/stdlib/source/library/lux/abstract/functor/contravariant.lux b/stdlib/source/library/lux/abstract/functor/contravariant.lux new file mode 100644 index 000000000..db66f1265 --- /dev/null +++ b/stdlib/source/library/lux/abstract/functor/contravariant.lux @@ -0,0 +1,9 @@ +(.module: + [library + [lux #*]]) + +(interface: #export (Functor f) + (: (All [a b] + (-> (-> b a) + (-> (f a) (f b)))) + map)) diff --git a/stdlib/source/library/lux/abstract/hash.lux b/stdlib/source/library/lux/abstract/hash.lux new file mode 100644 index 000000000..2cc18f3e4 --- /dev/null +++ b/stdlib/source/library/lux/abstract/hash.lux @@ -0,0 +1,27 @@ +(.module: + [library + [lux #*]] + [// + ["." equivalence (#+ Equivalence)] + [functor + ["." contravariant]]]) + +(interface: #export (Hash a) + {#.doc (doc "A way to produce hash-codes for a type's instances." + "A necessity when working with some data-structures, such as dictionaries or sets.")} + (: (Equivalence a) + &equivalence) + (: (-> a Nat) + hash)) + +(implementation: #export functor + (contravariant.Functor Hash) + + (def: (map f super) + (implementation + (def: &equivalence + (\ equivalence.functor map f + (\ super &equivalence))) + + (def: hash + (|>> f (\ super hash)))))) diff --git a/stdlib/source/library/lux/abstract/interval.lux b/stdlib/source/library/lux/abstract/interval.lux new file mode 100644 index 000000000..5fbf26109 --- /dev/null +++ b/stdlib/source/library/lux/abstract/interval.lux @@ -0,0 +1,194 @@ +## https://en.wikipedia.org/wiki/Interval_(mathematics) +(.module: + [library + [lux #*]] + [// + [equivalence (#+ Equivalence)] + ["." order] + [enum (#+ Enum)]]) + +(interface: #export (Interval a) + {#.doc "A representation of top and bottom boundaries for an ordered type."} + (: (Enum a) + &enum) + + (: a + bottom) + + (: a + top)) + +(def: #export (between enum bottom top) + (All [a] (-> (Enum a) a a (Interval a))) + (implementation + (def: &enum enum) + (def: bottom bottom) + (def: top top))) + +(def: #export (singleton enum elem) + (All [a] (-> (Enum a) a (Interval a))) + (implementation + (def: &enum enum) + (def: bottom elem) + (def: top elem))) + +(template [ ] + [(def: #export ( interval) + (All [a] (-> (Interval a) Bit)) + (let [(^open ",\.") interval] + ( ,\bottom ,\top)))] + + [inner? (order.> ,\&order)] + [outer? ,\<] + [singleton? ,\=] + ) + +(def: #export (within? interval elem) + (All [a] (-> (Interval a) a Bit)) + (let [(^open ",\.") interval] + (cond (inner? interval) + (and (order.>= ,\&order ,\bottom elem) + (order.<= ,\&order ,\top elem)) + + (outer? interval) + (or (order.>= ,\&order ,\bottom elem) + (order.<= ,\&order ,\top elem)) + + ## singleton + (and (,\= ,\bottom elem) + (,\= ,\top elem))))) + +(template [ ] + [(def: #export ( elem interval) + (All [a] (-> a (Interval a) Bit)) + (let [(^open ".") interval] + (= elem)))] + + [starts_with? bottom] + [ends_with? top] + ) + +(def: #export (borders? interval elem) + (All [a] (-> (Interval a) a Bit)) + (or (starts_with? elem interval) + (ends_with? elem interval))) + +(def: #export (union left right) + (All [a] (-> (Interval a) (Interval a) (Interval a))) + (implementation + (def: &enum (get@ #&enum right)) + (def: bottom (order.min (\ right &order) (\ left bottom) (\ right bottom))) + (def: top (order.max (\ right &order) (\ left top) (\ right top))))) + +(def: #export (intersection left right) + (All [a] (-> (Interval a) (Interval a) (Interval a))) + (implementation + (def: &enum (get@ #&enum right)) + (def: bottom (order.max (\ right &order) (\ left bottom) (\ right bottom))) + (def: top (order.min (\ right &order) (\ left top) (\ right top))))) + +(def: #export (complement interval) + (All [a] (-> (Interval a) (Interval a))) + (let [(^open ".") interval] + (implementation + (def: &enum (get@ #&enum interval)) + (def: bottom (succ top)) + (def: top (pred bottom))))) + +(def: #export (precedes? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (let [(^open ".") reference + limit (\ reference bottom)] + (and (< limit (\ sample bottom)) + (< limit (\ sample top))))) + +(def: #export (succeeds? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (precedes? sample reference)) + +(template [ ] + [(def: #export ( reference sample) + (All [a] (-> a (Interval a) Bit)) + (let [(^open ",\.") sample] + (and ( reference ,\bottom) + ( reference ,\top))))] + + [before? ,\<] + [after? (order.> ,\&order)] + ) + +(def: #export (meets? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (let [(^open ",\.") reference + limit (\ reference bottom)] + (and (,\= limit (\ sample top)) + (order.<= ,\&order limit (\ sample bottom))))) + +(def: #export (touches? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (or (meets? reference sample) + (meets? sample reference))) + +(template [ ] + [(def: #export ( reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (let [(^open ",\.") reference] + (and (,\= (\ reference ) + (\ sample )) + ( ,\&order + (\ reference ) + (\ sample )))))] + + [starts? ,\bottom order.<= ,\top] + [finishes? ,\top order.>= ,\bottom] + ) + +(implementation: #export equivalence (All [a] (Equivalence (Interval a))) + (def: (= reference sample) + (let [(^open ",\.") reference] + (and (,\= ,\bottom (\ sample bottom)) + (,\= ,\top (\ sample top)))))) + +(def: #export (nested? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (cond (or (singleton? sample) + (and (inner? reference) (inner? sample)) + (and (outer? reference) (outer? sample))) + (let [(^open ",\.") reference] + (and (order.>= ,\&order (\ reference bottom) (\ sample bottom)) + (order.<= ,\&order (\ reference top) (\ sample top)))) + + (or (singleton? reference) + (and (inner? reference) (outer? sample))) + #0 + + ## (and (outer? reference) (inner? sample)) + (let [(^open ",\.") reference] + (or (and (order.>= ,\&order (\ reference bottom) (\ sample bottom)) + (order.> ,\&order (\ reference bottom) (\ sample top))) + (and (,\< (\ reference top) (\ sample bottom)) + (order.<= ,\&order (\ reference top) (\ sample top))))) + )) + +(def: #export (overlaps? reference sample) + (All [a] (-> (Interval a) (Interval a) Bit)) + (let [(^open ",\.") reference] + (and (not (\ ..equivalence = reference sample)) + (cond (singleton? sample) + #0 + + (singleton? reference) + (nested? sample reference) + + (or (and (inner? sample) (outer? reference)) + (and (outer? sample) (inner? reference))) + (or (order.>= ,\&order (\ reference bottom) (\ sample top)) + (order.<= ,\&order (\ reference top) (\ sample bottom))) + + ## both inner + (inner? sample) + (inner? (intersection reference sample)) + + ## both outer + (not (nested? reference sample)) + )))) diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux new file mode 100644 index 000000000..a99baf75b --- /dev/null +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -0,0 +1,184 @@ +(.module: + [library + [lux #* + [meta + ["." location]]]] + [// + [functor (#+ Functor)]]) + +(def: (list\fold f init xs) + (All [a b] + (-> (-> b a a) a (List b) a)) + (case xs + #.Nil + init + + (#.Cons x xs') + (list\fold f (f x init) xs'))) + +(def: (list\size xs) + (All [a] (-> (List a) Nat)) + (loop [counter 0 + xs xs] + (case xs + #.Nil + counter + + (#.Cons _ xs') + (recur (inc counter) xs')))) + +(def: (reverse xs) + (All [a] + (-> (List a) (List a))) + (list\fold (function (_ 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)) + +(interface: #export (Monad m) + (: (Functor m) + &functor) + (: (All [a] + (-> a (m a))) + wrap) + (: (All [a] + (-> (m (m a)) (m a))) + join)) + +(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 (: (Maybe [(Maybe Text) Code (List Code) Code]) + (case tokens + (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body)) + (#.Some [(#.Some name) monad bindings body]) + + (^ (list monad [_ (#.Tuple bindings)] body)) + (#.Some [#.None monad bindings body]) + + _ + #.None)) + (#.Some [?name monad bindings body]) + (if (|> bindings list\size .int ("lux i64 %" +2) ("lux i64 =" +0)) + (let [[module short] (name_of ..do) + gensym (: (-> Text Code) + (|>> ($_ "lux text concat" module " " short " ") [""] #.Identifier [location.dummy])) + g!_ (gensym "_") + g!map (gensym "map") + g!join (gensym "join") + body' (list\fold (: (-> [Code Code] Code Code) + (function (_ binding body') + (let [[var value] binding] + (case var + [_ (#.Tag ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) ((~ g!map) (function ((~ g!_) (~ var)) (~ body'))) (~ g!join))) + )))) + body + (reverse (as_pairs bindings)))] + (#.Right [state (list (case ?name + (#.Some name) + (let [name [location.dummy (#.Identifier ["" name])]] + (` ({(~ name) + ({[(~ g!map) (~' wrap) (~ g!join)] + (~ body')} + (~ name))} + (~ monad)))) + + #.None + (` ({[(~ g!map) (~' wrap) (~ g!join)] + (~ body')} + (~ monad)))))])) + (#.Left "'do' bindings must have an even number of parts.")) + + #.None + (#.Left "Wrong syntax for 'do'"))) + +(def: #export (bind monad f) + (All [! a b] + (-> (Monad !) (-> a (! b)) + (-> (! a) (! b)))) + (|>> (\ monad map f) + (\ monad join))) + +(def: #export (seq monad) + {#.doc "Run all the monadic values in the list and produce a list of the base values."} + (All [M a] + (-> (Monad M) (List (M a)) + (M (List a)))) + (let [(^open "!\.") monad] + (function (recur xs) + (case xs + #.Nil + (!\wrap #.Nil) + + (#.Cons x xs') + (|> x + (!\map (function (_ _x) + (!\map (|>> (#.Cons _x)) (recur xs')))) + !\join))))) + +(def: #export (map monad f) + {#.doc "Apply a monadic function to all values in a list."} + (All [M a b] + (-> (Monad M) (-> a (M b)) (List a) + (M (List b)))) + (let [(^open "!\.") monad] + (function (recur xs) + (case xs + #.Nil + (!\wrap #.Nil) + + (#.Cons x xs') + (|> (f x) + (!\map (function (_ _x) + (!\map (|>> (#.Cons _x)) (recur xs')))) + !\join))))) + +(def: #export (filter monad f) + {#.doc "Filter the values in a list with a monadic function."} + (All [! a b] + (-> (Monad !) (-> a (! Bit)) (List a) + (! (List a)))) + (let [(^open "!\.") monad] + (function (recur xs) + (case xs + #.Nil + (!\wrap #.Nil) + + (#.Cons head xs') + (|> (f head) + (!\map (function (_ verdict) + (!\map (function (_ tail) + (if verdict + (#.Cons head tail) + tail)) + (recur xs')))) + !\join))))) + +(def: #export (fold monad f init xs) + {#.doc "Fold a list with a monadic function."} + (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)] + (fold monad f init' xs')))) diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux new file mode 100644 index 000000000..9648fbc8e --- /dev/null +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -0,0 +1,68 @@ +(.module: + [library + [lux #*]] + [/// + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad)]]) + +(type: #export (Free F a) + {#.doc "The Free Monad."} + (#Pure a) + (#Effect (F (Free F a)))) + +(implementation: #export (functor dsl) + (All [F] (-> (Functor F) (Functor (Free F)))) + + (def: (map f ea) + (case ea + (#Pure a) + (#Pure (f a)) + + (#Effect value) + (#Effect (\ dsl map (map f) value))))) + +(implementation: #export (apply dsl) + (All [F] (-> (Functor F) (Apply (Free F)))) + + (def: &functor (..functor dsl)) + + (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 + (function (_ f) (apply f ea)) + ff)) + ))) + +(implementation: #export (monad dsl) + (All [F] (-> (Functor F) (Monad (Free F)))) + + (def: &functor (..functor dsl)) + + (def: (wrap a) + (#Pure a)) + + (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)) + ))) diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux new file mode 100644 index 000000000..92db5f045 --- /dev/null +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -0,0 +1,84 @@ +(.module: + [library + [lux #* + [control + [monad] + ["p" parser + ["s" code (#+ Parser)]]] + [data + [collection + ["." list ("#\." functor fold)]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]]]]) + +(interface: #export (IxMonad m) + (: (All [p a] + (-> a (m p p a))) + wrap) + + (: (All [ii it io vi vo] + (-> (-> vi (m it io vo)) + (m ii it vi) + (m ii io vo))) + bind)) + +(type: Binding [Code Code]) + +(def: binding + (Parser Binding) + (p.and s.any s.any)) + +(type: Context + (#Let (List Binding)) + (#Bind Binding)) + +(def: context + (Parser Context) + (p.or (p.after (s.this! (' #let)) + (s.tuple (p.some binding))) + binding)) + +(def: (pair_list [binding value]) + (All [a] (-> [a a] (List a))) + (list binding value)) + +(def: named_monad + (Parser [(Maybe Text) Code]) + (p.either (s.record (p.and (\ p.monad map (|>> #.Some) + s.local_identifier) + s.any)) + (\ p.monad map (|>> [#.None]) + s.any))) + +(syntax: #export (do {[?name monad] ..named_monad} + {context (s.tuple (p.some context))} + expression) + (macro.with_gensyms [g!_ g!bind] + (let [body (list\fold (function (_ context next) + (case context + (#Let bindings) + (` (let [(~+ (|> bindings + (list\map pair_list) + list.concat))] + (~ next))) + + (#Bind [binding value]) + (` ((~ g!bind) + (.function ((~ g!_) (~ binding)) + (~ next)) + (~ value))))) + expression + (list.reverse context))] + (wrap (list (case ?name + (#.Some name) + (let [name (code.local_identifier name)] + (` (let [(~ name) (~ monad) + {#..wrap (~' wrap) + #..bind (~ g!bind)} (~ name)] + (~ body)))) + + #.None + (` (let [{#..wrap (~' wrap) + #..bind (~ g!bind)} (~ monad)] + (~ body))))))))) diff --git a/stdlib/source/library/lux/abstract/monoid.lux b/stdlib/source/library/lux/abstract/monoid.lux new file mode 100644 index 000000000..87f155848 --- /dev/null +++ b/stdlib/source/library/lux/abstract/monoid.lux @@ -0,0 +1,21 @@ +(.module: + [library + [lux #*]]) + +(interface: #export (Monoid a) + {#.doc (doc "A way to compose values." + "Includes an identity value which does not alter any other value when combined with.")} + (: a + identity) + (: (-> a a a) + compose)) + +(def: #export (compose left right) + (All [l r] (-> (Monoid l) (Monoid r) (Monoid [l r]))) + (implementation + (def: identity + [(\ left identity) (\ right identity)]) + + (def: (compose [lL rL] [lR rR]) + [(\ left compose lL lR) + (\ right compose rL rR)]))) diff --git a/stdlib/source/library/lux/abstract/order.lux b/stdlib/source/library/lux/abstract/order.lux new file mode 100644 index 000000000..3eaafaf3a --- /dev/null +++ b/stdlib/source/library/lux/abstract/order.lux @@ -0,0 +1,58 @@ +(.module: + [library + [lux #* + [control + ["." function]]]] + [// + ["." equivalence (#+ Equivalence)] + [functor + ["." contravariant]]]) + +(interface: #export (Order a) + {#.doc "A signature for types that possess some sense of ordering among their elements."} + + (: (Equivalence a) + &equivalence) + + (: (-> a a Bit) + <) + ) + +(type: #export (Comparison a) + (-> (Order a) a a Bit)) + +(def: #export (<= order parameter subject) + Comparison + (or (\ order < parameter subject) + (\ order = parameter subject))) + +(def: #export (> order parameter subject) + Comparison + (\ order < subject parameter)) + +(def: #export (>= order parameter subject) + Comparison + (or (\ order < subject parameter) + (\ order = subject parameter))) + +(type: #export (Choice a) + (-> (Order a) a a a)) + +(def: #export (min order x y) + Choice + (if (\ order < y x) x y)) + +(def: #export (max order x y) + Choice + (if (\ order < y x) y x)) + +(implementation: #export functor + (contravariant.Functor Order) + + (def: (map f order) + (implementation + (def: &equivalence + (\ equivalence.functor map f (\ order &equivalence))) + + (def: (< reference sample) + (\ order < (f reference) (f sample)))))) diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux new file mode 100644 index 000000000..205ccc316 --- /dev/null +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -0,0 +1,61 @@ +(.module: + [library + [lux #* + [control + ["." function]]]] + [// + [monoid (#+ Monoid)] + [functor + ["." contravariant]]]) + +(type: #export (Predicate a) + (-> a Bit)) + +(template [ ] + [(def: #export + Predicate + (function.constant )) + + (def: #export ( left right) + (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) + (function (_ value) + ( (left value) + (right value))))] + + [none #0 unite or] + [all #1 intersect and] + ) + +(template [ ] + [(implementation: #export + (All [a] (Monoid (Predicate a))) + + (def: identity ) + (def: compose ))] + + [union ..none ..unite] + [intersection ..all ..intersect] + ) + +(def: #export (complement predicate) + (All [a] (-> (Predicate a) (Predicate a))) + (|>> predicate not)) + +(def: #export (difference sub base) + (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) + (function (_ value) + (and (base value) + (not (sub value))))) + +(def: #export (rec predicate) + (All [a] + (-> (-> (Predicate a) (Predicate a)) + (Predicate a))) + (function (recur input) + (predicate recur input))) + +(implementation: #export functor + (contravariant.Functor Predicate) + + (def: (map f fb) + (|>> f fb))) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux new file mode 100644 index 000000000..2143a0c97 --- /dev/null +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -0,0 +1,331 @@ +(.module: + [library + [lux (#- Alias if loop) + ["." meta] + [abstract + ["." monad]] + [data + ["." maybe ("#\." monad)] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." fold functor)]]] + ["." macro (#+ with_gensyms) + ["." code] + [syntax (#+ syntax:) + ["|.|" export] + ["|.|" annotations]]] + [math + [number + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]]]] + [// + ["<>" parser ("#\." monad) + ["" code (#+ Parser)]]]) + +(type: Alias [Text Code]) + +(type: Stack + {#bottom (Maybe Nat) + #top (List Code)}) + +(def: aliases^ + (Parser (List Alias)) + (|> (<>.and .local_identifier .any) + <>.some + .record + (<>.default (list)))) + +(def: bottom^ + (Parser Nat) + (.form (<>.after (.this! (` #.Parameter)) .nat))) + +(def: stack^ + (Parser Stack) + (<>.either (<>.and (<>.maybe bottom^) + (.tuple (<>.some .any))) + (<>.and (|> bottom^ (<>\map (|>> #.Some))) + (<>\wrap (list))))) + +(def: (stack_fold tops bottom) + (-> (List Code) Code Code) + (list\fold (function (_ top bottom) + (` [(~ bottom) (~ top)])) + bottom + tops)) + +(def: (singleton expander) + (-> (Meta (List Code)) (Meta Code)) + (monad.do meta.monad + [expansion expander] + (case expansion + (#.Cons singleton #.Nil) + (wrap singleton) + + _ + (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new_line + (|> expansion (list\map %.code) (text.join_with " "))))))) + +(syntax: #export (=> {aliases aliases^} + {inputs stack^} + {outputs stack^}) + (let [de_alias (function (_ aliased) + (list\fold (function (_ [from to] pre) + (code.replace (code.local_identifier from) to pre)) + aliased + aliases))] + (case [(|> inputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`)))) + (|> outputs (get@ #bottom) (maybe\map (|>> code.nat (~) #.Parameter (`))))] + [(#.Some bottomI) (#.Some bottomO)] + (monad.do meta.monad + [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) bottomI))) + outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) bottomO)))] + (wrap (list (` (-> (~ (de_alias inputC)) + (~ (de_alias outputC))))))) + + [?bottomI ?bottomO] + (with_gensyms [g!stack] + (monad.do meta.monad + [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] + (wrap (list (` (All [(~ g!stack)] + (-> (~ (de_alias inputC)) + (~ (de_alias outputC)))))))))))) + +(def: begin! Any []) + +(def: end! + (All [a] (-> [Any a] a)) + (function (_ [_ top]) + top)) + +(syntax: #export (||> {commands (<>.some .any)}) + (wrap (list (` (|> (~! ..begin!) (~+ commands) ((~! ..end!))))))) + +(syntax: #export (word: + {export |export|.parser} + {name .local_identifier} + {annotations (<>.default |annotations|.empty |annotations|.parser)} + type + {commands (<>.some .any)}) + (wrap (list (` (def: (~+ (|export|.format export)) (~ (code.local_identifier name)) + (~ (|annotations|.format annotations)) + (~ type) + (|>> (~+ commands))))))) + +(syntax: #export (apply {arity (|> .nat (<>.filter (n.> 0)))}) + (with_gensyms [g! g!func g!stack g!output] + (monad.do {! meta.monad} + [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq !))] + (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] + (-> (-> (~+ g!inputs) (~ g!output)) + (=> [(~+ g!inputs)] [(~ g!output)]))) + (function ((~ g!) (~ g!func)) + (function ((~ g!) (~ (stack_fold g!inputs g!stack))) + [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) + +(def: #export apply/1 (apply 1)) +(def: #export apply/2 (apply 2)) +(def: #export apply/3 (apply 3)) +(def: #export apply/4 (apply 4)) +(def: #export apply/5 (apply 5)) +(def: #export apply/6 (apply 6)) +(def: #export apply/7 (apply 7)) +(def: #export apply/8 (apply 8)) + +(def: #export (push x) + (All [a] (-> a (=> [] [a]))) + (function (_ stack) + [stack x])) + +(def: #export drop + (All [t] (=> [t] [])) + (function (_ [stack top]) + stack)) + +(def: #export nip + (All [_ a] (=> [_ a] [a])) + (function (_ [[stack _] top]) + [stack top])) + +(def: #export dup + (All [a] (=> [a] [a a])) + (function (_ [stack top]) + [[stack top] top])) + +(def: #export swap + (All [a b] (=> [a b] [b a])) + (function (_ [[stack l] r]) + [[stack r] l])) + +(def: #export rotL + (All [a b c] (=> [a b c] [b c a])) + (function (_ [[[stack a] b] c]) + [[[stack b] c] a])) + +(def: #export rotR + (All [a b c] (=> [a b c] [c a b])) + (function (_ [[[stack a] b] c]) + [[[stack c] a] b])) + +(def: #export && + (All [a b] (=> [a b] [(& a b)])) + (function (_ [[stack l] r]) + [stack [l r]])) + +(def: #export ||L + (All [a b] (=> [a] [(| a b)])) + (function (_ [stack l]) + [stack (0 #0 l)])) + +(def: #export ||R + (All [a b] (=> [b] [(| a b)])) + (function (_ [stack r]) + [stack (0 #1 r)])) + +(template [ ] + [(def: #export + (=> [ ] []) + (function (_ [[stack subject] param]) + [stack ( param subject)]))] + + [Nat Nat n/+ n.+] + [Nat Nat n/- n.-] + [Nat Nat n/* n.*] + [Nat Nat n// n./] + [Nat Nat n/% n.%] + [Nat Bit n/= n.=] + [Nat Bit n/< n.<] + [Nat Bit n/<= n.<=] + [Nat Bit n/> n.>] + [Nat Bit n/>= n.>=] + + [Int Int i/+ i.+] + [Int Int i/- i.-] + [Int Int i/* i.*] + [Int Int i// i./] + [Int Int i/% i.%] + [Int Bit i/= i.=] + [Int Bit i/< i.<] + [Int Bit i/<= i.<=] + [Int Bit i/> i.>] + [Int Bit i/>= i.>=] + + [Rev Rev r/+ r.+] + [Rev Rev r/- r.-] + [Rev Rev r/* r.*] + [Rev Rev r// r./] + [Rev Rev r/% r.%] + [Rev Bit r/= r.=] + [Rev Bit r/< r.<] + [Rev Bit r/<= r.<=] + [Rev Bit r/> r.>] + [Rev Bit r/>= r.>=] + + [Frac Frac f/+ f.+] + [Frac Frac f/- f.-] + [Frac Frac f/* f.*] + [Frac Frac f// f./] + [Frac Frac f/% f.%] + [Frac Bit f/= f.=] + [Frac Bit f/< f.<] + [Frac Bit f/<= f.<=] + [Frac Bit f/> f.>] + [Frac Bit f/>= f.>=] + ) + +(def: #export if + (All [___a ___z] + (=> {then (=> ___a ___z) + else (=> ___a ___z)} + ___a [Bit then else] ___z)) + (function (_ [[[stack test] then] else]) + (.if test + (then stack) + (else stack)))) + +(def: #export call + (All [___a ___z] + (=> {quote (=> ___a ___z)} + ___a [quote] ___z)) + (function (_ [stack quote]) + (quote stack))) + +(def: #export loop + (All [___] + (=> {test (=> ___ ___ [Bit])} + ___ [test] ___)) + (function (loop [stack pred]) + (let [[stack' verdict] (pred stack)] + (.if verdict + (loop [stack' pred]) + stack')))) + +(def: #export dip + (All [___ a] + (=> ___ [a (=> ___ ___)] + ___ [a])) + (function (_ [[stack a] quote]) + [(quote stack) a])) + +(def: #export dip/2 + (All [___ a b] + (=> ___ [a b (=> ___ ___)] + ___ [a b])) + (function (_ [[[stack a] b] quote]) + [[(quote stack) a] b])) + +(def: #export do + (All [___a ___z] + (=> {body (=> ___a ___z) + pred (=> ___z ___a [Bit])} + ___a [pred body] + ___z [pred body])) + (function (_ [[stack pred] body]) + [[(body stack) pred] body])) + +(def: #export while + (All [___a ___z] + (=> {body (=> ___z ___a) + pred (=> ___a ___z [Bit])} + ___a [pred body] + ___z)) + (function (while [[stack pred] body]) + (let [[stack' verdict] (pred stack)] + (.if verdict + (while [[(body stack') pred] body]) + stack')))) + +(def: #export compose + (All [___a ___ ___z] + (=> [(=> ___a ___) (=> ___ ___z)] + [(=> ___a ___z)])) + (function (_ [[stack f] g]) + [stack (|>> f g)])) + +(def: #export curry + (All [___a ___z a] + (=> ___a [a (=> ___a [a] ___z)] + ___a [(=> ___a ___z)])) + (function (_ [[stack arg] quote]) + [stack (|>> (push arg) quote)])) + +(word: #export when + (All [___] + (=> {body (=> ___ ___)} + ___ [Bit body] + ___)) + swap + (push (|>> call)) + (push (|>> drop)) + if) + +(word: #export ? + (All [a] + (=> [Bit a a] [a])) + rotL + (push (|>> drop)) + (push (|>> nip)) + if) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux new file mode 100644 index 000000000..a12e65471 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -0,0 +1,390 @@ +(.module: {#.doc "The actor model of concurrency."} + [library + [lux #* + [abstract + monad] + [control + [pipe (#+ case>)] + ["." function] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + ["<>" parser + ["<.>" code (#+ Parser)]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." monoid monad fold)]]] + ["." macro (#+ with_gensyms) + ["." code] + [syntax (#+ syntax:) + ["|.|" input] + ["|.|" export] + ["|.|" annotations]]] + [math + [number + ["n" nat]]] + ["." meta (#+ monad) + ["." annotation]] + [type (#+ :share) + ["." abstract (#+ abstract: :representation :abstraction)]]]] + [// + ["." atom (#+ Atom atom)] + ["." promise (#+ Promise Resolver) ("#\." monad)] + ["." frp (#+ Channel)]]) + +(exception: #export poisoned) +(exception: #export dead) + +(with_expansions + [ (as_is (-> s (Actor s) (Promise (Try s)))) + (as_is [Text s (List )]) + (as_is (Rec Mailbox + [(Promise [ Mailbox]) + (Resolver [ Mailbox])]))] + + (def: (pending [read write]) + (All [a] + (-> (Rec Mailbox + [(Promise [a Mailbox]) + (Resolver [a Mailbox])]) + (IO (List a)))) + (do {! io.monad} + [current (promise.poll read)] + (case current + (#.Some [head tail]) + (\ ! map (|>> (#.Cons head)) + (pending tail)) + + #.None + (wrap #.Nil)))) + + (abstract: #export (Actor s) + {#obituary [(Promise ) + (Resolver )] + #mailbox (Atom )} + + (type: #export (Mail s) + ) + + (type: #export (Obituary s) + ) + + (type: #export (Behavior o s) + {#.doc "An actor's behavior when mail is received and when a fatal error occurs."} + {#on_init (-> o s) + #on_mail (-> (Mail s) s (Actor s) (Promise (Try s)))}) + + (def: #export (spawn! behavior init) + {#.doc "Given a behavior and initial state, spawns an actor and returns it."} + (All [o s] (-> (Behavior o s) o (IO (Actor s)))) + (io (let [[on_init on_mail] behavior + self (:share [o s] + (Behavior o s) + behavior + + (Actor s) + (:abstraction {#obituary (promise.promise []) + #mailbox (atom (promise.promise []))})) + process (loop [state (on_init init) + [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] + (do {! promise.monad} + [[head tail] |mailbox| + ?state' (on_mail head state self)] + (case ?state' + (#try.Failure error) + (let [[_ resolve] (get@ #obituary (:representation self))] + (exec (io.run + (do io.monad + [pending (..pending tail)] + (resolve [error state (#.Cons head pending)]))) + (wrap []))) + + (#try.Success state') + (recur state' tail))))] + self))) + + (def: #export (alive? actor) + (All [s] (-> (Actor s) (IO Bit))) + (let [[obituary _] (get@ #obituary (:representation actor))] + (|> obituary + promise.poll + (\ io.functor map + (|>> (case> #.None + yes + + _ + no)))))) + + (def: #export (obituary actor) + (All [s] (-> (Actor s) (IO (Maybe (Obituary s))))) + (let [[obituary _] (get@ #obituary (:representation actor))] + (promise.poll obituary))) + + (def: #export await + (All [s] (-> (Actor s) (Promise (Obituary s)))) + (|>> :representation + (get@ #obituary) + product.left)) + + (def: #export (mail! mail actor) + {#.doc "Send mail to an actor.."} + (All [s] (-> (Mail s) (Actor s) (IO (Try Any)))) + (do {! io.monad} + [alive? (..alive? actor)] + (if alive? + (let [entry [mail (promise.promise [])]] + (do ! + [|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))] + (loop [[|mailbox| resolve] |mailbox|&resolve] + (do ! + [|mailbox| (promise.poll |mailbox|)] + (case |mailbox| + #.None + (do ! + [resolved? (resolve entry)] + (if resolved? + (do ! + [_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))] + (wrap (exception.return []))) + (recur |mailbox|&resolve))) + + (#.Some [_ |mailbox|']) + (recur |mailbox|')))))) + (wrap (exception.throw ..dead []))))) + + (type: #export (Message s o) + (-> s (Actor s) (Promise (Try [s o])))) + + (def: (mail message) + (All [s o] (-> (Message s o) [(Promise (Try o)) (Mail s)])) + (let [[promise resolve] (:share [s o] + (Message s o) + message + + [(Promise (Try o)) + (Resolver (Try o))] + (promise.promise []))] + [promise + (function (_ state self) + (do {! promise.monad} + [outcome (message state self)] + (case outcome + (#try.Success [state' return]) + (exec (io.run (resolve (#try.Success return))) + (promise.resolved (#try.Success state'))) + + (#try.Failure error) + (exec (io.run (resolve (#try.Failure error))) + (promise.resolved (#try.Failure error))))))])) + + (def: #export (tell! message actor) + {#.doc "Communicate with an actor through message passing."} + (All [s o] (-> (Message s o) (Actor s) (Promise (Try o)))) + (let [[promise mail] (..mail message)] + (do promise.monad + [outcome (promise.future (..mail! mail actor))] + (case outcome + (#try.Success) + promise + + (#try.Failure error) + (wrap (#try.Failure error)))))) + ) + ) + +(def: (default_on_mail mail state self) + (All [s] (-> (Mail s) s (Actor s) (Promise (Try s)))) + (mail state self)) + +(def: #export default + (All [s] (Behavior s s)) + {#on_init function.identity + #on_mail ..default_on_mail}) + +(def: #export (poison! actor) + {#.doc (doc "Kills the actor by sending mail that will kill it upon processing," + "but allows the actor to handle previous mail.")} + (All [s] (-> (Actor s) (IO (Try Any)))) + (..mail! (function (_ state self) + (promise.resolved (exception.throw ..poisoned []))) + actor)) + +(def: actor_decl^ + (Parser [Text (List Text)]) + (<>.either (.form (<>.and .local_identifier (<>.some .local_identifier))) + (<>.and .local_identifier (\ <>.monad wrap (list))))) + +(type: On_MailC + [[Text Text Text] Code]) + +(type: BehaviorC + [(Maybe On_MailC) (List Code)]) + +(def: argument + (Parser Text) + .local_identifier) + +(def: behavior^ + (Parser BehaviorC) + (let [on_mail_args ($_ <>.and ..argument ..argument ..argument)] + ($_ <>.and + (<>.maybe (.form (<>.and (.form (<>.after (.this! (' on_mail)) on_mail_args)) + .any))) + (<>.some .any)))) + +(def: (on_mail g!_ ?on_mail) + (-> Code (Maybe On_MailC) Code) + (case ?on_mail + #.None + (` (~! ..default_on_mail)) + + (#.Some [[mailN stateN selfN] bodyC]) + (` (function ((~ g!_) + (~ (code.local_identifier mailN)) + (~ (code.local_identifier stateN)) + (~ (code.local_identifier selfN))) + (~ bodyC))))) + +(with_expansions [ (as_is (actor: #export (Stack a) + (List a) + + ((on_mail mail state self) + (do (try.with promise.monad) + [#let [_ (log! "BEFORE")] + output (mail state self) + #let [_ (log! "AFTER")]] + (wrap output))) + + (message: #export (push {value a} state self (List a)) + (let [state' (#.Cons value state)] + (promise.resolved (#try.Success [state' state']))))) + + (actor: #export Counter + Nat + + (message: #export (count! {increment Nat} state self Any) + (let [state' (n.+ increment state)] + (promise.resolved (#try.Success [state' state'])))) + + (message: #export (read! state self Nat) + (promise.resolved (#try.Success [state state])))))] + (syntax: #export (actor: + {export |export|.parser} + {[name vars] actor_decl^} + {annotations (<>.default |annotations|.empty |annotations|.parser)} + state_type + {[?on_mail messages] behavior^}) + {#.doc (doc "Defines an actor, with its behavior and internal state." + "Messages for the actor must be defined after the on_mail handler." + )} + (with_gensyms [g!_] + (do meta.monad + [g!type (macro.gensym (format name "_abstract_type")) + #let [g!actor (code.local_identifier name) + g!vars (list\map code.local_identifier vars)]] + (wrap (list (` ((~! abstract:) (~+ (|export|.format export)) ((~ g!type) (~+ g!vars)) + (~ state_type) + + (def: (~+ (|export|.format export)) (~ g!actor) + (All [(~+ g!vars)] + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) + + (~+ messages)))))))) + + (syntax: #export (actor {[state_type init] (.record (<>.and .any .any))} + {[?on_mail messages] behavior^}) + (with_gensyms [g!_] + (wrap (list (` (: ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (: (..Behavior (~ state_type) (~ state_type)) + {#..on_init (|>>) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) + (: (~ state_type) + (~ init))))))))) + + (type: Signature + {#vars (List Text) + #name Text + #inputs (List |input|.Input) + #state Text + #self Text + #output Code}) + + (def: signature^ + (Parser Signature) + (.form ($_ <>.and + (<>.default (list) (.tuple (<>.some .local_identifier))) + .local_identifier + (<>.some |input|.parser) + .local_identifier + .local_identifier + .any))) + + (def: reference^ + (Parser [Name (List Text)]) + (<>.either (.form (<>.and .identifier (<>.some .local_identifier))) + (<>.and .identifier (\ <>.monad wrap (list))))) + + (syntax: #export (message: + {export |export|.parser} + {signature signature^} + {annotations (<>.default |annotations|.empty |annotations|.parser)} + body) + {#.doc (doc "A message can access the actor's state through the state parameter." + "A message can also access the actor itself through the self parameter." + "A message's output must be a promise containing a 2-tuple with the updated state and a return value." + "A message may succeed or fail (in case of failure, the actor dies)." + + )} + (with_gensyms [g!_ g!return] + (do meta.monad + [actor_scope abstract.current + #let [g!type (code.local_identifier (get@ #abstract.name actor_scope)) + g!message (code.local_identifier (get@ #name signature)) + g!actor_vars (get@ #abstract.type_vars actor_scope) + g!all_vars (|> signature (get@ #vars) (list\map code.local_identifier) (list\compose g!actor_vars)) + g!inputsC (|> signature (get@ #inputs) (list\map product.left)) + g!inputsT (|> signature (get@ #inputs) (list\map product.right)) + g!state (|> signature (get@ #state) code.local_identifier) + g!self (|> signature (get@ #self) code.local_identifier)]] + (wrap (list (` (def: (~+ (|export|.format export)) ((~ g!message) (~+ g!inputsC)) + (~ (|annotations|.format annotations)) + (All [(~+ g!all_vars)] + (-> (~+ g!inputsT) + (..Message (~ (get@ #abstract.abstraction actor_scope)) + (~ (get@ #output signature))))) + (function ((~ g!_) (~ g!state) (~ g!self)) + (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) + (~ g!state))] + (|> (~ body) + (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) + (~ (get@ #output signature))]))) + (:as ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) + (~ (get@ #output signature))])))))))) + )))))) + +(type: #export Stop + (IO Any)) + +(def: continue! true) +(def: stop! false) + +(def: #export (observe action channel actor) + (All [e s] (-> (-> e Stop (Mail s)) (Channel e) (Actor s) (IO Any))) + (let [signal (: (Atom Bit) + (atom.atom ..continue!)) + stop (: Stop + (atom.write ..stop! signal))] + (frp.subscribe (function (_ event) + (do {! io.monad} + [continue? (atom.read signal)] + (if continue? + (do ! + [outcome (..mail! (action event stop) actor)] + (wrap (try.to_maybe outcome))) + (wrap #.None)))) + channel))) diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux new file mode 100644 index 000000000..057bfd5b2 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -0,0 +1,103 @@ +(.module: + [library + [lux #* + ["." ffi] + ["@" target] + [abstract + [monad (#+ do)]] + [control + ["." function] + ["." io (#- run) ("#\." functor)]] + [data + ["." product] + [collection + ["." array]]] + [type + abstract]]]) + +(with_expansions [ (as_is (ffi.import: (java/util/concurrent/atomic/AtomicReference a) + ["#::." + (new [a]) + (get [] a) + (compareAndSet [a a] boolean)]))] + (for {@.old + @.jvm } + (as_is))) + +(with_expansions [ (for {@.js "js array new" + @.python "python array new" + @.lua "lua array new" + @.ruby "ruby array new" + @.php "php array new" + @.scheme "scheme array new"} + (as_is)) + (for {@.js "js array write" + @.python "python array write" + @.lua "lua array write" + @.ruby "ruby array write" + @.php "php array write" + @.scheme "scheme array write"} + (as_is)) + + (for {@.js "js array read" + @.python "python array read" + @.lua "lua array read" + @.ruby "ruby array read" + @.php "php array read" + @.scheme "scheme array read"} + (as_is))] + (abstract: #export (Atom a) + (with_expansions [ (java/util/concurrent/atomic/AtomicReference a)] + (for {@.old + @.jvm } + (array.Array a))) + + {#.doc "Atomic references that are safe to mutate concurrently."} + + (def: #export (atom value) + (All [a] (-> a (Atom a))) + (:abstraction (with_expansions [ (java/util/concurrent/atomic/AtomicReference::new value)] + (for {@.old + @.jvm } + ( 0 value ( 1)))))) + + (def: #export (read atom) + (All [a] (-> (Atom a) (IO a))) + (io (with_expansions [ (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] + (for {@.old + @.jvm } + ( 0 (:representation atom)))))) + + (def: #export (compare_and_swap current new atom) + {#.doc (doc "Only mutates an atom if you can present its current value." + "That guarantees that atom was not updated since you last read from it.")} + (All [a] (-> a a (Atom a) (IO Bit))) + (io (with_expansions [ (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))] + (for {@.old + @.jvm } + (let [old ( 0 (:representation atom))] + (if (is? old current) + (exec ( 0 new (:representation atom)) + true) + false)))))) + )) + +(def: #export (update f atom) + {#.doc (doc "Updates an atom by applying a function to its current value." + "If it fails to update it (because some other process wrote to it first), it will retry until it succeeds." + "The retries will be done with the new values of the atom, as they show up.")} + (All [a] (-> (-> a a) (Atom a) (IO [a a]))) + (loop [_ []] + (do io.monad + [old (read atom) + #let [new (f old)] + swapped? (..compare_and_swap old new atom)] + (if swapped? + (wrap [old new]) + (recur []))))) + +(def: #export (write value atom) + (All [a] (-> a (Atom a) (IO a))) + (|> atom + (..update (function.constant value)) + (io\map product.left))) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux new file mode 100644 index 000000000..416b8c7c4 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -0,0 +1,296 @@ +(.module: + [library + [lux #* + [abstract + [predicate (#+ Predicate)] + [equivalence (#+ Equivalence)] + [functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)]] + [data + ["." maybe ("#\." functor)]] + [type (#+ :share) + abstract]]] + [// + ["." atom (#+ Atom)] + ["." promise (#+ Promise) ("#\." functor)]]) + +(type: #export (Channel a) + {#.doc "An asynchronous channel to distribute values."} + (Promise (Maybe [a (Channel a)]))) + +(exception: #export channel_is_already_closed) + +(interface: #export (Sink a) + (: (IO (Try Any)) + close) + (: (-> a (IO (Try Any))) + feed)) + +(def: (sink resolve) + (All [a] + (-> (promise.Resolver (Maybe [a (Channel a)])) + (Sink a))) + (let [sink (atom.atom resolve)] + (implementation + (def: close + (loop [_ []] + (do {! io.monad} + [current (atom.read sink) + stopped? (current #.None)] + (if stopped? + ## I closed the sink. + (wrap (exception.return [])) + ## Someone else interacted with the sink. + (do ! + [latter (atom.read sink)] + (if (is? current latter) + ## Someone else closed the sink. + (wrap (exception.throw ..channel_is_already_closed [])) + ## Someone else fed the sink while I was closing it. + (recur []))))))) + + (def: (feed value) + (loop [_ []] + (do {! io.monad} + [current (atom.read sink) + #let [[next resolve_next] (:share [a] + (promise.Resolver (Maybe [a (Channel a)])) + current + + [(Promise (Maybe [a (Channel a)])) + (promise.Resolver (Maybe [a (Channel a)]))] + (promise.promise []))] + fed? (current (#.Some [value next]))] + (if fed? + ## I fed the sink. + (do ! + [_ (atom.compare_and_swap current resolve_next sink)] + (wrap (exception.return []))) + ## Someone else interacted with the sink. + (do ! + [latter (atom.read sink)] + (if (is? current latter) + ## Someone else closed the sink while I was feeding it. + (wrap (exception.throw ..channel_is_already_closed [])) + ## Someone else fed the sink. + (recur [])))))))))) + +(def: #export (channel _) + (All [a] (-> Any [(Channel a) (Sink a)])) + (let [[promise resolve] (promise.promise [])] + [promise (..sink resolve)])) + +(implementation: #export functor + (Functor Channel) + + (def: (map f) + (promise\map + (maybe\map + (function (_ [head tail]) + [(f head) (map f tail)]))))) + +(implementation: #export apply + (Apply Channel) + + (def: &functor ..functor) + + (def: (apply ff fa) + (do promise.monad + [cons_f ff + cons_a fa] + (case [cons_f cons_a] + [(#.Some [head_f tail_f]) (#.Some [head_a tail_a])] + (wrap (#.Some [(head_f head_a) (apply tail_f tail_a)])) + + _ + (wrap #.None))))) + +(def: empty + Channel + (promise.resolved #.None)) + +(implementation: #export monad + (Monad Channel) + + (def: &functor ..functor) + + (def: (wrap a) + (promise.resolved (#.Some [a ..empty]))) + + (def: (join mma) + (let [[output sink] (channel [])] + (exec (: (Promise Any) + (loop [mma mma] + (do {! promise.monad} + [?mma mma] + (case ?mma + (#.Some [ma mma']) + (do ! + [_ (loop [ma ma] + (do ! + [?ma ma] + (case ?ma + (#.Some [a ma']) + (exec (io.run (\ sink feed a)) + (recur ma')) + + #.None + (wrap []))))] + (recur mma')) + + #.None + (wrap (: Any (io.run (\ sink close)))))))) + output)))) + +(type: #export (Subscriber a) + (-> a (IO (Maybe Any)))) + +(def: #export (subscribe subscriber channel) + (All [a] (-> (Subscriber a) (Channel a) (IO Any))) + (io (exec (: (Promise Any) + (loop [channel channel] + (do promise.monad + [cons channel] + (case cons + (#.Some [head tail]) + (case (io.run (subscriber head)) + (#.Some _) + (recur tail) + + #.None + (wrap [])) + + #.None + (wrap []))))) + []))) + +(def: #export (filter pass? channel) + (All [a] (-> (Predicate a) (Channel a) (Channel a))) + (do promise.monad + [cons channel] + (case cons + (#.Some [head tail]) + (let [tail' (filter pass? tail)] + (if (pass? head) + (wrap (#.Some [head tail'])) + tail')) + + #.None + (wrap #.None)))) + +(def: #export (from_promise promise) + (All [a] (-> (Promise a) (Channel a))) + (promise\map (function (_ value) + (#.Some [value ..empty])) + promise)) + +(def: #export (fold f init channel) + {#.doc "Asynchronous fold over channels."} + (All [a b] + (-> (-> b a (Promise a)) a (Channel b) + (Promise a))) + (do {! promise.monad} + [cons channel] + (case cons + #.None + (wrap init) + + (#.Some [head tail]) + (do ! + [init' (f head init)] + (fold f init' tail))))) + +(def: #export (folds f init channel) + {#.doc "A channel of folds."} + (All [a b] + (-> (-> b a (Promise a)) a (Channel b) + (Channel a))) + (do {! promise.monad} + [cons channel] + (case cons + #.None + (wrap (#.Some [init (wrap #.None)])) + + (#.Some [head tail]) + (do ! + [init' (f head init)] + (wrap (#.Some [init (folds f init' tail)])))))) + +(def: #export (poll milli_seconds action) + (All [a] + (-> Nat (IO a) [(Channel a) (Sink a)])) + (let [[output sink] (channel [])] + (exec (io.run (loop [_ []] + (do io.monad + [value action + _ (\ sink feed value)] + (promise.await recur (promise.wait milli_seconds))))) + [output sink]))) + +(def: #export (periodic milli_seconds) + (-> Nat [(Channel Any) (Sink Any)]) + (..poll milli_seconds (io []))) + +(def: #export (iterate f init) + (All [s o] (-> (-> s (Promise (Maybe [s o]))) s (Channel o))) + (do promise.monad + [?next (f init)] + (case ?next + (#.Some [state output]) + (wrap (#.Some [output (iterate f state)])) + + #.None + (wrap #.None)))) + +(def: (distinct' equivalence previous channel) + (All [a] (-> (Equivalence a) a (Channel a) (Channel a))) + (do promise.monad + [cons channel] + (case cons + (#.Some [head tail]) + (if (\ equivalence = previous head) + (distinct' equivalence previous tail) + (wrap (#.Some [head (distinct' equivalence head tail)]))) + + #.None + (wrap #.None)))) + +(def: #export (distinct equivalence channel) + (All [a] (-> (Equivalence a) (Channel a) (Channel a))) + (do promise.monad + [cons channel] + (case cons + (#.Some [head tail]) + (wrap (#.Some [head (distinct' equivalence head tail)])) + + #.None + (wrap #.None)))) + +(def: #export (consume channel) + {#.doc "Reads the entirety of a channel's content and returns it as a list."} + (All [a] (-> (Channel a) (Promise (List a)))) + (do {! promise.monad} + [cons channel] + (case cons + (#.Some [head tail]) + (\ ! map (|>> (#.Cons head)) + (consume tail)) + + #.None + (wrap #.Nil)))) + +(def: #export (sequential milli_seconds values) + (All [a] (-> Nat (List a) (Channel a))) + (case values + #.Nil + ..empty + + (#.Cons head tail) + (promise.resolved (#.Some [head (do promise.monad + [_ (promise.wait milli_seconds)] + (sequential milli_seconds tail))])))) diff --git a/stdlib/source/library/lux/control/concurrency/promise.lux b/stdlib/source/library/lux/control/concurrency/promise.lux new file mode 100644 index 000000000..ad94bbff8 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/promise.lux @@ -0,0 +1,200 @@ +(.module: + [library + [lux (#- and or) + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]] + [control + [pipe (#+ case>)] + ["." function] + ["." io (#+ IO io)]] + [data + ["." product]] + [type (#+ :share) + abstract]]] + [// + ["." thread] + ["." atom (#+ Atom atom)]]) + +(abstract: #export (Promise a) + (Atom [(Maybe a) (List (-> a (IO Any)))]) + + {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} + + (type: #export (Resolver a) + (-> a (IO Bit))) + + (def: (resolver promise) + {#.doc "Sets an promise's value if it has not been done yet."} + (All [a] (-> (Promise a) (Resolver a))) + (function (resolve value) + (let [promise (:representation promise)] + (do {! io.monad} + [(^@ old [_value _observers]) (atom.read promise)] + (case _value + (#.Some _) + (wrap #0) + + #.None + (do ! + [#let [new [(#.Some value) #.None]] + succeeded? (atom.compare_and_swap old new promise)] + (if succeeded? + (do ! + [_ (monad.map ! (function (_ f) (f value)) + _observers)] + (wrap #1)) + (resolve value)))))))) + + (def: #export (resolved value) + (All [a] (-> a (Promise a))) + (:abstraction (atom [(#.Some value) (list)]))) + + (def: #export (promise _) + (All [a] (-> Any [(Promise a) (Resolver a)])) + (let [promise (:abstraction (atom [#.None (list)]))] + [promise (..resolver promise)])) + + (def: #export poll + {#.doc "Polls a promise's value."} + (All [a] (-> (Promise a) (IO (Maybe a)))) + (|>> :representation + atom.read + (\ io.functor map product.left))) + + (def: #export (await f promise) + (All [a] (-> (-> a (IO Any)) (Promise a) (IO Any))) + (do {! io.monad} + [#let [promise (:representation promise)] + (^@ old [_value _observers]) (atom.read promise)] + (case _value + (#.Some value) + (f value) + + #.None + (let [new [_value (#.Cons f _observers)]] + (do ! + [swapped? (atom.compare_and_swap old new promise)] + (if swapped? + (wrap []) + (await f (:abstraction promise)))))))) + ) + +(def: #export resolved? + {#.doc "Checks whether a promise's value has already been resolved."} + (All [a] (-> (Promise a) (IO Bit))) + (|>> ..poll + (\ io.functor map + (|>> (case> #.None + #0 + + (#.Some _) + #1))))) + +(implementation: #export functor + (Functor Promise) + + (def: (map f fa) + (let [[fb resolve] (..promise [])] + (exec (io.run (..await (|>> f resolve) fa)) + fb)))) + +(implementation: #export apply + (Apply Promise) + + (def: &functor ..functor) + + (def: (apply ff fa) + (let [[fb resolve] (..promise [])] + (exec (io.run (..await (function (_ f) + (..await (|>> f resolve) fa)) + ff)) + fb)))) + +(implementation: #export monad + (Monad Promise) + + (def: &functor ..functor) + + (def: wrap ..resolved) + + (def: (join mma) + (let [[ma resolve] (promise [])] + (exec (io.run (..await (..await resolve) mma)) + ma)))) + +(def: #export (and left right) + {#.doc "Sequencing combinator."} + (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) + (let [[read! write!] (:share [a b] + [(Promise a) (Promise b)] + [left right] + + [(Promise [a b]) + (Resolver [a b])] + (..promise [])) + _ (io.run (..await (function (_ left) + (..await (function (_ right) + (write! [left right])) + right)) + left))] + read!)) + +(def: #export (or left right) + {#.doc "Heterogeneous alternative combinator."} + (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) + (let [[a|b resolve] (..promise [])] + (with_expansions + [ (template [ ] + [(io.run (await (|>> resolve) ))] + + [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 resolve] (..promise [])] + (`` (exec (~~ (template [] + [(io.run (await resolve ))] + + [left] + [right])) + left||right)))) + +(def: #export (schedule millis_delay computation) + {#.doc (doc "Runs an I/O computation on its own thread (after a specified delay)." + "Returns a Promise that will eventually host its result.")} + (All [a] (-> Nat (IO a) (Promise a))) + (let [[!out resolve] (..promise [])] + (exec (|> (do io.monad + [value computation] + (resolve value)) + (thread.schedule millis_delay) + io.run) + !out))) + +(def: #export future + {#.doc (doc "Runs an I/O computation on its own thread." + "Returns a Promise that will eventually host its result.")} + (All [a] (-> (IO a) (Promise a))) + (..schedule 0)) + +(def: #export (delay time_millis value) + {#.doc "Delivers a value after a certain period has passed."} + (All [a] (-> Nat a (Promise a))) + (..schedule time_millis (io value))) + +(def: #export (wait time_millis) + {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} + (-> Nat (Promise Any)) + (..delay time_millis [])) + +(def: #export (time_out time_millis promise) + {#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."} + (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) + (..or (wait time_millis) promise)) diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux new file mode 100644 index 000000000..597e96306 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -0,0 +1,174 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + [pipe (#+ if>)] + ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." queue (#+ Queue)]]] + [math + [number + ["n" nat] + ["i" int]]] + [type + abstract + ["." refinement]]]] + [// + ["." atom (#+ Atom)] + ["." promise (#+ Promise Resolver)]]) + +(type: State + {#max_positions Nat + #open_positions Int + #waiting_list (Queue (Resolver Any))}) + +(abstract: #export Semaphore + (Atom State) + + {#.doc "A tool for controlling access to resources by multiple concurrent processes."} + + (def: most_positions_possible + (.nat (\ i.interval top))) + + (def: #export (semaphore initial_open_positions) + (-> Nat Semaphore) + (let [max_positions (n.min initial_open_positions + ..most_positions_possible)] + (:abstraction (atom.atom {#max_positions max_positions + #open_positions (.int max_positions) + #waiting_list queue.empty})))) + + (def: #export (wait semaphore) + (Ex [k] (-> Semaphore (Promise Any))) + (let [semaphore (:representation semaphore) + [signal sink] (: [(Promise Any) (Resolver Any)] + (promise.promise []))] + (exec (io.run + (with_expansions [ (as_is (get@ #open_positions) (i.> -1))] + (do io.monad + [[_ state'] (atom.update (|>> (update@ #open_positions dec) + (if> [] + [] + [(update@ #waiting_list (queue.push sink))])) + semaphore)] + (with_expansions [ (sink []) + (wrap false)] + (if (|> state' ) + + ))))) + signal))) + + (exception: #export (semaphore_is_maxed_out {max_positions Nat}) + (exception.report + ["Max Positions" (%.nat max_positions)])) + + (def: #export (signal semaphore) + (Ex [k] (-> Semaphore (Promise (Try Int)))) + (let [semaphore (:representation semaphore)] + (promise.future + (do {! io.monad} + [[pre post] (atom.update (function (_ state) + (if (i.= (.int (get@ #max_positions state)) + (get@ #open_positions state)) + state + (|> state + (update@ #open_positions inc) + (update@ #waiting_list queue.pop)))) + semaphore)] + (if (is? pre post) + (wrap (exception.throw ..semaphore_is_maxed_out [(get@ #max_positions pre)])) + (do ! + [_ (case (queue.peek (get@ #waiting_list pre)) + #.None + (wrap true) + + (#.Some sink) + (sink []))] + (wrap (#try.Success (get@ #open_positions post))))))))) + ) + +(abstract: #export Mutex + Semaphore + + {#.doc "A mutual-exclusion lock that can only be acquired by one process at a time."} + + (def: #export (mutex _) + (-> Any Mutex) + (:abstraction (semaphore 1))) + + (def: acquire + (-> Mutex (Promise Any)) + (|>> :representation ..wait)) + + (def: release + (-> Mutex (Promise Any)) + (|>> :representation ..signal)) + + (def: #export (synchronize mutex procedure) + (All [a] (-> Mutex (IO (Promise a)) (Promise a))) + (do promise.monad + [_ (..acquire mutex) + output (io.run procedure) + _ (..release mutex)] + (wrap output))) + ) + +(def: #export limit + (refinement.refinement (n.> 0))) + +(type: #export Limit + (:~ (refinement.type limit))) + +(abstract: #export Barrier + {#limit Limit + #count (Atom Nat) + #start_turnstile Semaphore + #end_turnstile Semaphore} + + {#.doc "A barrier that blocks all processes from proceeding until a given number of processes are parked at the barrier."} + + (def: #export (barrier limit) + (-> Limit Barrier) + (:abstraction {#limit limit + #count (atom.atom 0) + #start_turnstile (..semaphore 0) + #end_turnstile (..semaphore 0)})) + + (def: (un_block times turnstile) + (-> Nat Semaphore (Promise Any)) + (loop [step 0] + (if (n.< times step) + (do promise.monad + [outcome (..signal turnstile)] + (recur (inc step))) + (\ promise.monad wrap [])))) + + (template [ ] + [(def: ( (^:representation barrier)) + (-> Barrier (Promise Any)) + (do promise.monad + [#let [limit (refinement.un_refine (get@ #limit barrier)) + goal + [_ count] (io.run (atom.update (get@ #count barrier))) + reached? (n.= goal count)]] + (if reached? + (..un_block (dec limit) (get@ barrier)) + (..wait (get@ barrier)))))] + + [start inc limit #start_turnstile] + [end dec 0 #end_turnstile] + ) + + (def: #export (block barrier) + (-> Barrier (Promise Any)) + (do promise.monad + [_ (..start barrier)] + (..end barrier))) + ) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux new file mode 100644 index 000000000..081d2f3d9 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -0,0 +1,274 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]] + [control + ["." io (#+ IO io)] + ["." try]] + [data + ["." product] + ["." maybe] + [collection + ["." list]]] + [type + abstract]]] + [// + ["." atom (#+ Atom atom)] + ["." promise (#+ Promise Resolver)] + ["." frp (#+ Channel Sink)]]) + +(type: (Observer a) + (-> a (IO Any))) + +(abstract: #export (Var a) + (Atom [a (List (Sink a))]) + + {#.doc "A mutable cell containing a value, and observers that will be alerted of any change to it."} + + (def: #export (var value) + {#.doc "Creates a new STM var, with a default value."} + (All [a] (-> a (Var a))) + (:abstraction (atom.atom [value (list)]))) + + (def: read! + (All [a] (-> (Var a) a)) + (|>> :representation atom.read io.run product.left)) + + (def: (un_follow sink var) + (All [a] (-> (Sink a) (Var a) (IO Any))) + (do io.monad + [_ (atom.update (function (_ [value observers]) + [value (list.filter (|>> (is? sink) not) observers)]) + (:representation var))] + (wrap []))) + + (def: (write! new_value var) + (All [a] (-> a (Var a) (IO Any))) + (do {! io.monad} + [#let [var' (:representation var)] + (^@ old [old_value observers]) (atom.read var') + succeeded? (atom.compare_and_swap old [new_value observers] var')] + (if succeeded? + (do ! + [_ (monad.map ! (function (_ sink) + (do ! + [result (\ sink feed new_value)] + (case result + (#try.Success _) + (wrap []) + + (#try.Failure _) + (un_follow sink var)))) + observers)] + (wrap [])) + (write! new_value var)))) + + (def: #export (follow target) + {#.doc "Creates a channel that will receive all changes to the value of the given var."} + (All [a] (-> (Var a) (IO [(Channel a) (Sink a)]))) + (do io.monad + [#let [[channel sink] (frp.channel [])] + _ (atom.update (function (_ [value observers]) + [value (#.Cons sink observers)]) + (:representation target))] + (wrap [channel sink]))) + ) + +(type: (Tx_Frame a) + {#var (Var a) + #original a + #current a}) + +(type: Tx + (List (Ex [a] (Tx_Frame a)))) + +(type: #export (STM a) + {#.doc "A computation which updates a transaction and produces a value."} + (-> Tx [Tx a])) + +(def: (find_var_value var tx) + (All [a] (-> (Var a) Tx (Maybe a))) + (|> tx + (list.find (function (_ [_var _original _current]) + (is? (:as (Var Any) var) + (:as (Var Any) _var)))) + (\ maybe.monad map (function (_ [_var _original _current]) + _current)) + (:assume) + )) + +(def: #export (read var) + (All [a] (-> (Var a) (STM a))) + (function (_ tx) + (case (find_var_value var tx) + (#.Some value) + [tx value] + + #.None + (let [value (..read! var)] + [(#.Cons [var value value] tx) + 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 (is? (:as (Var Any) var) + (:as (Var Any) _var)) + (#.Cons {#var (:as (Var Any) _var) + #original (:as Any _original) + #current (:as Any value)} + tx') + (#.Cons {#var _var + #original _original + #current _current} + (update_tx_value var value tx'))))) + +(def: #export (write value var) + {#.doc "Writes value to var."} + (All [a] (-> a (Var a) (STM Any))) + (function (_ tx) + (case (find_var_value var tx) + (#.Some _) + [(update_tx_value var value tx) + []] + + #.None + [(#.Cons [var (..read! var) value] tx) + []]))) + +(implementation: #export functor + (Functor STM) + + (def: (map f fa) + (function (_ tx) + (let [[tx' a] (fa tx)] + [tx' (f a)])))) + +(implementation: #export apply + (Apply STM) + + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ tx) + (let [[tx' f] (ff tx) + [tx'' a] (fa tx')] + [tx'' (f a)])))) + +(implementation: #export monad + (Monad STM) + + (def: &functor ..functor) + + (def: (wrap a) + (function (_ tx) + [tx a])) + + (def: (join mma) + (function (_ tx) + (let [[tx' ma] (mma tx)] + (ma tx'))))) + +(def: #export (update f var) + {#.doc "Will update a Var's value, and return a tuple with the old and the new values."} + (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 Bit) + (list.every? (function (_ [_var _original _current]) + (is? _original (..read! _var))) + tx)) + +(def: (commit_var! [_var _original _current]) + (-> (Ex [a] (Tx_Frame a)) (IO Any)) + (if (is? _original _current) + (io []) + (..write! _current _var))) + +(def: fresh_tx Tx (list)) + +(type: (Commit a) + [(STM a) + (Promise a) + (Resolver a)]) + +(def: pending_commits + (Atom (Rec Commits + [(Promise [(Ex [a] (Commit a)) Commits]) + (Resolver [(Ex [a] (Commit a)) Commits])])) + (atom (promise.promise []))) + +(def: commit_processor_flag + (Atom Bit) + (atom #0)) + +(def: (issue_commit commit) + (All [a] (-> (Commit a) (IO Any))) + (let [entry [commit (promise.promise [])]] + (do {! io.monad} + [|commits|&resolve (atom.read pending_commits)] + (loop [[|commits| resolve] |commits|&resolve] + (do ! + [|commits| (promise.poll |commits|)] + (case |commits| + #.None + (do io.monad + [resolved? (resolve entry)] + (if resolved? + (atom.write (product.right entry) pending_commits) + (recur |commits|&resolve))) + + (#.Some [head tail]) + (recur tail))))))) + +(def: (process_commit commit) + (All [a] (-> (Commit a) (IO Any))) + (let [[stm_proc output resolve] commit + [finished_tx value] (stm_proc fresh_tx)] + (if (can_commit? finished_tx) + (do {! io.monad} + [_ (monad.map ! commit_var! finished_tx)] + (resolve value)) + (issue_commit commit)))) + +(def: init_processor! + (IO Any) + (do {! io.monad} + [flag (atom.read commit_processor_flag)] + (if flag + (wrap []) + (do ! + [was_first? (atom.compare_and_swap flag #1 commit_processor_flag)] + (if was_first? + (do ! + [[promise resolve] (atom.read pending_commits)] + (promise.await (function (recur [head [tail _resolve]]) + (do ! + [_ (process_commit head)] + (promise.await recur tail))) + promise)) + (wrap []))) + ))) + +(def: #export (commit stm_proc) + {#.doc (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 resolver] (promise.promise [])] + (exec (io.run (do io.monad + [_ init_processor!] + (issue_commit [stm_proc output resolver]))) + output))) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux new file mode 100644 index 000000000..9c9bf6549 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -0,0 +1,170 @@ +(.module: + [library + [lux #* + ["@" target] + ["." ffi] + [abstract + ["." monad (#+ do)]] + [control + ["." try] + ["." exception (#+ exception:)] + ["." io (#+ IO io)]] + [data + ["." text] + [collection + ["." list]]] + [math + [number + ["n" nat] + ["f" frac]]] + [time + ["." instant]]]] + [// + ["." atom (#+ Atom)]]) + +(with_expansions [ (as_is (ffi.import: java/lang/Object) + + (ffi.import: java/lang/Runtime + ["#::." + (#static getRuntime [] java/lang/Runtime) + (availableProcessors [] int)]) + + (ffi.import: java/lang/Runnable) + + (ffi.import: java/util/concurrent/TimeUnit + ["#::." + (#enum MILLISECONDS)]) + + (ffi.import: java/util/concurrent/Executor + ["#::." + (execute [java/lang/Runnable] #io void)]) + + (ffi.import: (java/util/concurrent/ScheduledFuture a)) + + (ffi.import: java/util/concurrent/ScheduledThreadPoolExecutor + ["#::." + (new [int]) + (schedule [java/lang/Runnable long java/util/concurrent/TimeUnit] #io (java/util/concurrent/ScheduledFuture java/lang/Object))]))] + (for {@.old (as_is ) + @.jvm (as_is ) + + @.js + (as_is (ffi.import: (setTimeout [ffi.Function ffi.Number] #io Any))) + + @.python + (ffi.import: threading/Timer + ["#::." + (new [ffi.Float ffi.Function]) + (start [] #io #? Any)])} + + ## Default + (type: Thread + {#creation Nat + #delay Nat + #action (IO Any)}) + )) + +(def: #export parallelism + Nat + (with_expansions [ (|> (java/lang/Runtime::getRuntime) + (java/lang/Runtime::availableProcessors) + .nat)] + (for {@.old + @.jvm } + ## Default + 1))) + +(with_expansions [ (as_is (def: runner + java/util/concurrent/ScheduledThreadPoolExecutor + (java/util/concurrent/ScheduledThreadPoolExecutor::new (.int ..parallelism))))] + (for {@.old + @.jvm + @.js (as_is) + @.python (as_is)} + + ## Default + (def: runner + (Atom (List Thread)) + (atom.atom (list))))) + +(def: (execute! action) + (-> (IO Any) Any) + (case (try (io.run action)) + (#try.Failure error) + (exec + ("lux io log" ($_ "lux text concat" + "ERROR DURING THREAD EXECUTION:" text.new_line + error)) + []) + + (#try.Success _) + [])) + +(def: #export (schedule milli_seconds action) + (-> Nat (IO Any) (IO Any)) + (with_expansions [ (as_is (let [runnable (ffi.object [] [java/lang/Runnable] + [] + (java/lang/Runnable [] (run self) void + (..execute! action)))] + (case milli_seconds + 0 (java/util/concurrent/Executor::execute runnable runner) + _ (java/util/concurrent/ScheduledThreadPoolExecutor::schedule runnable (.int milli_seconds) java/util/concurrent/TimeUnit::MILLISECONDS + runner))))] + (for {@.old + @.jvm + + @.js + (..setTimeout [(ffi.closure [] (..execute! action)) + (n.frac milli_seconds)]) + + @.python + (do io.monad + [_ (|> (ffi.lambda [] (..execute! action)) + [(|> milli_seconds n.frac (f./ +1,000.0))] + threading/Timer::new + (threading/Timer::start []))] + (wrap []))} + + ## Default + (do {! io.monad} + [now (\ ! map (|>> instant.to_millis .nat) instant.now) + _ (atom.update (|>> (#.Cons {#creation now + #delay milli_seconds + #action action})) + ..runner)] + (wrap []))))) + +(for {@.old (as_is) + @.jvm (as_is) + @.js (as_is) + @.python (as_is)} + + ## Default + (as_is (exception: #export cannot_continue_running_threads) + + (def: #export run! + (IO Any) + (loop [_ []] + (do {! io.monad} + [threads (atom.read ..runner)] + (case threads + ## And... we're done! + #.Nil + (wrap []) + + _ + (do ! + [now (\ ! map (|>> instant.to_millis .nat) instant.now) + #let [[ready pending] (list.partition (function (_ thread) + (|> (get@ #creation thread) + (n.+ (get@ #delay thread)) + (n.<= now))) + threads)] + swapped? (atom.compare_and_swap threads pending ..runner)] + (if swapped? + (do ! + [_ (monad.map ! (|>> (get@ #action) ..execute! io.io) ready)] + (recur [])) + (error! (exception.construct ..cannot_continue_running_threads [])))) + )))) + )) diff --git a/stdlib/source/library/lux/control/continuation.lux b/stdlib/source/library/lux/control/continuation.lux new file mode 100644 index 000000000..8b9b5a24f --- /dev/null +++ b/stdlib/source/library/lux/control/continuation.lux @@ -0,0 +1,100 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)]] + [control + ["." function] + [parser + ["s" code]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]]]]) + +(type: #export (Cont i o) + {#.doc "Continuations."} + (-> (-> i o) o)) + +(def: #export (continue next cont) + {#.doc "Continues a continuation thunk."} + (All [i o] (-> (-> i o) (Cont i o) o)) + (cont next)) + +(def: #export (run cont) + {#.doc "Forces a continuation thunk to be evaluated."} + (All [a] (-> (Cont a a) a)) + (cont function.identity)) + +(def: #export (call/cc f) + {#.doc "Call with current continuation."} + (All [a b z] + (-> (-> (-> a (Cont b z)) + (Cont a z)) + (Cont a z))) + (function (_ k) + (f (function (_ a) (function (_ _) (k a))) + k))) + +(syntax: #export (pending expr) + {#.doc (doc "Turns any expression into a function that is pending a continuation." + (pending (some_function some_input)))} + (with_gensyms [g!_ g!k] + (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) + +(def: #export (reset scope) + (All [i o] (-> (Cont i i) (Cont i o))) + (function (_ k) + (k (run scope)))) + +(def: #export (shift f) + (All [a] + (-> (-> (-> a (Cont a a)) + (Cont a a)) + (Cont a a))) + (function (_ oc) + (f (function (_ a) (function (_ ic) (ic (oc a)))) + function.identity))) + +(implementation: #export functor + (All [o] (Functor (All [i] (Cont i o)))) + + (def: (map f fv) + (function (_ k) (fv (function.compose k f))))) + +(implementation: #export apply + (All [o] (Apply (All [i] (Cont i o)))) + + (def: &functor ..functor) + + (def: (apply ff fv) + (function (_ k) + (|> (k (f v)) + (function (_ v)) fv + (function (_ f)) ff)))) + +(implementation: #export monad + (All [o] (Monad (All [i] (Cont i o)))) + + (def: &functor ..functor) + + (def: (wrap value) + (function (_ k) (k value))) + + (def: (join ffa) + (function (_ k) + (ffa (continue k))))) + +(def: #export (portal init) + (All [i o z] + (-> i + (Cont [(-> i (Cont o z)) + i] + z))) + (call/cc (function (_ k) + (do ..monad + [#let [nexus (function (nexus val) + (k [nexus val]))] + _ (k [nexus init])] + (wrap (undefined)))))) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux new file mode 100644 index 000000000..405c858a5 --- /dev/null +++ b/stdlib/source/library/lux/control/exception.lux @@ -0,0 +1,184 @@ +(.module: {#.doc "Exception-handling functionality."} + [library + [lux #* + ["." macro] + ["." meta] + [abstract + [monad (#+ do)]] + [control + ["p" parser + ["s" code (#+ Parser)]]] + [data + ["." maybe] + ["." product] + ["." text ("#\." monoid)] + [collection + ["." list ("#\." functor fold)]]] + [macro + ["." code] + [syntax (#+ syntax:) + ["|.|" export] + ["|.|" input] + ["." type #_ + ["|#_.|" variable]]]] + [math + [number + ["n" nat ("#\." decimal)]]]]] + [// + ["//" try (#+ Try)]]) + +(type: #export (Exception a) + {#.doc "An exception provides a way to decorate error messages."} + {#label Text + #constructor (-> a Text)}) + +(def: #export (match? exception error) + (All [e] (-> (Exception e) Text Bit)) + (text.starts_with? (get@ #label exception) error)) + +(def: #export (catch exception then try) + {#.doc (doc "If a particular exception is detected on a possibly-erroneous value, handle it." + "If no exception was detected, or a different one from the one being checked, then pass along the original value.")} + (All [e a] + (-> (Exception e) (-> Text a) (Try a) + (Try a))) + (case try + (#//.Success output) + (#//.Success output) + + (#//.Failure error) + (let [reference (get@ #label exception)] + (if (text.starts_with? reference error) + (#//.Success (|> error + (text.clip' (text.size reference)) + maybe.assume + then)) + (#//.Failure error))))) + +(def: #export (otherwise to_do try) + {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."} + (All [a] + (-> (-> Text a) (Try a) a)) + (case try + (#//.Success output) + output + + (#//.Failure error) + (to_do error))) + +(def: #export (return value) + {#.doc "A way to lift normal values into the error-handling context."} + (All [a] (-> a (Try a))) + (#//.Success value)) + +(def: #export (construct exception message) + {#.doc "Constructs an exception."} + (All [e] (-> (Exception e) e Text)) + ((get@ #..constructor exception) message)) + +(def: #export (throw exception message) + {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} + (All [e a] (-> (Exception e) e (Try a))) + (#//.Failure (..construct exception message))) + +(def: #export (assert exception message test) + (All [e] (-> (Exception e) e Bit (Try Any))) + (if test + (#//.Success []) + (..throw exception message))) + +(syntax: #export (exception: {export |export|.parser} + {t_vars (p.default (list) (s.tuple (p.some |type_variable|.parser)))} + {[name inputs] (p.either (p.and s.local_identifier (wrap (list))) + (s.form (p.and s.local_identifier (p.some |input|.parser))))} + {body (p.maybe s.any)}) + {#.doc (doc "Define a new exception type." + "It mostly just serves as a way to tag error messages for later catching." + "" + "Simple case:" + (exception: #export some_exception) + "" + "Complex case:" + (exception: #export [optional type variables] (some_exception {optional Text} {arguments Int}) + optional_body))} + (macro.with_gensyms [g!descriptor] + (do meta.monad + [current_module meta.current_module_name + #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) + g!self (code.local_identifier name)]] + (wrap (list (` (def: (~+ (|export|.format export)) + (~ g!self) + (All [(~+ (list\map |type_variable|.format t_vars))] + (..Exception [(~+ (list\map (get@ #|input|.type) inputs))])) + (let [(~ g!descriptor) (~ (code.text descriptor))] + {#..label (~ g!descriptor) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))]) + ((~! text\compose) (~ g!descriptor) + (~ (maybe.default (' "") body))))}))))) + ))) + +(def: (report' entries) + (-> (List [Text Text]) Text) + (let [header_separator ": " + largest_header_size (list\fold (function (_ [header _] max) + (n.max (text.size header) max)) + 0 + entries) + on_new_line (|> " " + (list.repeat (n.+ (text.size header_separator) + largest_header_size)) + (text.join_with "") + (text\compose text.new_line))] + (|> entries + (list\map (function (_ [header message]) + (let [padding (|> " " + (list.repeat (n.- (text.size header) + largest_header_size)) + (text.join_with ""))] + (|> message + (text.replace_all text.new_line on_new_line) + ($_ text\compose padding header header_separator))))) + (text.join_with text.new_line)))) + +(syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) + (wrap (list (` ((~! report') (list (~+ (|> entries + (list\map (function (_ [header message]) + (` [(~ header) (~ message)]))))))))))) + +(def: #export (enumerate format entries) + (All [a] + (-> (-> a Text) (List a) Text)) + (|> entries + list.enumeration + (list\map (function (_ [index entry]) + [(n\encode index) (format entry)])) + report')) + +(def: separator + (let [gap ($_ "lux text concat" text.new_line text.new_line) + horizontal_line (|> "-" (list.repeat 64) (text.join_with ""))] + ($_ "lux text concat" + gap + horizontal_line + gap))) + +(def: (decorate prelude error) + (-> Text Text Text) + ($_ "lux text concat" + prelude + ..separator + error)) + +(def: #export (with exception message computation) + (All [e a] (-> (Exception e) e (Try a) (Try a))) + (case computation + (#//.Failure error) + (#//.Failure (case error + "" + (..construct exception message) + + _ + (..decorate (..construct exception message) error))) + + success + success)) diff --git a/stdlib/source/library/lux/control/function.lux b/stdlib/source/library/lux/control/function.lux new file mode 100644 index 000000000..2f880a872 --- /dev/null +++ b/stdlib/source/library/lux/control/function.lux @@ -0,0 +1,47 @@ +(.module: + [library + [lux #* + [abstract + [monoid (#+ Monoid)]]]]) + +(def: #export identity + {#.doc (doc "Identity function." + "Does nothing to its argument and just returns it." + (is? (identity value) + value))} + (All [a] (-> a a)) + (|>>)) + +(def: #export (compose f g) + {#.doc (doc "Function composition." + (= ((compose f g) "foo") + (f (g "foo"))))} + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (|>> g f)) + +(def: #export (constant value) + {#.doc (doc "Create constant functions." + (= ((constant "foo") "bar") + "foo"))} + (All [o] (-> o (All [i] (-> i o)))) + (function (_ _) value)) + +(def: #export (flip f) + {#.doc (doc "Flips the order of the arguments of a function." + (= ((flip f) "foo" "bar") + (f "bar" "foo")))} + (All [a b c] + (-> (-> a b c) (-> b a c))) + (function (_ x y) (f y x))) + +(def: #export (apply input function) + (All [i o] + (-> i (-> i o) o)) + (function input)) + +(implementation: #export monoid + (All [a] (Monoid (-> a a))) + + (def: identity ..identity) + (def: compose ..compose)) diff --git a/stdlib/source/library/lux/control/function/contract.lux b/stdlib/source/library/lux/control/function/contract.lux new file mode 100644 index 000000000..149053230 --- /dev/null +++ b/stdlib/source/library/lux/control/function/contract.lux @@ -0,0 +1,52 @@ +(.module: + [library + [lux #* + [control + ["." exception (#+ exception:)]] + [data + [text + ["%" format (#+ format)]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + [math + [number + ["i" int]]]]]) + +(template [] + [(exception: ( {condition Code}) + (exception.report + ["Condition" (%.code condition)]))] + + [pre_condition_failed] + [post_condition_failed] + ) + +(def: (assert! message test) + (-> Text Bit []) + (if test + [] + (error! message))) + +(syntax: #export (pre test expr) + {#.doc (doc "Pre-conditions." + "Given a test and an expression to run, only runs the expression if the test passes." + "Otherwise, an error is raised." + (pre (i.= +4 (i.+ +2 +2)) + (foo +123 +456 +789)))} + (wrap (list (` (exec ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) + (~ test)) + (~ expr)))))) + +(syntax: #export (post test expr) + {#.doc (doc "Post-conditions." + "Given a predicate and an expression to run, evaluates the expression and then tests the output with the predicate." + "If the predicate returns #1, returns the value of the expression." + "Otherwise, an error is raised." + (post i.even? + (i.+ +2 +2)))} + (with_gensyms [g!output] + (wrap (list (` (let [(~ g!output) (~ expr)] + (exec ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) + ((~ test) (~ g!output))) + (~ g!output)))))))) diff --git a/stdlib/source/library/lux/control/function/memo.lux b/stdlib/source/library/lux/control/function/memo.lux new file mode 100644 index 000000000..5ab6c2b3b --- /dev/null +++ b/stdlib/source/library/lux/control/function/memo.lux @@ -0,0 +1,64 @@ +## Inspired by; +## "The Different Aspects of Monads and Mixins" by Bruno C. d. S. Oliveira + +(.module: + [library + [lux #* + [abstract + [hash (#+ Hash)] + [monad (#+ do)]] + [control + ["." state (#+ State)]] + [data + ["." product] + [collection + ["." dictionary (#+ Dictionary)]]]]] + ["." // #_ + ["#" mixin (#+ Mixin Recursive)]]) + +(def: #export memoization + (All [i o] + (Mixin i (State (Dictionary i o) o))) + (function (_ delegate recur) + (function (_ input) + (do {! state.monad} + [memory state.get] + (case (dictionary.get input memory) + (#.Some output) + (wrap output) + + #.None + (do ! + [output (delegate input) + _ (state.update (dictionary.put input output))] + (wrap output))))))) + +(type: #export (Memo i o) + (Recursive i (State (Dictionary i o) o))) + +(def: #export (open memo) + {#.doc (doc "Memoization where the memoized results can be re-used accross invocations.")} + (All [i o] + (:let [Memory (Dictionary i o)] + (-> (Memo i o) (-> [Memory i] [Memory o])))) + (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo)))] + (function (_ [memory input]) + (|> input memo (state.run memory))))) + +(def: #export (closed hash memo) + {#.doc (doc "Memoization confined to a single invocation to the function (not counting any subsequent recursive invocations)." + "Memoized results will be re-used during recursive invocations, but cannot be accessed after the main invocation has ended.")} + (All [i o] + (-> (Hash i) (Memo i o) (-> i o))) + (let [memo (//.mixin (//.inherit ..memoization (//.from-recursive memo))) + empty (dictionary.new hash)] + (|>> memo (state.run empty) product.right))) + +(def: #export (none hash memo) + {#.doc (doc "No memoization at all." + "This is useful as a test control when measuring the effect of using memoization.")} + (All [i o] + (-> (Hash i) (Memo i o) (-> i o))) + (let [memo (//.mixin (//.from-recursive memo)) + empty (dictionary.new hash)] + (|>> memo (state.run empty) product.right))) diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux new file mode 100644 index 000000000..f70b2f9c3 --- /dev/null +++ b/stdlib/source/library/lux/control/function/mixin.lux @@ -0,0 +1,64 @@ +## Inspired by; +## "The Different Aspects of Monads and Mixins" by Bruno C. d. S. Oliveira + +(.module: + [library + [lux #* + [abstract + [monoid (#+ Monoid)] + [predicate (#+ Predicate)] + [monad (#+ Monad do)]]]]) + +(type: #export (Mixin i o) + (-> (-> i o) (-> i o) (-> i o))) + +(def: #export (mixin f) + (All [i o] (-> (Mixin i o) (-> i o))) + (function (mix input) + ((f mix mix) input))) + +(def: #export nothing + Mixin + (function (_ delegate recur) + delegate)) + +(def: #export (inherit parent child) + (All [i o] (-> (Mixin i o) (Mixin i o) (Mixin i o))) + (function (_ delegate recur) + (parent (child delegate recur) recur))) + +(implementation: #export monoid + (All [i o] (Monoid (Mixin i o))) + + (def: identity ..nothing) + (def: compose ..inherit)) + +(def: #export (advice when then) + (All [i o] (-> (Predicate i) (Mixin i o) (Mixin i o))) + (function (_ delegate recur input) + (if (when input) + ((then delegate recur) input) + (delegate input)))) + +(def: #export (before monad action) + (All [! i o] (-> (Monad !) (-> i (! Any)) (Mixin i (! o)))) + (function (_ delegate recur input) + (do monad + [_ (action input)] + (delegate input)))) + +(def: #export (after monad action) + (All [! i o] (-> (Monad !) (-> i o (! Any)) (Mixin i (! o)))) + (function (_ delegate recur input) + (do monad + [output (delegate input) + _ (action input output)] + (wrap output)))) + +(type: #export (Recursive i o) + (-> (-> i o) (-> i o))) + +(def: #export (from-recursive recursive) + (All [i o] (-> (Recursive i o) (Mixin i o))) + (function (_ delegate recur) + (recursive recur))) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux new file mode 100644 index 000000000..dcc4791e1 --- /dev/null +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -0,0 +1,158 @@ +(.module: + [library + [lux (#- Definition let def:) + ["." meta] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["<>" parser ("#\." monad) + ["<.>" code (#+ Parser)]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)] + [dictionary + ["." plist (#+ PList)]]]] + ["." macro + ["." local] + ["." code] + [syntax (#+ syntax:) + ["." export] + ["." declaration (#+ Declaration)]]]]] + ["." //]) + +(type: Mutual + {#declaration Declaration + #type Code + #body Code}) + +(.def: mutual + (Parser [Declaration Code Code]) + ($_ <>.and + declaration.parser + .any + .any + )) + +(.def: (mutual_definition context g!context [g!name mutual]) + (-> (List Code) Code [Code Mutual] Code) + (` (function ((~ g!name) (~ g!context)) + (.let [[(~+ context)] (~ g!context)] + (function (~ (declaration.format (get@ #declaration mutual))) + (~ (get@ #body mutual))))))) + +(.def: (macro g!context g!self) + (-> Code Code Macro) + (<| (:as Macro) + (: Macro') + (function (_ parameters) + (\ meta.monad wrap (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) + +(syntax: #export (let {functions (.tuple (<>.some ..mutual))} + body) + (case functions + #.Nil + (wrap (list body)) + + (#.Cons mutual #.Nil) + (.let [g!name (|> mutual (get@ [#declaration #declaration.name]) code.local_identifier)] + (wrap (list (` (.let [(~ g!name) (: (~ (get@ #type mutual)) + (function (~ (declaration.format (get@ #declaration mutual))) + (~ (get@ #body mutual))))] + (~ body)))))) + + _ + (macro.with_gensyms [g!context g!output] + (do {! meta.monad} + [here_name meta.current_module_name + hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) + functions) + #let [definitions (list\map (..mutual_definition hidden_names g!context) + (list.zip/2 hidden_names + functions)) + context_types (list\map (function (_ mutual) + (` (-> (~ g!context) (~ (get@ #type mutual))))) + functions) + user_names (list\map (|>> (get@ [#declaration #declaration.name]) code.local_identifier) + functions)] + g!pop (local.push (list\map (function (_ [g!name mutual]) + [[here_name (get@ [#declaration #declaration.name] mutual)] + (..macro g!context g!name)]) + (list.zip/2 hidden_names + functions)))] + (wrap (list (` (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]) + (~ g!output) (~ body)] + (exec (~ g!pop) + (~ g!output)))))))))) + +(type: Definition + {#exported? Bit + #mutual Mutual}) + +(.def: definition + (Parser Definition) + (.tuple (<>.and export.parser + ..mutual))) + +(syntax: #export (def: {functions (<>.many ..definition)}) + (case functions + #.Nil + (wrap (list)) + + (#.Cons definition #.Nil) + (.let [(^slots [#exported? #mutual]) definition + (^slots [#declaration #type #body]) mutual] + (wrap (list (` (.def: + (~+ (export.format exported?)) + (~ (declaration.format declaration)) + (~ type) + (~ body)))))) + + _ + (macro.with_gensyms [g!context g!output] + (do {! meta.monad} + [here_name meta.current_module_name + hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) + functions) + #let [definitions (list\map (..mutual_definition hidden_names g!context) + (list.zip/2 hidden_names + (list\map (get@ #mutual) functions))) + context_types (list\map (function (_ mutual) + (` (-> (~ g!context) (~ (get@ [#mutual #type] mutual))))) + functions) + user_names (list\map (|>> (get@ [#mutual #declaration #declaration.name]) code.local_identifier) + functions)] + g!pop (local.push (list\map (function (_ [g!name mutual]) + [[here_name (get@ [#mutual #declaration #declaration.name] mutual)] + (..macro g!context g!name)]) + (list.zip/2 hidden_names + functions)))] + (wrap (list& (` (.def: (~ g!context) + [(~+ (list\map (get@ [#mutual #type]) functions))] + (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]))) + g!pop + (list\map (function (_ mutual) + (.let [g!name (|> mutual (get@ [#mutual #declaration #declaration.name]) code.local_identifier)] + (` (.def: + (~+ (export.format (get@ #exported? mutual))) + (~ g!name) + (~ (get@ [#mutual #type] mutual)) + (.let [[(~+ user_names)] (~ g!context)] + (~ g!name)))))) + functions))))))) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux new file mode 100644 index 000000000..a4773cd0d --- /dev/null +++ b/stdlib/source/library/lux/control/io.lux @@ -0,0 +1,72 @@ +(.module: {#.doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)]] + [control + [parser + ["s" code]]] + [type + abstract] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." template]]]]) + +(abstract: #export (IO a) + (-> Any a) + + {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."} + + (def: label + (All [a] (-> (-> Any a) (IO a))) + (|>> :abstraction)) + + (template: (!io computation) + (:abstraction (template.with_locals [g!func g!arg] + (function (g!func g!arg) + computation)))) + + (template: (!run io) + ## creatio ex nihilo + ((:representation io) [])) + + (syntax: #export (io computation) + {#.doc (doc "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." + "Great for wrapping effectful computations (which will not be performed until the IO is 'run')." + (io (exec + (log! msg) + "Some value...")))} + (with_gensyms [g!func g!arg] + (wrap (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) + (~ computation)))))))) + + (def: #export run + {#.doc "A way to execute IO computations and perform their side-effects."} + (All [a] (-> (IO a) a)) + (|>> !run)) + + (implementation: #export functor + (Functor IO) + + (def: (map f) + (|>> !run f !io))) + + (implementation: #export apply + (Apply IO) + + (def: &functor ..functor) + + (def: (apply ff fa) + (!io ((!run ff) (!run fa))))) + + (implementation: #export monad + (Monad IO) + + (def: &functor ..functor) + + (def: wrap (|>> !io)) + + (def: join (|>> !run !run !io))) + ) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux new file mode 100644 index 000000000..fad957e27 --- /dev/null +++ b/stdlib/source/library/lux/control/parser.lux @@ -0,0 +1,324 @@ +(.module: + [library + [lux (#- or and not) + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + [codec (#+ Codec)]] + [control + ["." try (#+ Try)]] + [data + ["." product] + [collection + ["." list ("#\." functor monoid)]]] + [math + [number + ["n" nat]]]]]) + +(type: #export (Parser s a) + {#.doc "A generic parser."} + (-> s (Try [s a]))) + +(implementation: #export functor + (All [s] (Functor (Parser s))) + + (def: (map f ma) + (function (_ input) + (case (ma input) + (#try.Failure msg) + (#try.Failure msg) + + (#try.Success [input' a]) + (#try.Success [input' (f a)]))))) + +(implementation: #export apply + (All [s] (Apply (Parser s))) + + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ input) + (case (ff input) + (#try.Success [input' f]) + (case (fa input') + (#try.Success [input'' a]) + (#try.Success [input'' (f a)]) + + (#try.Failure msg) + (#try.Failure msg)) + + (#try.Failure msg) + (#try.Failure msg))))) + +(implementation: #export monad + (All [s] (Monad (Parser s))) + + (def: &functor ..functor) + + (def: (wrap x) + (function (_ input) + (#try.Success [input x]))) + + (def: (join mma) + (function (_ input) + (case (mma input) + (#try.Failure msg) + (#try.Failure msg) + + (#try.Success [input' ma]) + (ma input'))))) + +(def: #export (assert message test) + {#.doc "Fails with the given message if the test is #0."} + (All [s] (-> Text Bit (Parser s Any))) + (function (_ input) + (if test + (#try.Success [input []]) + (#try.Failure message)))) + +(def: #export (maybe parser) + {#.doc "Optionality combinator."} + (All [s a] + (-> (Parser s a) (Parser s (Maybe a)))) + (function (_ input) + (case (parser input) + (#try.Failure _) + (#try.Success [input #.None]) + + (#try.Success [input' x]) + (#try.Success [input' (#.Some x)])))) + +(def: #export (run parser input) + (All [s a] + (-> (Parser s a) s (Try [s a]))) + (parser input)) + +(def: #export (and first second) + {#.doc "Sequencing combinator."} + (All [s a b] + (-> (Parser s a) (Parser s b) (Parser s [a b]))) + (do {! ..monad} + [head first] + (\ ! map (|>> [head]) second))) + +(def: #export (or left right) + {#.doc "Heterogeneous alternative combinator."} + (All [s a b] + (-> (Parser s a) (Parser s b) (Parser s (| a b)))) + (function (_ tokens) + (case (left tokens) + (#try.Success [tokens' output]) + (#try.Success [tokens' (0 #0 output)]) + + (#try.Failure _) + (case (right tokens) + (#try.Success [tokens' output]) + (#try.Success [tokens' (0 #1 output)]) + + (#try.Failure error) + (#try.Failure error))))) + +(def: #export (either this that) + {#.doc "Homogeneous alternative combinator."} + (All [s a] + (-> (Parser s a) (Parser s a) (Parser s a))) + (function (_ tokens) + (case (this tokens) + (#try.Failure _) + (that tokens) + + output + output))) + +(def: #export (some parser) + {#.doc "0-or-more combinator."} + (All [s a] + (-> (Parser s a) (Parser s (List a)))) + (function (_ input) + (case (parser input) + (#try.Failure _) + (#try.Success [input (list)]) + + (#try.Success [input' head]) + (..run (\ ..monad map (|>> (list& head)) + (some parser)) + input')))) + +(def: #export (many parser) + {#.doc "1-or-more combinator."} + (All [s a] + (-> (Parser s a) (Parser s (List a)))) + (|> (..some parser) + (..and parser) + (\ ..monad map (|>> #.Cons)))) + +(def: #export (exactly amount parser) + {#.doc "Parse exactly N times."} + (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) + (case amount + 0 (\ ..monad wrap (list)) + _ (do {! ..monad} + [x parser] + (|> parser + (exactly (dec amount)) + (\ ! map (|>> (#.Cons x))))))) + +(def: #export (at_least amount parser) + {#.doc "Parse at least N times."} + (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) + (do {! ..monad} + [minimum (..exactly amount parser)] + (\ ! map (list\compose minimum) (..some parser)))) + +(def: #export (at_most amount parser) + {#.doc "Parse at most N times."} + (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) + (case amount + 0 (\ ..monad wrap (list)) + _ (function (_ input) + (case (parser input) + (#try.Failure msg) + (#try.Success [input (list)]) + + (#try.Success [input' x]) + (..run (\ ..monad map (|>> (#.Cons x)) + (at_most (dec amount) parser)) + input'))))) + +(def: #export (between from to parser) + {#.doc "Parse between N and M times."} + (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) + (do {! ..monad} + [minimum (..exactly from parser)] + (if (n.< to from) + (\ ! map (list\compose minimum) + (..at_most (n.- from to) parser)) + (wrap minimum)))) + +(def: #export (separated_by separator parser) + {#.doc "Parsers instances of 'parser' that are separated by instances of 'separator'."} + (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) + (do {! ..monad} + [?x (..maybe parser)] + (case ?x + #.None + (wrap #.Nil) + + (#.Some x) + (|> parser + (..and separator) + ..some + (\ ! map (|>> (list\map product.right) (#.Cons x))))))) + +(def: #export (not parser) + (All [s a] (-> (Parser s a) (Parser s Any))) + (function (_ input) + (case (parser input) + (#try.Failure msg) + (#try.Success [input []]) + + _ + (#try.Failure "Expected to fail; yet succeeded.")))) + +(def: #export (fail message) + (All [s a] (-> Text (Parser s a))) + (function (_ input) + (#try.Failure message))) + +(def: #export (lift operation) + (All [s a] (-> (Try a) (Parser s a))) + (function (_ input) + (case operation + (#try.Success output) + (#try.Success [input output]) + + (#try.Failure error) + (#try.Failure error)))) + +(def: #export (default value parser) + {#.doc "If the given parser fails, returns the default value."} + (All [s a] (-> a (Parser s a) (Parser s a))) + (function (_ input) + (case (parser input) + (#try.Failure error) + (#try.Success [input value]) + + (#try.Success [input' output]) + (#try.Success [input' output])))) + +(def: #export remaining + (All [s] (Parser s s)) + (function (_ inputs) + (#try.Success [inputs inputs]))) + +(def: #export (rec parser) + {#.doc "Combinator for recursive parser."} + (All [s a] (-> (-> (Parser s a) (Parser s a)) (Parser s a))) + (function (_ inputs) + (..run (parser (rec parser)) inputs))) + +(def: #export (after param subject) + (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) + (do ..monad + [_ param] + subject)) + +(def: #export (before param subject) + (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) + (do ..monad + [output subject + _ param] + (wrap output))) + +(def: #export (filter test parser) + (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) + (do ..monad + [output parser + _ (..assert "Constraint failed." (test output))] + (wrap output))) + +(def: #export (parses? parser) + (All [s a] (-> (Parser s a) (Parser s Bit))) + (function (_ input) + (case (parser input) + (#try.Failure error) + (#try.Success [input false]) + + (#try.Success [input' _]) + (#try.Success [input' true])))) + +(def: #export (parses parser) + (All [s a] (-> (Parser s a) (Parser s Any))) + (function (_ input) + (case (parser input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [input' _]) + (#try.Success [input' []])))) + +(def: #export (speculative parser) + (All [s a] (-> (Parser s a) (Parser s a))) + (function (_ input) + (case (parser input) + (#try.Success [input' output]) + (#try.Success [input output]) + + output + output))) + +(def: #export (codec codec parser) + (All [s a z] (-> (Codec a z) (Parser s a) (Parser s z))) + (function (_ input) + (case (parser input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [input' to_decode]) + (case (\ codec decode to_decode) + (#try.Failure error) + (#try.Failure error) + + (#try.Success value) + (#try.Success [input' value]))))) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux new file mode 100644 index 000000000..cdfb18504 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -0,0 +1,135 @@ +(.module: + [library + [lux (#- nat int rev) + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." bit] + ["." name] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]]] + [math + [number + ["." i64] + ["." nat] + ["." int] + ["." rev] + ["." frac]]] + [tool + [compiler + [arity (#+ Arity)] + [reference (#+) + [variable (#+)]] + [language + [lux + ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]]]] + ["." //]) + +(def: (remaining_inputs asts) + (-> (List Analysis) Text) + (format text.new_line "Remaining input: " + (|> asts + (list\map /.%analysis) + (list.interpose " ") + (text.join_with "")))) + +(exception: #export (cannot_parse {input (List Analysis)}) + (exception.report + ["Input" (exception.enumerate /.%analysis input)])) + +(exception: #export (unconsumed_input {input (List Analysis)}) + (exception.report + ["Input" (exception.enumerate /.%analysis input)])) + +(type: #export Parser + (//.Parser (List Analysis))) + +(def: #export (run parser input) + (All [a] (-> (Parser a) (List Analysis) (Try a))) + (case (parser input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [#.Nil value]) + (#try.Success value) + + (#try.Success [unconsumed _]) + (exception.throw ..unconsumed_input unconsumed))) + +(def: #export any + (Parser Analysis) + (function (_ input) + (case input + #.Nil + (exception.throw ..cannot_parse input) + + (#.Cons [head tail]) + (#try.Success [tail head])))) + +(def: #export end! + {#.doc "Ensures there are no more inputs."} + (Parser Any) + (function (_ tokens) + (case tokens + #.Nil (#try.Success [tokens []]) + _ (#try.Failure (format "Expected list of tokens to be empty!" + (remaining_inputs tokens)))))) + +(def: #export end? + {#.doc "Checks whether there are no more inputs."} + (Parser Bit) + (function (_ tokens) + (#try.Success [tokens (case tokens + #.Nil true + _ false)]))) + +(template [ ] + [(def: #export + (Parser ) + (function (_ input) + (case input + (^ (list& ( x) input')) + (#try.Success [input' x]) + + _ + (exception.throw ..cannot_parse input)))) + + (def: #export ( expected) + (-> (Parser Any)) + (function (_ input) + (case input + (^ (list& ( actual) input')) + (if (\ = expected actual) + (#try.Success [input' []]) + (exception.throw ..cannot_parse input)) + + _ + (exception.throw ..cannot_parse input))))] + + [bit bit! /.bit Bit bit.equivalence] + [nat nat! /.nat Nat nat.equivalence] + [int int! /.int Int int.equivalence] + [rev rev! /.rev Rev rev.equivalence] + [frac frac! /.frac Frac frac.equivalence] + [text text! /.text Text text.equivalence] + [local local! /.variable/local Nat nat.equivalence] + [foreign foreign! /.variable/foreign Nat nat.equivalence] + [constant constant! /.constant Name name.equivalence] + ) + +(def: #export (tuple parser) + (All [a] (-> (Parser a) (Parser a))) + (function (_ input) + (case input + (^ (list& (/.tuple head) tail)) + (do try.monad + [output (..run parser head)] + (#try.Success [tail output])) + + _ + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux new file mode 100644 index 000000000..af28caeae --- /dev/null +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -0,0 +1,275 @@ +(.module: + [library + [lux (#- and or nat int rev list type) + [type (#+ :share)] + [abstract + [hash (#+ Hash)] + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["/" binary (#+ Binary)] + [text + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." list] + ["." row (#+ Row)] + ["." set (#+ Set)]]] + [macro + ["." template]] + [math + [number + ["n" nat] + ["." frac]]]]] + ["." // ("#\." monad)]) + +(type: #export Offset Nat) + +(type: #export Parser + (//.Parser [Offset Binary])) + +(exception: #export (binary_was_not_fully_read {binary_length Nat} {bytes_read Nat}) + (exception.report + ["Binary length" (%.nat binary_length)] + ["Bytes read" (%.nat bytes_read)])) + +(def: #export (run parser input) + (All [a] (-> (Parser a) Binary (Try a))) + (case (parser [0 input]) + (#try.Failure msg) + (#try.Failure msg) + + (#try.Success [[end _] output]) + (let [length (/.size input)] + (if (n.= end length) + (#try.Success output) + (exception.throw ..binary_was_not_fully_read [length end]))))) + +(def: #export end? + (Parser Bit) + (function (_ (^@ input [offset data])) + (#try.Success [input (n.= offset (/.size data))]))) + +(def: #export offset + (Parser Offset) + (function (_ (^@ input [offset data])) + (#try.Success [input offset]))) + +(def: #export remaining + (Parser Nat) + (function (_ (^@ input [offset data])) + (#try.Success [input (n.- offset (/.size data))]))) + +(type: #export Size Nat) + +(def: #export size/8 Size 1) +(def: #export size/16 Size (n.* 2 size/8)) +(def: #export size/32 Size (n.* 2 size/16)) +(def: #export size/64 Size (n.* 2 size/32)) + +(template [ ] + [(def: #export + (Parser I64) + (function (_ [offset binary]) + (case ( offset binary) + (#try.Success data) + (#try.Success [(n.+ offset) binary] data) + + (#try.Failure error) + (#try.Failure error))))] + + [bits/8 ..size/8 /.read/8] + [bits/16 ..size/16 /.read/16] + [bits/32 ..size/32 /.read/32] + [bits/64 ..size/64 /.read/64] + ) + +(template [ ] + [(def: #export (Parser ) ..bits/64)] + + [nat Nat] + [int Int] + [rev Rev] + ) + +(def: #export frac + (Parser Frac) + (//\map frac.from_bits ..bits/64)) + +(exception: #export (invalid_tag {range Nat} {byte Nat}) + (exception.report + ["Tag range" (%.nat range)] + ["Tag value" (%.nat byte)])) + +(template: (!variant +) + (do {! //.monad} + [flag (: (Parser Nat) + ..bits/8)] + (`` (case flag + (^template [ ] + [ (\ ! map (|>> ) )]) + ((~~ (template.splice +))) + _ (//.lift (exception.throw ..invalid_tag [(~~ (template.count +)) flag])))))) + +(def: #export (or left right) + (All [l r] (-> (Parser l) (Parser r) (Parser (| l r)))) + (!variant [[0 #.Left left] + [1 #.Right right]])) + +(def: #export (rec body) + (All [a] (-> (-> (Parser a) (Parser a)) (Parser a))) + (function (_ input) + (let [parser (body (rec body))] + (parser input)))) + +(def: #export any + (Parser Any) + (//\wrap [])) + +(exception: #export (not_a_bit {value Nat}) + (exception.report + ["Expected values" "either 0 or 1"] + ["Actual value" (%.nat value)])) + +(def: #export bit + (Parser Bit) + (do //.monad + [value (: (Parser Nat) + ..bits/8)] + (case value + 0 (wrap #0) + 1 (wrap #1) + _ (//.lift (exception.throw ..not_a_bit [value]))))) + +(def: #export (segment size) + (-> Nat (Parser Binary)) + (function (_ [offset binary]) + (case size + 0 (#try.Success [[offset binary] (/.create 0)]) + _ (|> binary + (/.slice offset size) + (\ try.monad map (|>> [[(n.+ size offset) binary]])))))) + +(template [ ] + [(def: #export + (Parser Binary) + (do //.monad + [size (//\map .nat )] + (..segment size)))] + + [binary/8 ..bits/8] + [binary/16 ..bits/16] + [binary/32 ..bits/32] + [binary/64 ..bits/64] + ) + +(template [ ] + [(def: #export + (Parser Text) + (do //.monad + [utf8 ] + (//.lift (\ utf8.codec decode utf8))))] + + [utf8/8 ..binary/8] + [utf8/16 ..binary/16] + [utf8/32 ..binary/32] + [utf8/64 ..binary/64] + ) + +(def: #export text ..utf8/64) + +(template [ ] + [(def: #export ( valueP) + (All [v] (-> (Parser v) (Parser (Row v)))) + (do //.monad + [count (: (Parser Nat) + )] + (loop [index 0 + output (:share [v] + (Parser v) + valueP + + (Row v) + row.empty)] + (if (n.< count index) + (do //.monad + [value valueP] + (recur (.inc index) + (row.add value output))) + (//\wrap output)))))] + + [row/8 ..bits/8] + [row/16 ..bits/16] + [row/32 ..bits/32] + [row/64 ..bits/64] + ) + +(def: #export maybe + (All [a] (-> (Parser a) (Parser (Maybe a)))) + (..or ..any)) + +(def: #export (list value) + (All [a] (-> (Parser a) (Parser (List a)))) + (..rec + (|>> (//.and value) + (..or ..any)))) + +(exception: #export set_elements_are_not_unique) + +(def: #export (set hash value) + (All [a] (-> (Hash a) (Parser a) (Parser (Set a)))) + (do //.monad + [raw (..list value) + #let [output (set.from_list hash raw)] + _ (//.assert (exception.construct ..set_elements_are_not_unique []) + (n.= (list.size raw) + (set.size output)))] + (wrap output))) + +(def: #export name + (Parser Name) + (//.and ..text ..text)) + +(def: #export type + (Parser Type) + (..rec + (function (_ type) + (let [pair (//.and type type) + indexed ..nat + quantified (//.and (..list type) type)] + (!variant [[0 #.Primitive (//.and ..text (..list type))] + [1 #.Sum pair] + [2 #.Product pair] + [3 #.Function pair] + [4 #.Parameter indexed] + [5 #.Var indexed] + [6 #.Ex indexed] + [7 #.UnivQ quantified] + [8 #.ExQ quantified] + [9 #.Apply pair] + [10 #.Named (//.and ..name type)]]))))) + +(def: #export location + (Parser Location) + ($_ //.and ..text ..nat ..nat)) + +(def: #export code + (Parser Code) + (..rec + (function (_ recur) + (let [sequence (..list recur)] + (//.and ..location + (!variant [[0 #.Bit ..bit] + [1 #.Nat ..nat] + [2 #.Int ..int] + [3 #.Rev ..rev] + [4 #.Frac ..frac] + [5 #.Text ..text] + [6 #.Identifier ..name] + [7 #.Tag ..name] + [8 #.Form sequence] + [9 #.Tuple sequence] + [10 #.Record (..list (//.and recur recur))]])))))) diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux new file mode 100644 index 000000000..34b061afc --- /dev/null +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -0,0 +1,99 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]]]]] + ["." //]) + +(type: #export (Parser a) + {#.doc "A command-line interface parser."} + (//.Parser (List Text) a)) + +(def: #export (run parser inputs) + (All [a] (-> (Parser a) (List Text) (Try a))) + (case (//.run parser inputs) + (#try.Success [remaining output]) + (case remaining + #.Nil + (#try.Success output) + + _ + (#try.Failure (format "Remaining CLI inputs: " (text.join_with " " remaining)))) + + (#try.Failure try) + (#try.Failure try))) + +(def: #export any + {#.doc "Just returns the next input without applying any logic."} + (Parser Text) + (function (_ inputs) + (case inputs + (#.Cons arg inputs') + (#try.Success [inputs' arg]) + + _ + (#try.Failure "Cannot parse empty arguments.")))) + +(def: #export (parse parser) + {#.doc "Parses the next input with a parsing function."} + (All [a] (-> (-> Text (Try a)) (Parser a))) + (function (_ inputs) + (do try.monad + [[remaining raw] (any inputs) + output (parser raw)] + (wrap [remaining output])))) + +(def: #export (this reference) + {#.doc "Checks that a token is in the inputs."} + (-> Text (Parser Any)) + (function (_ inputs) + (do try.monad + [[remaining raw] (any inputs)] + (if (text\= reference raw) + (wrap [remaining []]) + (try.fail (format "Missing token: '" reference "'")))))) + +(def: #export (somewhere cli) + {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} + (All [a] (-> (Parser a) (Parser a))) + (function (_ inputs) + (loop [immediate inputs] + (case (//.run cli immediate) + (#try.Success [remaining output]) + (#try.Success [remaining output]) + + (#try.Failure try) + (case immediate + #.Nil + (#try.Failure try) + + (#.Cons to_omit immediate') + (do try.monad + [[remaining output] (recur immediate')] + (wrap [(#.Cons to_omit remaining) + output]))))))) + +(def: #export end + {#.doc "Ensures there are no more inputs."} + (Parser Any) + (function (_ inputs) + (case inputs + #.Nil (#try.Success [inputs []]) + _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) + +(def: #export (named name value) + (All [a] (-> Text (Parser a) (Parser a))) + (|> value + (//.after (..this name)) + ..somewhere)) + +(def: #export (parameter [short long] value) + (All [a] (-> [Text Text] (Parser a) (Parser a))) + (|> value + (//.after (//.either (..this short) (..this long))) + ..somewhere)) diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux new file mode 100644 index 000000000..bb37c1faf --- /dev/null +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -0,0 +1,199 @@ +(.module: + [library + [lux (#- nat int rev) + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)]] + [data + ["." bit] + ["." text ("#\." monoid)] + ["." name] + [collection + ["." list ("#\." functor)]]] + [macro + ["." code ("#\." equivalence)]] + [math + [number + ["." nat] + ["." int] + ["." rev] + ["." frac]]]]] + ["." //]) + +(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')))) + +(type: #export Parser + {#.doc "A Lux syntax parser."} + (//.Parser (List Code))) + +(def: (remaining_inputs asts) + (-> (List Code) Text) + ($_ text\compose text.new_line "Remaining input: " + (|> asts (list\map code.format) (list.interpose " ") (text.join_with "")))) + +(def: #export any + {#.doc "Just returns the next input without applying any logic."} + (Parser Code) + (function (_ tokens) + (case tokens + #.Nil + (#try.Failure "There are no tokens to parse!") + + (#.Cons [t tokens']) + (#try.Success [tokens' t])))) + +(template [ ] + [(with_expansions [ (as_is (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))] + (def: #export + {#.doc (code.text ($_ text\compose "Parses the next " " input."))} + (Parser ) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( x)] tokens']) + (#try.Success [tokens' x]) + + _ + ))) + + (def: #export ( expected) + (-> (Parser Any)) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( actual)] tokens']) + (if (\ = expected actual) + (#try.Success [tokens' []]) + ) + + _ + ))))] + + [bit bit! Bit #.Bit bit.equivalence "bit"] + [nat nat! Nat #.Nat nat.equivalence "nat"] + [int int! Int #.Int int.equivalence "int"] + [rev rev! Rev #.Rev rev.equivalence "rev"] + [frac frac! Frac #.Frac frac.equivalence "frac"] + [text text! Text #.Text text.equivalence "text"] + [identifier identifier! Name #.Identifier name.equivalence "identifier"] + [tag tag! Name #.Tag name.equivalence "tag"] + ) + +(def: #export (this! ast) + {#.doc "Ensures the given Code is the next input."} + (-> Code (Parser Any)) + (function (_ tokens) + (case tokens + (#.Cons [token tokens']) + (if (code\= ast token) + (#try.Success [tokens' []]) + (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token) + (remaining_inputs tokens)))) + + _ + (#try.Failure "There are no tokens to parse!")))) + +(template [ ] + [(with_expansions [ (as_is (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))] + (def: #export + {#.doc (code.text ($_ text\compose "Parse a local " " (a " " that has no module prefix)."))} + (Parser Text) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( ["" x])] tokens']) + (#try.Success [tokens' x]) + + _ + ))) + + (def: #export ( expected) + (-> Text (Parser Any)) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( ["" actual])] tokens']) + (if (\ = expected actual) + (#try.Success [tokens' []]) + ) + + _ + ))))] + + [local_identifier local_identifier! #.Identifier text.equivalence "local identifier"] + [ local_tag local_tag! #.Tag text.equivalence "local tag"] + ) + +(template [ ] + [(def: #export ( p) + {#.doc (code.text ($_ text\compose "Parse inside the contents of a " " as if they were the input Codes."))} + (All [a] + (-> (Parser a) (Parser a))) + (function (_ tokens) + (case tokens + (#.Cons [[_ ( members)] tokens']) + (case (p members) + (#try.Success [#.Nil x]) (#try.Success [tokens' x]) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " (remaining_inputs tokens)))) + + _ + (#try.Failure ($_ text\compose "Cannot parse " (remaining_inputs tokens))))))] + + [ form #.Form "form"] + [tuple #.Tuple "tuple"] + ) + +(def: #export (record p) + {#.doc (code.text ($_ text\compose "Parse inside the contents of a record as if they were the input Codes."))} + (All [a] + (-> (Parser a) (Parser a))) + (function (_ tokens) + (case tokens + (#.Cons [[_ (#.Record pairs)] tokens']) + (case (p (join_pairs pairs)) + (#try.Success [#.Nil x]) (#try.Success [tokens' x]) + _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens)))) + + _ + (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens)))))) + +(def: #export end! + {#.doc "Ensures there are no more inputs."} + (Parser Any) + (function (_ tokens) + (case tokens + #.Nil (#try.Success [tokens []]) + _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens)))))) + +(def: #export end? + {#.doc "Checks whether there are no more inputs."} + (Parser Bit) + (function (_ tokens) + (#try.Success [tokens (case tokens + #.Nil true + _ false)]))) + +(def: #export (run syntax inputs) + (All [a] (-> (Parser a) (List Code) (Try a))) + (case (syntax inputs) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [unconsumed value]) + (case unconsumed + #.Nil + (#try.Success value) + + _ + (#try.Failure (text\compose "Unconsumed inputs: " + (|> (list\map code.format unconsumed) + (text.join_with ", "))))))) + +(def: #export (local inputs syntax) + {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} + (All [a] (-> (List Code) (Parser a) (Parser a))) + (function (_ real) + (do try.monad + [value (..run syntax inputs)] + (wrap [real value])))) diff --git a/stdlib/source/library/lux/control/parser/environment.lux b/stdlib/source/library/lux/control/parser/environment.lux new file mode 100644 index 000000000..c0ced37c2 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/environment.lux @@ -0,0 +1,44 @@ +(.module: + [library + [lux #* + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [collection + ["." dictionary (#+ Dictionary)]]]]] + ["." //]) + +(type: #export Property + Text) + +(type: #export Environment + (Dictionary Property Text)) + +(exception: #export (unknown {property Property}) + (exception.report + ["Property" (%.text property)])) + +(type: #export (Parser a) + (//.Parser Environment a)) + +(def: #export empty + Environment + (dictionary.new text.hash)) + +(def: #export (property name) + (-> Text (Parser Text)) + (function (_ environment) + (case (dictionary.get name environment) + (#.Some value) + (exception.return [environment value]) + + #.None + (exception.throw ..unknown name)))) + +(def: #export (run parser environment) + (All [a] (-> (Parser a) Environment (Try a))) + (\ try.monad map product.right (parser environment))) diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux new file mode 100644 index 000000000..12fb90dd3 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -0,0 +1,207 @@ +(.module: + [library + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." bit] + ["." text ("#\." equivalence monoid)] + [collection + ["." list ("#\." functor)] + ["." row] + ["." dictionary (#+ Dictionary)]] + [format + ["/" json (#+ JSON)]]] + [macro + ["." code]] + [math + [number + ["." frac]]]]] + ["." // ("#\." functor)]) + +(type: #export (Parser a) + {#.doc "JSON parser."} + (//.Parser (List JSON) a)) + +(exception: #export (unconsumed_input {input (List JSON)}) + (exception.report + ["Input" (exception.enumerate /.format input)])) + +(exception: #export empty_input) + +(def: #export (run parser json) + (All [a] (-> (Parser a) JSON (Try a))) + (case (//.run parser (list json)) + (#try.Success [remainder output]) + (case remainder + #.Nil + (#try.Success output) + + _ + (exception.throw ..unconsumed_input remainder)) + + (#try.Failure error) + (#try.Failure error))) + +(def: #export any + {#.doc "Just returns the JSON input without applying any logic."} + (Parser JSON) + (<| (function (_ inputs)) + (case inputs + #.Nil + (exception.throw ..empty_input []) + + (#.Cons head tail) + (#try.Success [tail head])))) + +(exception: #export (unexpected_value {value JSON}) + (exception.report + ["Value" (/.format value)])) + +(template [ ] + [(def: #export + {#.doc (code.text ($_ text\compose "Reads a JSON value as " "."))} + (Parser ) + (do //.monad + [head ..any] + (case head + ( value) + (wrap value) + + _ + (//.fail (exception.construct ..unexpected_value [head])))))] + + [null /.Null #/.Null "null"] + [boolean /.Boolean #/.Boolean "boolean"] + [number /.Number #/.Number "number"] + [string /.String #/.String "string"] + ) + +(exception: #export [a] (value_mismatch {reference JSON} {sample JSON}) + (exception.report + ["Reference" (/.format reference)] + ["Sample" (/.format sample)])) + +(template [ ] + [(def: #export ( test) + {#.doc (code.text ($_ text\compose "Asks whether a JSON value is a " "."))} + (-> (Parser Bit)) + (do //.monad + [head ..any] + (case head + ( value) + (wrap (\ = test value)) + + _ + (//.fail (exception.construct ..unexpected_value [head]))))) + + (def: #export ( test) + {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " "."))} + (-> (Parser Any)) + (do //.monad + [head ..any] + (case head + ( value) + (if (\ = test value) + (wrap []) + (//.fail (exception.construct ..value_mismatch [( test) ( value)]))) + + _ + (//.fail (exception.construct ..unexpected_value [head])))))] + + [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] + [number? number! /.Number frac.equivalence #/.Number "number"] + [string? string! /.String text.equivalence #/.String "string"] + ) + +(def: #export (nullable parser) + (All [a] (-> (Parser a) (Parser (Maybe a)))) + (//.or ..null + parser)) + +(def: #export (array parser) + {#.doc "Parses a JSON array."} + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [head ..any] + (case head + (#/.Array values) + (case (//.run parser (row.to_list values)) + (#try.Failure error) + (//.fail error) + + (#try.Success [remainder output]) + (case remainder + #.Nil + (wrap output) + + _ + (//.fail (exception.construct ..unconsumed_input remainder)))) + + _ + (//.fail (exception.construct ..unexpected_value [head]))))) + +(def: #export (object parser) + {#.doc "Parses a JSON object. Use this with the 'field' combinator."} + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [head ..any] + (case head + (#/.Object kvs) + (case (|> kvs + dictionary.entries + (list\map (function (_ [key value]) + (list (#/.String key) value))) + list.concat + (//.run parser)) + (#try.Failure error) + (//.fail error) + + (#try.Success [remainder output]) + (case remainder + #.Nil + (wrap output) + + _ + (//.fail (exception.construct ..unconsumed_input remainder)))) + + _ + (//.fail (exception.construct ..unexpected_value [head]))))) + +(def: #export (field field_name parser) + {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} + (All [a] (-> Text (Parser a) (Parser a))) + (function (recur inputs) + (case inputs + (^ (list& (#/.String key) value inputs')) + (if (text\= key field_name) + (case (//.run parser (list value)) + (#try.Success [#.Nil output]) + (#try.Success [inputs' output]) + + (#try.Success [inputs'' _]) + (exception.throw ..unconsumed_input inputs'') + + (#try.Failure error) + (#try.Failure error)) + (do try.monad + [[inputs'' output] (recur inputs')] + (wrap [(list& (#/.String key) value inputs'') + output]))) + + #.Nil + (exception.throw ..empty_input []) + + _ + (exception.throw ..unconsumed_input inputs)))) + +(def: #export dictionary + {#.doc "Parses a dictionary-like JSON object."} + (All [a] (-> (Parser a) (Parser (Dictionary Text a)))) + (|>> (//.and ..string) + //.some + ..object + (//\map (dictionary.from_list text.hash)))) diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux new file mode 100644 index 000000000..9c8f76143 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -0,0 +1,164 @@ +(.module: + [library + [lux (#- function loop i64) + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." bit] + ["." name] + ["." text + ["%" format (#+ format)]]] + [math + [number + ["n" nat] + ["." i64] + ["." frac]]] + [tool + [compiler + [reference (#+) + [variable (#+ Register)]] + [arity (#+ Arity)] + [language + [lux + [analysis (#+ Variant Tuple Environment)] + ["/" synthesis (#+ Synthesis Abstraction)]]]]]]] + ["." //]) + +## TODO: Use "type:" ASAP. +(def: Input + Type + (type (List Synthesis))) + +(exception: #export (cannot_parse {input ..Input}) + (exception.report + ["Input" (exception.enumerate /.%synthesis input)])) + +(exception: #export (unconsumed_input {input ..Input}) + (exception.report + ["Input" (exception.enumerate /.%synthesis input)])) + +(exception: #export (expected_empty_input {input ..Input}) + (exception.report + ["Input" (exception.enumerate /.%synthesis input)])) + +(exception: #export (wrong_arity {expected Arity} {actual Arity}) + (exception.report + ["Expected" (%.nat expected)] + ["Actual" (%.nat actual)])) + +(exception: #export empty_input) + +(type: #export Parser + (//.Parser ..Input)) + +(def: #export (run parser input) + (All [a] (-> (Parser a) ..Input (Try a))) + (case (parser input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [#.Nil value]) + (#try.Success value) + + (#try.Success [unconsumed _]) + (exception.throw ..unconsumed_input unconsumed))) + +(def: #export any + (Parser Synthesis) + (.function (_ input) + (case input + #.Nil + (exception.throw ..empty_input []) + + (#.Cons [head tail]) + (#try.Success [tail head])))) + +(def: #export end! + {#.doc "Ensures there are no more inputs."} + (Parser Any) + (.function (_ tokens) + (case tokens + #.Nil (#try.Success [tokens []]) + _ (exception.throw ..expected_empty_input [tokens])))) + +(def: #export end? + {#.doc "Checks whether there are no more inputs."} + (Parser Bit) + (.function (_ tokens) + (#try.Success [tokens (case tokens + #.Nil true + _ false)]))) + +(template [ ] + [(def: #export + (Parser ) + (.function (_ input) + (case input + (^ (list& ( x) input')) + (#try.Success [input' x]) + + _ + (exception.throw ..cannot_parse input)))) + + (def: #export ( expected) + (-> (Parser Any)) + (.function (_ input) + (case input + (^ (list& ( actual) input')) + (if (\ = expected actual) + (#try.Success [input' []]) + (exception.throw ..cannot_parse input)) + + _ + (exception.throw ..cannot_parse input))))] + + [bit bit! /.bit Bit bit.equivalence] + [i64 i64! /.i64 (I64 Any) i64.equivalence] + [f64 f64! /.f64 Frac frac.equivalence] + [text text! /.text Text text.equivalence] + [local local! /.variable/local Nat n.equivalence] + [foreign foreign! /.variable/foreign Nat n.equivalence] + [constant constant! /.constant Name name.equivalence] + ) + +(def: #export (tuple parser) + (All [a] (-> (Parser a) (Parser a))) + (.function (_ input) + (case input + (^ (list& (/.tuple head) tail)) + (do try.monad + [output (..run parser head)] + (#try.Success [tail output])) + + _ + (exception.throw ..cannot_parse input)))) + +(def: #export (function expected parser) + (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) + (.function (_ input) + (case input + (^ (list& (/.function/abstraction [environment actual body]) tail)) + (if (n.= expected actual) + (do try.monad + [output (..run parser (list body))] + (#try.Success [tail [environment output]])) + (exception.throw ..wrong_arity [expected actual])) + + _ + (exception.throw ..cannot_parse input)))) + +(def: #export (loop init_parsers iteration_parser) + (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b]))) + (.function (_ input) + (case input + (^ (list& (/.loop/scope [start inits iteration]) tail)) + (do try.monad + [inits (..run init_parsers inits) + iteration (..run iteration_parser (list iteration))] + (#try.Success [tail [start inits iteration]])) + + _ + (exception.throw ..cannot_parse input)))) diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux new file mode 100644 index 000000000..cfd1ab891 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -0,0 +1,377 @@ +(.module: + [library + [lux (#- or and not) + [abstract + [monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["/" text (#+ Char) ("#\." monoid)] + ["." product] + ["." maybe] + [collection + ["." list ("#\." fold)]]] + [macro + ["." code]] + [math + [number + ["n" nat ("#\." decimal)]]]]] + ["." //]) + +(type: #export Offset Nat) + +(def: start_offset Offset 0) + +(type: #export Parser + (//.Parser [Offset Text])) + +(type: #export Slice + {#basis Offset + #distance Offset}) + +(def: (remaining offset tape) + (-> Offset Text Text) + (|> tape (/.split offset) maybe.assume product.right)) + +(exception: #export (unconsumed_input {offset Offset} {tape Text}) + (exception.report + ["Offset" (n\encode offset)] + ["Input size" (n\encode (/.size tape))] + ["Remaining input" (remaining offset tape)])) + +(exception: #export (expected_to_fail {offset Offset} {tape Text}) + (exception.report + ["Offset" (n\encode offset)] + ["Input" (remaining offset tape)])) + +(exception: #export cannot_parse) +(exception: #export cannot_slice) + +(def: #export (run parser input) + (All [a] (-> (Parser a) Text (Try a))) + (case (parser [start_offset input]) + (#try.Failure msg) + (#try.Failure msg) + + (#try.Success [[end_offset _] output]) + (if (n.= end_offset (/.size input)) + (#try.Success output) + (exception.throw ..unconsumed_input [end_offset input])))) + +(def: #export offset + (Parser Offset) + (function (_ (^@ input [offset tape])) + (#try.Success [input offset]))) + +(def: (with_slices parser) + (-> (Parser (List Slice)) (Parser Slice)) + (do //.monad + [offset ..offset + slices parser] + (wrap (list\fold (function (_ [slice::basis slice::distance] + [total::basis total::distance]) + [total::basis ("lux i64 +" slice::distance total::distance)]) + {#basis offset + #distance 0} + slices)))) + +(def: #export any + {#.doc "Just returns the next character without applying any logic."} + (Parser Text) + (function (_ [offset tape]) + (case (/.nth offset tape) + (#.Some output) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) + + _ + (exception.throw ..cannot_parse [])))) + +(def: #export any! + {#.doc "Just returns the next character without applying any logic."} + (Parser Slice) + (function (_ [offset tape]) + (case (/.nth offset tape) + (#.Some _) + (#try.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]) + + _ + (exception.throw ..cannot_slice [])))) + +(template [ ] + [(def: #export ( p) + {#.doc "Produce a character if the parser fails."} + (All [a] (-> (Parser a) (Parser ))) + (function (_ input) + (case (p input) + (#try.Failure msg) + ( input) + + _ + (exception.throw ..expected_to_fail input))))] + + [not Text ..any] + [not! Slice ..any!] + ) + +(exception: #export (cannot_match {reference Text}) + (exception.report + ["Reference" (/.format reference)])) + +(def: #export (this reference) + {#.doc "Lex a text if it matches the given sample."} + (-> Text (Parser Any)) + (function (_ [offset tape]) + (case (/.index_of' reference offset tape) + (#.Some where) + (if (n.= offset where) + (#try.Success [[("lux i64 +" (/.size reference) offset) tape] + []]) + (exception.throw ..cannot_match [reference])) + + _ + (exception.throw ..cannot_match [reference])))) + +(def: #export end! + {#.doc "Ensure the parser's input is empty."} + (Parser Any) + (function (_ (^@ input [offset tape])) + (if (n.= offset (/.size tape)) + (#try.Success [input []]) + (exception.throw ..unconsumed_input input)))) + +(def: #export peek + {#.doc "Lex the next character (without consuming it from the input)."} + (Parser Text) + (function (_ (^@ input [offset tape])) + (case (/.nth offset tape) + (#.Some output) + (#try.Success [input (/.from_code output)]) + + _ + (exception.throw ..cannot_parse [])))) + +(def: #export get_input + {#.doc "Get all of the remaining input (without consuming it)."} + (Parser Text) + (function (_ (^@ input [offset tape])) + (#try.Success [input (remaining offset tape)]))) + +(def: #export (range bottom top) + {#.doc "Only lex characters within a range."} + (-> Nat Nat (Parser Text)) + (do //.monad + [char any + #let [char' (maybe.assume (/.nth 0 char))] + _ (//.assert ($_ /\compose "Character is not within range: " (/.from_code bottom) "-" (/.from_code top)) + (.and (n.>= bottom char') + (n.<= top char')))] + (wrap char))) + +(template [ ] + [(def: #export + {#.doc (code.text ($_ /\compose "Only lex " " characters."))} + (Parser Text) + (..range (char ) (char )))] + + [upper "A" "Z" "uppercase"] + [lower "a" "z" "lowercase"] + [decimal "0" "9" "decimal"] + [octal "0" "7" "octal"] + ) + +(def: #export alpha + {#.doc "Only lex alphabetic characters."} + (Parser Text) + (//.either lower upper)) + +(def: #export alpha_num + {#.doc "Only lex alphanumeric characters."} + (Parser Text) + (//.either alpha decimal)) + +(def: #export hexadecimal + {#.doc "Only lex hexadecimal digits."} + (Parser Text) + ($_ //.either + decimal + (range (char "a") (char "f")) + (range (char "A") (char "F")))) + +(template [] + [(exception: #export ( {options Text} {character Char}) + (exception.report + ["Options" (/.format options)] + ["Character" (/.format (/.from_code character))]))] + + [character_should_be] + [character_should_not_be] + ) + +(template [ ] + [(def: #export ( options) + {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} + (-> Text (Parser Text)) + (function (_ [offset tape]) + (case (/.nth offset tape) + (#.Some output) + (let [output' (/.from_code output)] + (if ( (/.contains? output' options)) + (#try.Success [[("lux i64 +" 1 offset) tape] output']) + (exception.throw [options output]))) + + _ + (exception.throw ..cannot_parse []))))] + + [one_of |> ..character_should_be ""] + [none_of .not ..character_should_not_be " not"] + ) + +(template [ ] + [(def: #export ( options) + {#.doc (code.text ($_ /\compose "Only lex characters that are" " part of a piece of text."))} + (-> Text (Parser Slice)) + (function (_ [offset tape]) + (case (/.nth offset tape) + (#.Some output) + (let [output' (/.from_code output)] + (if ( (/.contains? output' options)) + (#try.Success [[("lux i64 +" 1 offset) tape] + {#basis offset + #distance 1}]) + (exception.throw [options output]))) + + _ + (exception.throw ..cannot_slice []))))] + + [one_of! |> ..character_should_be ""] + [none_of! .not ..character_should_not_be " not"] + ) + +(exception: #export (character_does_not_satisfy_predicate {character Char}) + (exception.report + ["Character" (/.format (/.from_code character))])) + +(def: #export (satisfies p) + {#.doc "Only lex characters that satisfy a predicate."} + (-> (-> Char Bit) (Parser Text)) + (function (_ [offset tape]) + (case (/.nth offset tape) + (#.Some output) + (if (p output) + (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)]) + (exception.throw ..character_does_not_satisfy_predicate [output])) + + _ + (exception.throw ..cannot_parse [])))) + +(def: #export space + {#.doc "Only lex white-space."} + (Parser Text) + (..satisfies /.space?)) + +(def: #export (and left right) + (-> (Parser Text) (Parser Text) (Parser Text)) + (do //.monad + [=left left + =right right] + (wrap ($_ /\compose =left =right)))) + +(def: #export (and! left right) + (-> (Parser Slice) (Parser Slice) (Parser Slice)) + (do //.monad + [[left::basis left::distance] left + [right::basis right::distance] right] + (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) + +(template [ ] + [(def: #export ( parser) + {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} + (-> (Parser Text) (Parser Text)) + (|> parser (\ //.monad map /.concat)))] + + [some //.some "some"] + [many //.many "many"] + ) + +(template [ ] + [(def: #export ( parser) + {#.doc (code.text ($_ /\compose "Lex " " characters as a single continuous text."))} + (-> (Parser Slice) (Parser Slice)) + (with_slices ( parser)))] + + [some! //.some "some"] + [many! //.many "many"] + ) + +(template [ ] + [(def: #export ( amount parser) + {#.doc (code.text ($_ /\compose "Lex " " N characters."))} + (-> Nat (Parser Text) (Parser Text)) + (|> parser ( amount) (\ //.monad map /.concat)))] + + [exactly //.exactly "exactly"] + [at_most //.at_most "at most"] + [at_least //.at_least "at least"] + ) + +(template [ ] + [(def: #export ( amount parser) + {#.doc (code.text ($_ /\compose "Lex " " N characters."))} + (-> Nat (Parser Slice) (Parser Slice)) + (with_slices ( amount parser)))] + + [exactly! //.exactly "exactly"] + [at_most! //.at_most "at most"] + [at_least! //.at_least "at least"] + ) + +(def: #export (between from to parser) + {#.doc "Lex between N and M characters."} + (-> Nat Nat (Parser Text) (Parser Text)) + (|> parser (//.between from to) (\ //.monad map /.concat))) + +(def: #export (between! from to parser) + {#.doc "Lex between N and M characters."} + (-> Nat Nat (Parser Slice) (Parser Slice)) + (with_slices (//.between from to parser))) + +(def: #export (enclosed [start end] parser) + (All [a] (-> [Text Text] (Parser a) (Parser a))) + (|> parser + (//.before (this end)) + (//.after (this start)))) + +(def: #export (local local_input parser) + {#.doc "Run a parser with the given input, instead of the real one."} + (All [a] (-> Text (Parser a) (Parser a))) + (function (_ real_input) + (case (..run parser local_input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success value) + (#try.Success [real_input value])))) + +(def: #export (slice parser) + (-> (Parser Slice) (Parser Text)) + (do //.monad + [[basis distance] parser] + (function (_ (^@ input [offset tape])) + (case (/.clip basis distance tape) + (#.Some output) + (#try.Success [input output]) + + #.None + (exception.throw ..cannot_slice []))))) + +(def: #export (embed structured text) + (All [s a] + (-> (Parser a) + (//.Parser s Text) + (//.Parser s a))) + (do //.monad + [raw text] + (//.lift (..run structured raw)))) diff --git a/stdlib/source/library/lux/control/parser/tree.lux b/stdlib/source/library/lux/control/parser/tree.lux new file mode 100644 index 000000000..5834c69e8 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/tree.lux @@ -0,0 +1,60 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [collection + [tree (#+ Tree) + ["." zipper (#+ Zipper)]]]]]] + ["." //]) + +(type: #export (Parser t a) + (//.Parser (Zipper t) a)) + +(def: #export (run' parser zipper) + (All [t a] (-> (Parser t a) (Zipper t) (Try a))) + (do try.monad + [[zipper output] (//.run parser zipper)] + (wrap output))) + +(def: #export (run parser tree) + (All [t a] (-> (Parser t a) (Tree t) (Try a))) + (run' parser (zipper.zip tree))) + +(def: #export value + (All [t] (Parser t t)) + (function (_ zipper) + (#try.Success [zipper (zipper.value zipper)]))) + +(exception: #export cannot-move-further) + +(template [ ] + [(def: #export + (All [t] (Parser t [])) + (function (_ zipper) + (case ( zipper) + #.None + (exception.throw ..cannot-move-further []) + + (#.Some next) + (#try.Success [next []]))))] + + [down zipper.down] + [up zipper.up] + + [right zipper.right] + [rightmost zipper.rightmost] + + [left zipper.left] + [leftmost zipper.leftmost] + + [next zipper.next] + [end zipper.end] + + [previous zipper.previous] + [start zipper.start] + ) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux new file mode 100644 index 000000000..1e2c037d5 --- /dev/null +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -0,0 +1,349 @@ +(.module: + [library + [lux (#- function) + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." function]] + [data + ["." text ("#\." monoid) + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)] + ["." dictionary (#+ Dictionary)]]] + [macro + ["." code]] + [math + [number + ["n" nat ("#\." decimal)]]] + ["." type ("#\." equivalence) + ["." check]]]] + ["." //]) + +(template [] + [(exception: #export ( {type Type}) + (exception.report + ["Type" (%.type type)]))] + + [not_existential] + [not_recursive] + [not_named] + [not_parameter] + [unknown_parameter] + [not_function] + [not_application] + [not_polymorphic] + [not_variant] + [not_tuple] + ) + +(template [] + [(exception: #export ( {expected Type} {actual Type}) + (exception.report + ["Expected" (%.type expected)] + ["Actual" (%.type actual)]))] + + [types_do_not_match] + [wrong_parameter] + ) + +(exception: #export empty_input) + +(exception: #export (unconsumed_input {remaining (List Type)}) + (exception.report + ["Types" (|> remaining + (list\map (|>> %.type (format text.new_line "* "))) + (text.join_with ""))])) + +(type: #export Env + (Dictionary Nat [Type Code])) + +(type: #export (Parser a) + (//.Parser [Env (List Type)] a)) + +(def: #export fresh + Env + (dictionary.new n.hash)) + +(def: (run' env poly types) + (All [a] (-> Env (Parser a) (List Type) (Try a))) + (case (//.run poly [env types]) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [[env' remaining] output]) + (case remaining + #.Nil + (#try.Success output) + + _ + (exception.throw ..unconsumed_input remaining)))) + +(def: #export (run poly type) + (All [a] (-> (Parser a) Type (Try a))) + (run' ..fresh poly (list type))) + +(def: #export env + (Parser Env) + (.function (_ [env inputs]) + (#try.Success [[env inputs] env]))) + +(def: (with_env temp poly) + (All [a] (-> Env (Parser a) (Parser a))) + (.function (_ [env inputs]) + (case (//.run poly [temp inputs]) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [[_ remaining] output]) + (#try.Success [[env remaining] output])))) + +(def: #export peek + (Parser Type) + (.function (_ [env inputs]) + (case inputs + #.Nil + (exception.throw ..empty_input []) + + (#.Cons headT tail) + (#try.Success [[env inputs] headT])))) + +(def: #export any + (Parser Type) + (.function (_ [env inputs]) + (case inputs + #.Nil + (exception.throw ..empty_input []) + + (#.Cons headT tail) + (#try.Success [[env tail] headT])))) + +(def: #export (local types poly) + (All [a] (-> (List Type) (Parser a) (Parser a))) + (.function (_ [env pass_through]) + (case (run' env poly types) + (#try.Failure error) + (#try.Failure error) + + (#try.Success output) + (#try.Success [[env pass_through] output])))) + +(def: (label idx) + (-> Nat Code) + (code.local_identifier ($_ text\compose "label" text.tab (n\encode idx)))) + +(def: #export (with_extension type poly) + (All [a] (-> Type (Parser a) (Parser [Code a]))) + (.function (_ [env inputs]) + (let [current_id (dictionary.size env) + g!var (label current_id)] + (case (//.run poly + [(dictionary.put current_id [type g!var] env) + inputs]) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [[_ inputs'] output]) + (#try.Success [[env inputs'] [g!var output]]))))) + +(template [ ] + [(def: #export ( poly) + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [headT ..any] + (let [members ( (type.un_name headT))] + (if (n.> 1 (list.size members)) + (local members poly) + (//.fail (exception.construct headT))))))] + + [variant type.flatten_variant #.Sum ..not_variant] + [tuple type.flatten_tuple #.Product ..not_tuple] + ) + +(def: polymorphic' + (Parser [Nat Type]) + (do //.monad + [headT any + #let [[num_arg bodyT] (type.flatten_univ_q (type.un_name headT))]] + (if (n.= 0 num_arg) + (//.fail (exception.construct ..not_polymorphic headT)) + (wrap [num_arg bodyT])))) + +(def: #export (polymorphic poly) + (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) + (do {! //.monad} + [headT any + funcI (\ ! map dictionary.size ..env) + [num_args non_poly] (local (list headT) ..polymorphic') + env ..env + #let [funcL (label funcI) + [all_varsL env'] (loop [current_arg 0 + env' env + all_varsL (: (List Code) (list))] + (if (n.< num_args current_arg) + (if (n.= 0 current_arg) + (let [varL (label (inc funcI))] + (recur (inc current_arg) + (|> env' + (dictionary.put funcI [headT funcL]) + (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL])) + (#.Cons varL all_varsL))) + (let [partialI (|> current_arg (n.* 2) (n.+ funcI)) + partial_varI (inc partialI) + partial_varL (label partial_varI) + partialC (` ((~ funcL) (~+ (|> (list.indices num_args) + (list\map (|>> (n.* 2) inc (n.+ funcI) label)) + list.reverse))))] + (recur (inc current_arg) + (|> env' + (dictionary.put partialI [.Nothing partialC]) + (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL])) + (#.Cons partial_varL all_varsL)))) + [all_varsL env']))]] + (<| (with_env env') + (local (list non_poly)) + (do ! + [output poly] + (wrap [funcL all_varsL output]))))) + +(def: #export (function in_poly out_poly) + (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) + (do //.monad + [headT any + #let [[inputsT outputT] (type.flatten_function (type.un_name headT))]] + (if (n.> 0 (list.size inputsT)) + (//.and (local inputsT in_poly) + (local (list outputT) out_poly)) + (//.fail (exception.construct ..not_function headT))))) + +(def: #export (apply poly) + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [headT any + #let [[funcT paramsT] (type.flatten_application (type.un_name headT))]] + (if (n.= 0 (list.size paramsT)) + (//.fail (exception.construct ..not_application headT)) + (..local (#.Cons funcT paramsT) poly)))) + +(template [ ] + [(def: #export ( expected) + (-> Type (Parser Any)) + (do //.monad + [actual any] + (if ( expected actual) + (wrap []) + (//.fail (exception.construct ..types_do_not_match [expected actual])))))] + + [exactly type\=] + [sub check.checks?] + [super (function.flip check.checks?)] + ) + +(def: #export (adjusted_idx env idx) + (-> Env Nat Nat) + (let [env_level (n./ 2 (dictionary.size env)) + parameter_level (n./ 2 idx) + parameter_idx (n.% 2 idx)] + (|> env_level dec (n.- parameter_level) (n.* 2) (n.+ parameter_idx)))) + +(def: #export parameter + (Parser Code) + (do //.monad + [env ..env + headT any] + (case headT + (#.Parameter idx) + (case (dictionary.get (adjusted_idx env idx) env) + (#.Some [poly_type poly_code]) + (wrap poly_code) + + #.None + (//.fail (exception.construct ..unknown_parameter headT))) + + _ + (//.fail (exception.construct ..not_parameter headT))))) + +(def: #export (parameter! id) + (-> Nat (Parser Any)) + (do //.monad + [env ..env + headT any] + (case headT + (#.Parameter idx) + (if (n.= id (adjusted_idx env idx)) + (wrap []) + (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) + + _ + (//.fail (exception.construct ..not_parameter headT))))) + +(def: #export existential + (Parser Nat) + (do //.monad + [headT any] + (case headT + (#.Ex ex_id) + (wrap ex_id) + + _ + (//.fail (exception.construct ..not_existential headT))))) + +(def: #export named + (Parser [Name Type]) + (do //.monad + [inputT any] + (case inputT + (#.Named name anonymousT) + (wrap [name anonymousT]) + + _ + (//.fail (exception.construct ..not_named inputT))))) + +(`` (template: (|nothing|) + (#.Named [(~~ (static .prelude_module)) "Nothing"] + (#.UnivQ #.Nil + (#.Parameter 1))))) + +(def: #export (recursive poly) + (All [a] (-> (Parser a) (Parser [Code a]))) + (do {! //.monad} + [headT any] + (case (type.un_name headT) + (^ (#.Apply (|nothing|) (#.UnivQ _ headT'))) + (do ! + [[recT _ output] (|> poly + (with_extension .Nothing) + (with_extension headT) + (local (list headT')))] + (wrap [recT output])) + + _ + (//.fail (exception.construct ..not_recursive headT))))) + +(def: #export recursive_self + (Parser Code) + (do //.monad + [env ..env + headT any] + (case (type.un_name headT) + (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx))) + (n.= 0 (adjusted_idx env funcT_idx)) + [(dictionary.get 0 env) (#.Some [self_type self_call])]) + (wrap self_call) + + _ + (//.fail (exception.construct ..not_recursive headT))))) + +(def: #export recursive_call + (Parser Code) + (do {! //.monad} + [env ..env + [funcT argsT] (..apply (//.and any (//.many any))) + _ (local (list funcT) (..parameter! 0)) + allC (let [allT (list& funcT argsT)] + (|> allT + (monad.map ! (function.constant ..parameter)) + (local allT)))] + (wrap (` ((~+ allC)))))) diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux new file mode 100644 index 000000000..3fed4030e --- /dev/null +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -0,0 +1,142 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try) ("#\." functor)] + ["." exception (#+ exception:)]] + [data + ["." name ("#\." equivalence codec)] + ["." text + ["%" format (#+ format)]] + [collection + ["." list] + ["." dictionary]] + [format + ["/" xml (#+ Attribute Attrs Tag XML)]]]]] + ["." //]) + +(type: #export (Parser a) + (//.Parser [Attrs (List XML)] a)) + +(exception: #export empty_input) +(exception: #export unexpected_input) + +(exception: #export (wrong_tag {expected Tag} {actual Tag}) + (exception.report + ["Expected" (%.text (/.tag expected))] + ["Actual" (%.text (/.tag actual))])) + +(exception: #export (unknown_attribute {expected Attribute} {available (List Attribute)}) + (exception.report + ["Expected" (%.text (/.attribute expected))] + ["Available" (exception.enumerate (|>> /.attribute %.text) available)])) + +(exception: #export (unconsumed_inputs {inputs (List XML)}) + (exception.report + ["Inputs" (exception.enumerate (\ /.codec encode) inputs)])) + +(def: (run' parser attrs documents) + (All [a] (-> (Parser a) Attrs (List XML) (Try a))) + (case (//.run parser [attrs documents]) + (#try.Success [[attrs' remaining] output]) + (if (list.empty? remaining) + (#try.Success output) + (exception.throw ..unconsumed_inputs remaining)) + + (#try.Failure error) + (#try.Failure error))) + +(def: #export (run parser documents) + (All [a] (-> (Parser a) (List XML) (Try a))) + (..run' parser /.attributes documents)) + +(def: #export text + (Parser Text) + (function (_ [attrs documents]) + (case documents + #.Nil + (exception.throw ..empty_input []) + + (#.Cons head tail) + (case head + (#/.Text value) + (#try.Success [[attrs tail] value]) + + (#/.Node _) + (exception.throw ..unexpected_input []))))) + +(def: #export tag + (Parser Tag) + (function (_ [attrs documents]) + (case documents + #.Nil + (exception.throw ..empty_input []) + + (#.Cons head _) + (case head + (#/.Text _) + (exception.throw ..unexpected_input []) + + (#/.Node tag _ _) + (#try.Success [[attrs documents] tag]))))) + +(def: #export (attribute name) + (-> Attribute (Parser Text)) + (function (_ [attrs documents]) + (case (dictionary.get name attrs) + #.None + (exception.throw ..unknown_attribute [name (dictionary.keys attrs)]) + + (#.Some value) + (#try.Success [[attrs documents] value])))) + +(def: #export (node expected parser) + (All [a] (-> Tag (Parser a) (Parser a))) + (function (_ [attrs documents]) + (case documents + #.Nil + (exception.throw ..empty_input []) + + (#.Cons head tail) + (case head + (#/.Text _) + (exception.throw ..unexpected_input []) + + (#/.Node actual attrs' children) + (if (name\= expected actual) + (|> children + (..run' parser attrs') + (try\map (|>> [[attrs tail]]))) + (exception.throw ..wrong_tag [expected actual])))))) + +(def: #export ignore + (Parser Any) + (function (_ [attrs documents]) + (case documents + #.Nil + (exception.throw ..empty_input []) + + (#.Cons head tail) + (#try.Success [[attrs tail] []])))) + +(exception: #export nowhere) + +(def: #export (somewhere parser) + (All [a] (-> (Parser a) (Parser a))) + (function (recur [attrs input]) + (case (//.run parser [attrs input]) + (#try.Success [[attrs remaining] output]) + (#try.Success [[attrs remaining] output]) + + (#try.Failure error) + (case input + #.Nil + (exception.throw ..nowhere []) + + (#.Cons head tail) + (do try.monad + [[[attrs tail'] output] (recur [attrs tail])] + (wrap [[attrs (#.Cons head tail')] + output])))))) diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux new file mode 100644 index 000000000..cac70fe6b --- /dev/null +++ b/stdlib/source/library/lux/control/pipe.lux @@ -0,0 +1,161 @@ +(.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["e" try] + ["p" parser + ["s" code (#+ Parser)]]] + [data + ["." identity] + [collection + ["." list ("#\." fold monad)]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + [math + [number + ["n" nat] + ["i" int]]]]]) + +(def: body^ + (Parser (List Code)) + (s.tuple (p.some s.any))) + +(syntax: #export (new> start + {body body^} + prev) + {#.doc (doc "Ignores the piped argument, and begins a new pipe." + (n.= 1 + (|> 20 + (n.* 3) + (n.+ 4) + (new> 0 [inc]))))} + (wrap (list (` (|> (~ start) (~+ body)))))) + +(syntax: #export (let> binding body prev) + {#.doc (doc "Gives a name to the piped-argument, within the given expression." + (n.= 10 + (|> 5 + (let> x (n.+ x x)))))} + (wrap (list (` (let [(~ binding) (~ prev)] + (~ body)))))) + +(def: _reverse_ + (Parser Any) + (function (_ tokens) + (#e.Success [(list.reverse tokens) []]))) + +(syntax: #export (cond> {_ _reverse_} + prev + {else body^} + {_ _reverse_} + {branches (p.some (p.and body^ body^))}) + {#.doc (doc "Branching for pipes." + "Both the tests and the bodies are piped-code, and must be given inside a tuple." + (|> +5 + (cond> [i.even?] [(i.* +2)] + [i.odd?] [(i.* +3)] + [(new> -1 [])])))} + (with_gensyms [g!temp] + (wrap (list (` (let [(~ g!temp) (~ prev)] + (cond (~+ (do list.monad + [[test then] branches] + (list (` (|> (~ g!temp) (~+ test))) + (` (|> (~ g!temp) (~+ then)))))) + (|> (~ g!temp) (~+ else))))))))) + +(syntax: #export (if> {test body^} {then body^} {else body^} prev) + (wrap (list (` (cond> [(~+ test)] [(~+ then)] + [(~+ else)] + (~ prev)))))) + +(syntax: #export (when> {test body^} {then body^} prev) + (wrap (list (` (cond> [(~+ test)] [(~+ then)] + [] + (~ prev)))))) + +(syntax: #export (loop> {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 + (loop> [(i.< +10)] + [inc])))} + (with_gensyms [g!temp] + (wrap (list (` (loop [(~ g!temp) (~ prev)] + (if (|> (~ g!temp) (~+ test)) + ((~' recur) (|> (~ g!temp) (~+ then))) + (~ g!temp)))))))) + +(syntax: #export (do> monad + {steps (p.some body^)} + prev) + {#.doc (doc "Monadic pipes." + "Each steps in the monadic computation is a pipe and must be given inside a tuple." + (|> +5 + (do> identity.monad + [(i.* +3)] + [(i.+ +4)] + [inc])))} + (with_gensyms [g!temp] + (case (list.reverse steps) + (^ (list& last_step prev_steps)) + (let [step_bindings (do list.monad + [step (list.reverse prev_steps)] + (list g!temp (` (|> (~ g!temp) (~+ step)))))] + (wrap (list (` ((~! do) (~ monad) + [(~' #let) [(~ g!temp) (~ prev)] + (~+ step_bindings)] + (|> (~ g!temp) (~+ last_step))))))) + + _ + (wrap (list prev))))) + +(syntax: #export (exec> {body body^} + prev) + {#.doc (doc "Non-updating pipes." + "Will generate piped computations, but their results will not be used in the larger scope." + (|> +5 + (exec> [.nat %n log!]) + (i.* +10)))} + (with_gensyms [g!temp] + (wrap (list (` (let [(~ g!temp) (~ prev)] + (exec (|> (~ g!temp) (~+ body)) + (~ g!temp)))))))) + +(syntax: #export (tuple> {paths (p.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 + (tuple> [(i.* +10)] + [dec (i./ +2)] + [Int/encode])) + "Will become: [+50 +2 '+5']")} + (with_gensyms [g!temp] + (wrap (list (` (let [(~ g!temp) (~ prev)] + [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) + paths))])))))) + +(syntax: #export (case> {branches (p.many (p.and 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" + _ "???")))} + (wrap (list (` (case (~ prev) + (~+ (list\join (list\map (function (_ [pattern body]) (list pattern body)) + branches)))))))) diff --git a/stdlib/source/library/lux/control/reader.lux b/stdlib/source/library/lux/control/reader.lux new file mode 100644 index 000000000..95662b8ba --- /dev/null +++ b/stdlib/source/library/lux/control/reader.lux @@ -0,0 +1,72 @@ +(.module: + [library + [lux #* + [abstract + ["." functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]]]]) + +(type: #export (Reader r a) + {#.doc "Computations that have access to some environmental value."} + (-> r a)) + +(def: #export ask + {#.doc "Get the environment."} + (All [r] (Reader r r)) + (function (_ env) env)) + +(def: #export (local change proc) + {#.doc "Run computation with a locally-modified environment."} + (All [r a] (-> (-> r r) (Reader r a) (Reader r a))) + (|>> change proc)) + +(def: #export (run env proc) + (All [r a] (-> r (Reader r a) a)) + (proc env)) + +(implementation: #export functor + (All [r] (Functor (Reader r))) + + (def: (map f fa) + (function (_ env) + (f (fa env))))) + +(implementation: #export apply + (All [r] (Apply (Reader r))) + + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ env) + ((ff env) (fa env))))) + +(implementation: #export monad + (All [r] (Monad (Reader r))) + + (def: &functor ..functor) + + (def: (wrap x) + (function (_ env) x)) + + (def: (join mma) + (function (_ env) + (mma env env)))) + +(implementation: #export (with monad) + {#.doc "Monad transformer for Reader."} + (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) + + (def: &functor (functor.compose ..functor (get@ #monad.&functor monad))) + + (def: wrap (|>> (\ monad wrap) (\ ..monad wrap))) + + (def: (join eMeMa) + (function (_ env) + (do monad + [eMa (run env eMeMa)] + (run env eMa))))) + +(def: #export lift + {#.doc "Lift monadic values to the Reader wrapper."} + (All [M e a] (-> (M a) (Reader e (M a)))) + (\ ..monad wrap)) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux new file mode 100644 index 000000000..ff6247418 --- /dev/null +++ b/stdlib/source/library/lux/control/region.lux @@ -0,0 +1,158 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + ["." monad (#+ Monad do)]] + [control + ["." try (#+ Try)]] + [data + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#\." fold)]]]]] + [// + ["." exception (#+ Exception exception:)]]) + +(type: (Cleaner r !) + (-> r (! (Try Any)))) + +(type: #export (Region r ! a) + (-> [r (List (Cleaner r !))] + (! [(List (Cleaner r !)) + (Try a)]))) + +(def: separator + Text + (format text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + "-----------------------------------------" text.new_line + text.new_line)) + +(exception: #export [a] (clean_up_error {error Text} + {output (Try a)}) + (format error + (case output + (#try.Success _) + "" + + (#try.Failure error|output) + (format separator + error|output)))) + +(def: (combine_outcomes clean_up output) + (All [a] (-> (Try Any) (Try a) (Try a))) + (case clean_up + (#try.Success _) + output + + (#try.Failure error) + (exception.throw ..clean_up_error [error output]))) + +(def: #export (run monad computation) + (All [! a] + (-> (Monad !) (All [r] (Region r ! a)) + (! (Try a)))) + (do {! monad} + [[cleaners output] (computation [[] (list)]) + results (monad.map ! (function (_ cleaner) (cleaner [])) + cleaners)] + (wrap (list\fold combine_outcomes output results)))) + +(def: #export (acquire monad cleaner value) + (All [! a] (-> (Monad !) (-> a (! (Try Any))) a + (All [r] (Region r ! a)))) + (function (_ [region cleaners]) + (\ monad wrap [(#.Cons (function (_ region) (cleaner value)) + cleaners) + (#try.Success value)]))) + +(implementation: #export (functor super) + (All [!] + (-> (Functor !) + (All [r] (Functor (Region r !))))) + + (def: (map f) + (function (_ fa) + (function (_ region+cleaners) + (\ super map + (function (_ [cleaners' temp]) + [cleaners' (case temp + (#try.Success value) + (#try.Success (f value)) + + (#try.Failure error) + (#try.Failure error))]) + (fa region+cleaners)))))) + +(implementation: #export (apply super) + (All [!] + (-> (Monad !) + (All [r] (Apply (Region r !))))) + + (def: &functor + (..functor (get@ #monad.&functor super))) + + (def: (apply ff fa) + (function (_ [region cleaners]) + (do super + [[cleaners ef] (ff [region cleaners]) + [cleaners ea] (fa [region cleaners])] + (case ef + (#try.Success f) + (case ea + (#try.Success a) + (wrap [cleaners (#try.Success (f a))]) + + (#try.Failure error) + (wrap [cleaners (#try.Failure error)])) + + (#try.Failure error) + (wrap [cleaners (#try.Failure error)])))))) + +(implementation: #export (monad super) + (All [!] + (-> (Monad !) + (All [r] (Monad (Region r !))))) + + (def: &functor + (..functor (get@ #monad.&functor super))) + + (def: (wrap value) + (function (_ [region cleaners]) + (\ super wrap [cleaners (#try.Success value)]))) + + (def: (join ffa) + (function (_ [region cleaners]) + (do super + [[cleaners efa] (ffa [region cleaners])] + (case efa + (#try.Success fa) + (fa [region cleaners]) + + (#try.Failure error) + (wrap [cleaners (#try.Failure error)])))))) + +(def: #export (fail monad error) + (All [! a] + (-> (Monad !) Text + (All [r] (Region r ! a)))) + (function (_ [region cleaners]) + (\ monad wrap [cleaners (#try.Failure error)]))) + +(def: #export (throw monad exception message) + (All [! e a] + (-> (Monad !) (Exception e) e + (All [r] (Region r ! a)))) + (fail monad (exception.construct exception message))) + +(def: #export (lift monad operation) + (All [! a] + (-> (Monad !) (! a) + (All [r] (Region r ! a)))) + (function (_ [region cleaners]) + (do monad + [output operation] + (wrap [cleaners (#try.Success output)])))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux new file mode 100644 index 000000000..86f9cb7a1 --- /dev/null +++ b/stdlib/source/library/lux/control/remember.lux @@ -0,0 +1,74 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io] + ["." try] + ["." exception (#+ exception:)] + ["<>" parser ("#\." functor) + ["" code (#+ Parser)]]] + [data + ["." text + ["%" format (#+ format)]]] + [time + ["." instant] + ["." date (#+ Date) ("#\." order)]] + ["." meta] + [macro + ["." code] + [syntax (#+ syntax:)]]]]) + +(exception: #export (must_remember {deadline Date} {today Date} {message Text} {focus (Maybe Code)}) + (exception.report + ["Deadline" (%.date deadline)] + ["Today" (%.date today)] + ["Message" message] + ["Code" (case focus + (#.Some focus) + (%.code focus) + + #.None + "")])) + +(def: deadline + (Parser Date) + ($_ <>.either + (<>\map (|>> instant.from_millis instant.date) + .int) + (do <>.monad + [raw .text] + (case (\ date.codec decode raw) + (#try.Success date) + (wrap date) + + (#try.Failure message) + (<>.fail message))))) + +(syntax: #export (remember {deadline ..deadline} {message .text} {focus (<>.maybe .any)}) + (let [now (io.run instant.now) + today (instant.date now)] + (if (date\< deadline today) + (wrap (case focus + (#.Some focus) + (list focus) + + #.None + (list))) + (meta.fail (exception.construct ..must_remember [deadline today message focus]))))) + +(template [ ] + [(syntax: #export ( {deadline ..deadline} {message .text} {focus (<>.maybe .any)}) + (wrap (list (` (..remember (~ (code.text (%.date deadline))) + (~ (code.text (format " " message))) + (~+ (case focus + (#.Some focus) + (list focus) + + #.None + (list))))))))] + + [to_do "TODO"] + [fix_me "FIXME"] + ) diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux new file mode 100644 index 000000000..13ae40d15 --- /dev/null +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -0,0 +1,71 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["" code]] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]]] + [type + abstract] + ["." meta] + ["." macro + ["." code] + [syntax (#+ syntax:) + ["|.|" export] + ["|.|" declaration] + ["|.|" annotations]]]]]) + +(abstract: #export (Capability brand input output) + (-> input output) + + {#.doc (doc "Represents the capability to perform an operation." + "This operation is assumed to have security implications.")} + + (def: forge + (All [brand input output] + (-> (-> input output) + (Capability brand input output))) + (|>> :abstraction)) + + (def: #export (use capability input) + (All [brand input output] + (-> (Capability brand input output) + input + output)) + ((:representation capability) input)) + + (syntax: #export (capability: {export |export|.parser} + {declaration |declaration|.parser} + {annotations (<>.maybe |annotations|.parser)} + {[forge input output] (.form ($_ <>.and .local_identifier .any .any))}) + (do {! meta.monad} + [this_module meta.current_module_name + #let [[name vars] declaration] + g!brand (\ ! map (|>> %.code code.text) + (macro.gensym (format (%.name [this_module name])))) + #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] + (wrap (list (` (type: (~+ (|export|.format export)) + (~ (|declaration|.format declaration)) + (~ capability))) + (` (def: (~ (code.local_identifier forge)) + (All [(~+ (list\map code.local_identifier vars))] + (-> (-> (~ input) (~ output)) + (~ capability))) + (~! ..forge))) + )))) + + (def: #export (async capability) + (All [brand input output] + (-> (Capability brand input (IO output)) + (Capability brand input (Promise output)))) + (..forge (|>> ((:representation capability)) promise.future))) + ) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux new file mode 100644 index 000000000..3c1eb579e --- /dev/null +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -0,0 +1,93 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad)]] + [type + abstract]]]) + +(abstract: #export (Policy brand value label) + value + + (type: #export (Can_Upgrade brand label value) + {#.doc (doc "Represents the capacity to 'upgrade' a value.")} + (-> value (Policy brand value label))) + + (type: #export (Can_Downgrade brand label value) + {#.doc (doc "Represents the capacity to 'downgrade' a value.")} + (-> (Policy brand value label) value)) + + (type: #export (Privilege brand label) + {#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")} + {#can_upgrade (Can_Upgrade brand label) + #can_downgrade (Can_Downgrade brand label)}) + + (def: privilege + Privilege + {#can_upgrade (|>> :abstraction) + #can_downgrade (|>> :representation)}) + + (type: #export (Delegation brand from to) + {#.doc (doc "Represents the act of delegating policy capacities.")} + (All [value] + (-> (Policy brand value from) + (Policy brand value to)))) + + (def: #export (delegation downgrade upgrade) + {#.doc (doc "Delegating policy capacities.")} + (All [brand from to] + (-> (Can_Downgrade brand from) (Can_Upgrade brand to) + (Delegation brand from to))) + (|>> downgrade upgrade)) + + (type: #export (Context brand scope label) + {#.doc (doc "A computational context with an associated policy privilege.")} + (-> (Privilege brand label) + (scope label))) + + (def: #export (with_policy context) + (All [brand scope] + (Ex [label] + (-> (Context brand scope label) + (scope label)))) + (context ..privilege)) + + (def: (decorate constructor) + (-> Type Type) + (type (All [brand label] (constructor (All [value] (Policy brand value label)))))) + + (implementation: #export functor + (:~ (decorate Functor)) + + (def: (map f fa) + (|> fa :representation f :abstraction))) + + (implementation: #export apply + (:~ (decorate Apply)) + + (def: &functor ..functor) + (def: (apply ff fa) + (:abstraction ((:representation ff) (:representation fa))))) + + (implementation: #export monad + (:~ (decorate Monad)) + + (def: &functor ..functor) + (def: wrap (|>> :abstraction)) + (def: join (|>> :representation))) + ) + +(template [ ] + [(abstract: #export + Any + + (type: #export (Policy )) + (type: #export (Can_Upgrade )) + (type: #export (Can_Downgrade )) + )] + + [Privacy Private Can_Conceal Can_Reveal] + [Safety Safe Can_Trust Can_Distrust] + ) diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux new file mode 100644 index 000000000..ef0e2dbb7 --- /dev/null +++ b/stdlib/source/library/lux/control/state.lux @@ -0,0 +1,149 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)]]]]) + +(type: #export (State s a) + {#.doc "Stateful computations."} + (-> s [s a])) + +(def: #export get + {#.doc "Read the current state."} + (All [s] (State s s)) + (function (_ state) + [state state])) + +(def: #export (put new-state) + {#.doc "Set the new state."} + (All [s] (-> s (State s Any))) + (function (_ state) + [new-state []])) + +(def: #export (update change) + {#.doc "Compute the new state."} + (All [s] (-> (-> s s) (State s Any))) + (function (_ state) + [(change state) []])) + +(def: #export (use user) + {#.doc "Run function on current state."} + (All [s a] (-> (-> s a) (State s a))) + (function (_ 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))) + (function (_ state) + (let [[state' output] (action (change state))] + [state output]))) + +(def: #export (run state action) + {#.doc "Run a stateful computation."} + (All [s a] (-> s (State s a) [s a])) + (action state)) + +(implementation: #export functor + (All [s] (Functor (State s))) + + (def: (map f ma) + (function (_ state) + (let [[state' a] (ma state)] + [state' (f a)])))) + +(implementation: #export apply + (All [s] (Apply (State s))) + + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ state) + (let [[state' f] (ff state) + [state'' a] (fa state')] + [state'' (f a)])))) + +(implementation: #export monad + (All [s] (Monad (State s))) + + (def: &functor ..functor) + + (def: (wrap a) + (function (_ state) + [state a])) + + (def: (join mma) + (function (_ state) + (let [[state' ma] (mma state)] + (ma state'))))) + +(def: #export (while condition body) + (All [s] (-> (State s Bit) (State s Any) (State s Any))) + (do {! ..monad} + [execute? condition] + (if execute? + (do ! + [_ body] + (while condition body)) + (wrap [])))) + +(def: #export (do-while condition body) + (All [s] (-> (State s Bit) (State s Any) (State s Any))) + (do ..monad + [_ body] + (while condition body))) + +(implementation: (with//functor functor) + (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) + + (def: (map f sfa) + (function (_ state) + (\ functor map (function (_ [s a]) [s (f a)]) + (sfa state))))) + +(implementation: (with//apply monad) + (All [M s] (-> (Monad M) (Apply (All [a] (-> s (M [s a])))))) + + (def: &functor (with//functor (\ monad &functor))) + + (def: (apply sFf sFa) + (function (_ state) + (do monad + [[state f] (sFf state) + [state a] (sFa state)] + (wrap [state (f a)]))))) + +(type: #export (State' M s a) + {#.doc "Stateful computations decorated by a monad."} + (-> s (M [s a]))) + +(def: #export (run' state action) + {#.doc "Run a stateful computation decorated by a monad."} + (All [M s a] (-> s (State' M s a) (M [s a]))) + (action state)) + +(implementation: #export (with monad) + {#.doc "A monad transformer to create composite stateful computations."} + (All [M s] (-> (Monad M) (Monad (State' M s)))) + + (def: &functor (with//functor (\ monad &functor))) + + (def: (wrap a) + (function (_ state) + (\ monad wrap [state a]))) + + (def: (join sMsMa) + (function (_ state) + (do monad + [[state' sMa] (sMsMa state)] + (sMa state'))))) + +(def: #export (lift monad ma) + {#.doc "Lift monadic values to the State' wrapper."} + (All [M s a] (-> (Monad M) (M a) (State' M s a))) + (function (_ state) + (do monad + [a ma] + (wrap [state a])))) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux new file mode 100644 index 000000000..818c38298 --- /dev/null +++ b/stdlib/source/library/lux/control/thread.lux @@ -0,0 +1,106 @@ +(.module: + [library + [lux #* + ["@" target] + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)]] + [control + ["." io (#+ IO)]] + [data + [collection + ["." array (#+ Array)]]] + [type + abstract]]]) + +(type: #export (Thread ! a) + (-> ! a)) + +(abstract: #export (Box t v) + (Array v) + + {#.doc "A mutable box holding a value."} + + (def: #export (box init) + (All [a] (-> a (All [!] (Thread ! (Box ! a))))) + (function (_ !) + (|> (array.new 1) + (array.write! 0 init) + :abstraction))) + + (def: #export (read box) + (All [! a] (-> (Box ! a) (Thread ! a))) + (function (_ !) + (for {@.old + ("jvm aaload" (:representation box) 0) + + @.jvm + ("jvm array read object" + (|> 0 + (:as (primitive "java.lang.Long")) + "jvm object cast" + "jvm conversion long-to-int") + (:representation box)) + + @.js ("js array read" 0 (:representation box)) + @.python ("python array read" 0 (:representation box)) + @.lua ("lua array read" 0 (:representation box)) + @.ruby ("ruby array read" 0 (:representation box)) + @.php ("php array read" 0 (:representation box)) + @.scheme ("scheme array read" 0 (:representation box))}))) + + (def: #export (write value box) + (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any))))) + (function (_ !) + (|> box :representation (array.write! 0 value) :abstraction))) + ) + +(def: #export (run thread) + (All [a] + (-> (All [!] (Thread ! a)) + a)) + (thread [])) + +(def: #export io + (All [a] + (-> (All [!] (Thread ! a)) + (IO a))) + (|>> ..run io.io)) + +(implementation: #export functor + (All [!] (Functor (Thread !))) + + (def: (map f) + (function (_ fa) + (function (_ !) + (f (fa !)))))) + +(implementation: #export apply + (All [!] (Apply (Thread !))) + + (def: &functor ..functor) + + (def: (apply ff fa) + (function (_ !) + ((ff !) (fa !))))) + +(implementation: #export monad + (All [!] (Monad (Thread !))) + + (def: &functor ..functor) + + (def: (wrap value) + (function (_ !) + value)) + + (def: (join ffa) + (function (_ !) + ((ffa !) !)))) + +(def: #export (update f box) + (All [a] (-> (-> a a) (All [!] (-> (Box ! a) (Thread ! a))))) + (do ..monad + [old (read box) + _ (write (f old) box)] + (wrap old))) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux new file mode 100644 index 000000000..013553b04 --- /dev/null +++ b/stdlib/source/library/lux/control/try.lux @@ -0,0 +1,153 @@ +(.module: + [library + [lux #* + [abstract + [apply (#+ Apply)] + [equivalence (#+ Equivalence)] + ["." functor (#+ Functor)] + ["." monad (#+ Monad do)]] + [meta + ["." location]]]]) + +(type: #export (Try a) + (#Failure Text) + (#Success a)) + +(implementation: #export functor + (Functor Try) + + (def: (map f ma) + (case ma + (#Failure msg) + (#Failure msg) + + (#Success datum) + (#Success (f datum))))) + +(implementation: #export apply + (Apply Try) + + (def: &functor ..functor) + + (def: (apply ff fa) + (case ff + (#Success f) + (case fa + (#Success a) + (#Success (f a)) + + (#Failure msg) + (#Failure msg)) + + (#Failure msg) + (#Failure msg)) + )) + +(implementation: #export monad + (Monad Try) + + (def: &functor ..functor) + + (def: (wrap a) + (#Success a)) + + (def: (join mma) + (case mma + (#Failure msg) + (#Failure msg) + + (#Success ma) + ma))) + +(implementation: #export (with monad) + ## TODO: Replace (All [a] (M (Try a))) with (functor.Then M Try) + (All [M] (-> (Monad M) (Monad (All [a] (M (Try a)))))) + + (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) + + (def: wrap (|>> (\ ..monad wrap) (\ monad wrap))) + + (def: (join MeMea) + (do monad + [eMea MeMea] + (case eMea + (#Failure try) + (wrap (#Failure try)) + + (#Success Mea) + Mea)))) + +(def: #export (lift monad) + (All [M a] (-> (Monad M) (-> (M a) (M (Try a))))) + (\ monad map (\ ..monad wrap))) + +(implementation: #export (equivalence (^open "_\.")) + (All [a] (-> (Equivalence a) (Equivalence (Try a)))) + + (def: (= reference sample) + (case [reference sample] + [(#Success reference) (#Success sample)] + (_\= reference sample) + + [(#Failure reference) (#Failure sample)] + ("lux text =" reference sample) + + _ + false + ))) + +(def: #export (succeed value) + (All [a] (-> a (Try a))) + (#Success value)) + +(def: #export (fail message) + (-> Text Try) + (#Failure message)) + +(def: #export (assume try) + (All [a] (-> (Try a) a)) + (case try + (#Success value) + value + + (#Failure message) + (error! message))) + +(def: #export (to_maybe try) + (All [a] (-> (Try a) (Maybe a))) + (case try + (#Success value) + (#.Some value) + + (#Failure message) + #.None)) + +(def: #export (from_maybe maybe) + (All [a] (-> (Maybe a) (Try a))) + (case maybe + (#.Some value) + (#Success value) + + #.None + (#Failure (`` (("lux in-module" (~~ (static .prelude_module)) .name\encode) + (name_of ..from_maybe)))))) + +(macro: #export (default tokens compiler) + {#.doc (doc "Allows you to provide a default value that will be used" + "if a (Try x) value turns out to be #Failure." + "Note: the expression for the default value will not be computed if the base computation succeeds." + (= "bar" + (default "foo" (#..Success "bar"))) + (= "foo" + (default "foo" (#..Failure "KABOOM!"))))} + (case tokens + (^ (list else try)) + (#Success [compiler (list (` (case (~ try) + (#..Success (~' g!temp)) + (~' g!temp) + + (#..Failure (~ [location.dummy (#.Identifier ["" ""])])) + (~ else))))]) + + _ + (#Failure "Wrong syntax for default"))) diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux new file mode 100644 index 000000000..2ddf343df --- /dev/null +++ b/stdlib/source/library/lux/control/writer.lux @@ -0,0 +1,78 @@ +(.module: + [library + [lux #* + ["@" target] + [abstract + monoid + [apply (#+ Apply)] + ["." functor (#+ Functor)] + ["." monad (#+ Monad do)]]]]) + +(type: #export (Writer l a) + {#.doc "Represents a value with an associated 'log' value to record arbitrary information."} + {#log l + #value a}) + +(def: #export (write l) + {#.doc "Set the log to a particular value."} + (All [l] (-> l (Writer l Any))) + [l []]) + +(implementation: #export functor + (All [l] + (Functor (Writer l))) + + (def: (map f fa) + (let [[log datum] fa] + [log (f datum)]))) + +(implementation: #export (apply monoid) + (All [l] + (-> (Monoid l) (Apply (Writer l)))) + + (def: &functor ..functor) + + (def: (apply ff fa) + (let [[log1 f] ff + [log2 a] fa] + [(\ monoid compose log1 log2) (f a)]))) + +(implementation: #export (monad monoid) + (All [l] + (-> (Monoid l) (Monad (Writer l)))) + + (def: &functor ..functor) + + (def: wrap + (|>> [(\ monoid identity)])) + + (def: (join mma) + (let [[log1 [log2 a]] mma] + [(\ monoid compose log1 log2) a]))) + +(implementation: #export (with monoid monad) + (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) + + (def: &functor + (functor.compose (get@ #monad.&functor monad) + ..functor)) + + (def: wrap + (let [writer (..monad monoid)] + (|>> (\ writer wrap) (\ monad wrap)))) + + (def: (join MlMla) + (do monad + [[l1 Mla] (for {@.old + (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2))))) + MlMla)} + ## On new compiler + MlMla) + [l2 a] Mla] + (wrap [(\ monoid compose l1 l2) a])))) + +(def: #export (lift monoid monad) + (All [l M a] + (-> (Monoid l) (Monad M) + (-> (M a) (M (Writer l a))))) + (\ monad map (|>> [(\ monoid identity)]))) diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux new file mode 100644 index 000000000..11bc86754 --- /dev/null +++ b/stdlib/source/library/lux/data/binary.lux @@ -0,0 +1,367 @@ +(.module: + [library + [lux (#- i64) + ["@" target] + ["." ffi] + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)] + [monoid (#+ Monoid)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." maybe] + [text + ["%" format (#+ format)]] + [collection + ["." array]]] + [math + [number (#+ hex) + ["n" nat] + ["f" frac] + ["." i64]]]]]) + +(exception: #export (index_out_of_bounds {size Nat} {index Nat}) + (exception.report + ["Size" (%.nat size)] + ["Index" (%.nat index)])) + +(exception: #export (slice_out_of_bounds {size Nat} {offset Nat} {length Nat}) + (exception.report + ["Size" (%.nat size)] + ["Offset" (%.nat offset)] + ["Length" (%.nat length)])) + +(with_expansions [ (as_is (type: #export Binary (ffi.type [byte])) + + (ffi.import: java/lang/Object) + + (ffi.import: java/lang/System + ["#::." + (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void)]) + + (ffi.import: java/util/Arrays + ["#::." + (#static copyOfRange [[byte] int int] [byte]) + (#static equals [[byte] [byte]] boolean)]) + + (def: byte_mask + I64 + (|> i64.bits_per_byte i64.mask .i64)) + + (def: i64 + (-> (primitive "java.lang.Byte") I64) + (|>> ffi.byte_to_long (:as I64) (i64.and ..byte_mask))) + + (def: byte + (-> (I64 Any) (primitive "java.lang.Byte")) + (for {@.old + (|>> .int ffi.long_to_byte) + + @.jvm + (|>> .int (:as (primitive "java.lang.Long")) ffi.long_to_byte)})))] + (for {@.old (as_is ) + @.jvm (as_is ) + + @.js + (as_is (ffi.import: ArrayBuffer + ["#::." + (new [ffi.Number])]) + + (ffi.import: Uint8Array + ["#::." + (new [ArrayBuffer]) + (length ffi.Number)]) + + (type: #export Binary + Uint8Array)) + + @.python + (type: #export Binary + (primitive "bytearray")) + + @.scheme + (as_is (type: #export Binary + (primitive "bytevector")) + + (ffi.import: (make-bytevector [Nat] Binary)) + (ffi.import: (bytevector-u8-ref [Binary Nat] I64)) + (ffi.import: (bytevector-u8-set! [Binary Nat (I64 Any)] Any)) + (ffi.import: (bytevector-length [Binary] Nat)))} + + ## Default + (type: #export Binary + (array.Array (I64 Any))))) + +(template: (!size binary) + (for {@.old (ffi.array_length binary) + @.jvm (ffi.array_length binary) + + @.js + (|> binary + Uint8Array::length + f.nat) + + @.python + (|> binary + (:as (array.Array (I64 Any))) + "python array length") + + @.scheme + (..bytevector-length [binary])} + + ## Default + (array.size binary))) + +(template: (!read idx binary) + (for {@.old (..i64 (ffi.array_read idx binary)) + @.jvm (..i64 (ffi.array_read idx binary)) + + @.js + (|> binary + (: ..Binary) + (:as (array.Array .Frac)) + ("js array read" idx) + f.nat + .i64) + + @.python + (|> binary + (:as (array.Array .I64)) + ("python array read" idx)) + + @.scheme + (..bytevector-u8-ref [binary idx])} + + ## Default + (|> binary + (array.read idx) + (maybe.default (: (I64 Any) 0)) + (:as I64)))) + +(template: (!!write idx value binary) + (|> binary + (: ..Binary) + (:as (array.Array )) + ( idx (|> value .nat (n.% (hex "100")) )) + (:as ..Binary))) + +(template: (!write idx value binary) + (for {@.old (ffi.array_write idx (..byte value) binary) + @.jvm (ffi.array_write idx (..byte value) binary) + + @.js (!!write .Frac n.frac "js array write" idx value binary) + @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" idx value binary) + @.scheme (exec (..bytevector-u8-set! [binary idx value]) + binary)} + + ## Default + (array.write! idx (|> value .nat (n.% (hex "100"))) binary))) + +(def: #export size + (-> Binary Nat) + (|>> !size)) + +(def: #export create + (-> Nat Binary) + (for {@.old (|>> (ffi.array byte)) + @.jvm (|>> (ffi.array byte)) + + @.js + (|>> n.frac ArrayBuffer::new Uint8Array::new) + + @.python + (|>> ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as Binary)) + + @.scheme + (|>> ..make-bytevector)} + + ## Default + array.new)) + +(def: #export (fold f init binary) + (All [a] (-> (-> I64 a a) a Binary a)) + (let [size (..!size binary)] + (loop [idx 0 + output init] + (if (n.< size idx) + (recur (inc idx) (f (!read idx binary) output)) + output)))) + +(def: #export (read/8 idx binary) + (-> Nat Binary (Try I64)) + (if (n.< (..!size binary) idx) + (#try.Success (!read idx binary)) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (read/16 idx binary) + (-> Nat Binary (Try I64)) + (if (n.< (..!size binary) (n.+ 1 idx)) + (#try.Success ($_ i64.or + (i64.left_shift 8 (!read idx binary)) + (!read (n.+ 1 idx) binary))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (read/32 idx binary) + (-> Nat Binary (Try I64)) + (if (n.< (..!size binary) (n.+ 3 idx)) + (#try.Success ($_ i64.or + (i64.left_shift 24 (!read idx binary)) + (i64.left_shift 16 (!read (n.+ 1 idx) binary)) + (i64.left_shift 8 (!read (n.+ 2 idx) binary)) + (!read (n.+ 3 idx) binary))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (read/64 idx binary) + (-> Nat Binary (Try I64)) + (if (n.< (..!size binary) (n.+ 7 idx)) + (#try.Success ($_ i64.or + (i64.left_shift 56 (!read idx binary)) + (i64.left_shift 48 (!read (n.+ 1 idx) binary)) + (i64.left_shift 40 (!read (n.+ 2 idx) binary)) + (i64.left_shift 32 (!read (n.+ 3 idx) binary)) + (i64.left_shift 24 (!read (n.+ 4 idx) binary)) + (i64.left_shift 16 (!read (n.+ 5 idx) binary)) + (i64.left_shift 8 (!read (n.+ 6 idx) binary)) + (!read (n.+ 7 idx) binary))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (write/8 idx value binary) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (..!size binary) idx) + (#try.Success (|> binary + (!write idx value))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (write/16 idx value binary) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (..!size binary) (n.+ 1 idx)) + (#try.Success (|> binary + (!write idx (i64.right_shift 8 value)) + (!write (n.+ 1 idx) value))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (write/32 idx value binary) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (..!size binary) (n.+ 3 idx)) + (#try.Success (|> binary + (!write idx (i64.right_shift 24 value)) + (!write (n.+ 1 idx) (i64.right_shift 16 value)) + (!write (n.+ 2 idx) (i64.right_shift 8 value)) + (!write (n.+ 3 idx) value))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(def: #export (write/64 idx value binary) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (..!size binary) (n.+ 7 idx)) + (for {@.scheme (let [write_high (|>> (!write idx (i64.right_shift 56 value)) + (!write (n.+ 1 idx) (i64.right_shift 48 value)) + (!write (n.+ 2 idx) (i64.right_shift 40 value)) + (!write (n.+ 3 idx) (i64.right_shift 32 value))) + write_low (|>> (!write (n.+ 4 idx) (i64.right_shift 24 value)) + (!write (n.+ 5 idx) (i64.right_shift 16 value)) + (!write (n.+ 6 idx) (i64.right_shift 8 value)) + (!write (n.+ 7 idx) value))] + (|> binary write_high write_low #try.Success))} + (#try.Success (|> binary + (!write idx (i64.right_shift 56 value)) + (!write (n.+ 1 idx) (i64.right_shift 48 value)) + (!write (n.+ 2 idx) (i64.right_shift 40 value)) + (!write (n.+ 3 idx) (i64.right_shift 32 value)) + (!write (n.+ 4 idx) (i64.right_shift 24 value)) + (!write (n.+ 5 idx) (i64.right_shift 16 value)) + (!write (n.+ 6 idx) (i64.right_shift 8 value)) + (!write (n.+ 7 idx) value)))) + (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + +(implementation: #export equivalence + (Equivalence Binary) + + (def: (= reference sample) + (with_expansions [ (java/util/Arrays::equals reference sample)] + (for {@.old + @.jvm } + (let [limit (!size reference)] + (and (n.= limit + (!size sample)) + (loop [idx 0] + (if (n.< limit idx) + (and (n.= (!read idx reference) + (!read idx sample)) + (recur (inc idx))) + true)))))))) + +(for {@.old (as_is) + @.jvm (as_is)} + + ## Default + (exception: #export (cannot_copy_bytes {bytes Nat} + {source_input Nat} + {target_output Nat}) + (exception.report + ["Bytes" (%.nat bytes)] + ["Source input space" (%.nat source_input)] + ["Target output space" (%.nat target_output)]))) + +(def: #export (copy bytes source_offset source target_offset target) + (-> Nat Nat Binary Nat Binary (Try Binary)) + (with_expansions [ (as_is (do try.monad + [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] + (wrap target)))] + (for {@.old + @.jvm } + + ## Default + (let [source_input (n.- source_offset (!size source)) + target_output (n.- target_offset (!size target))] + (if (n.<= source_input bytes) + (loop [idx 0] + (if (n.< bytes idx) + (exec (!write (n.+ target_offset idx) + (!read (n.+ source_offset idx) source) + target) + (recur (inc idx))) + (#try.Success target))) + (exception.throw ..cannot_copy_bytes [bytes source_input target_output])))))) + +(def: #export (slice offset length binary) + (-> Nat Nat Binary (Try Binary)) + (let [size (..!size binary) + limit (n.+ length offset)] + (if (n.<= size limit) + (with_expansions [ (as_is (#try.Success (java/util/Arrays::copyOfRange binary (.int offset) (.int limit))))] + (for {@.old + @.jvm } + + ## Default + (..copy length offset binary 0 (..create length)))) + (exception.throw ..slice_out_of_bounds [size offset length])))) + +(def: #export (drop offset binary) + (-> Nat Binary Binary) + (case offset + 0 binary + _ (let [distance (n.- offset (..!size binary))] + (case (..slice offset distance binary) + (#try.Success slice) + slice + + (#try.Failure _) + (..create 0))))) + +(implementation: #export monoid + (Monoid Binary) + + (def: identity + (..create 0)) + + (def: (compose left right) + (let [sizeL (!size left) + sizeR (!size right) + output (..create (n.+ sizeL sizeR))] + (exec + (..copy sizeL 0 left 0 output) + (..copy sizeR 0 right sizeL output) + output)))) diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux new file mode 100644 index 000000000..5a62ecce5 --- /dev/null +++ b/stdlib/source/library/lux/data/bit.lux @@ -0,0 +1,59 @@ +(.module: + [library + [lux #* + [abstract + [monoid (#+ Monoid)] + [equivalence (#+ Equivalence)] + hash + [codec (#+ Codec)]] + [control + ["." function]]]]) + +(implementation: #export equivalence + (Equivalence Bit) + + (def: (= x y) + (if x + y + (not y)))) + +(implementation: #export hash + (Hash Bit) + + (def: &equivalence ..equivalence) + + (def: (hash value) + (case value + #0 2 + #1 3))) + +(template [ ] + [(implementation: #export + (Monoid Bit) + + (def: identity ) + (def: (compose x y) ( x y)))] + + [disjunction #0 or] + [conjunction #1 and] + ) + +(implementation: #export codec + (Codec Text Bit) + + (def: (encode x) + (if x + "#1" + "#0")) + + (def: (decode input) + (case input + "#1" (#.Right #1) + "#0" (#.Right #0) + _ (#.Left "Wrong syntax for Bit.")))) + +(def: #export complement + {#.doc (doc "Generates the complement of a predicate." + "That is a predicate that returns the oposite of the original predicate.")} + (All [a] (-> (-> a Bit) (-> a Bit))) + (function.compose not)) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux new file mode 100644 index 000000000..66a3abb6e --- /dev/null +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -0,0 +1,388 @@ +(.module: + [library + [lux #* + ["@" target] + [abstract + [monoid (#+ Monoid)] + [functor (#+ Functor)] + [equivalence (#+ Equivalence)] + [fold (#+ Fold)] + [predicate (#+ Predicate)]] + [data + ["." product] + ["." maybe] + [collection + ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]]]]) + +(def: #export type_name + "#Array") + +(type: #export (Array a) + {#.doc "Mutable arrays."} + (#.Primitive ..type_name (#.Cons a #.Nil))) + +(with_expansions [ (primitive "java.lang.Long") + (primitive "java.lang.Object") + (type (Array ))] + (for {@.jvm + (template: (!int value) + (|> value + (:as ) + "jvm object cast" + "jvm conversion long-to-int"))} + (as_is)) + + (def: #export (new size) + (All [a] (-> Nat (Array a))) + (for {@.old + (:assume ("jvm anewarray" "(java.lang.Object )" size)) + + @.jvm + (|> size + !int + "jvm array new object" + (: ) + :assume) + + @.js ("js array new" size) + @.python ("python array new" size) + @.lua ("lua array new" size) + @.ruby ("ruby array new" size) + @.php ("php array new" size) + @.scheme ("scheme array new" size)})) + + (def: #export (size array) + (All [a] (-> (Array a) Nat)) + (for {@.old + ("jvm arraylength" array) + + @.jvm + (|> array + (:as ) + "jvm array length object" + "jvm conversion int-to-long" + "jvm object cast" + (: ) + (:as Nat)) + + @.js ("js array length" array) + @.python ("python array length" array) + @.lua ("lua array length" array) + @.ruby ("ruby array length" array) + @.php ("php array length" array) + @.scheme ("scheme array length" array)})) + + (template: (!read ) + (let [output ( index array)] + (if ( output) + #.None + (#.Some output)))) + + (def: #export (read index array) + (All [a] + (-> Nat (Array a) (Maybe a))) + (if (n.< (size array) index) + (for {@.old + (let [value ("jvm aaload" array index)] + (if ("jvm object null?" value) + #.None + (#.Some value))) + + @.jvm + (let [value (|> array + (:as ) + ("jvm array read object" (!int index)))] + (if ("jvm object null?" value) + #.None + (#.Some (:assume value)))) + + @.js (!read "js array read" "js object undefined?") + @.python (!read "python array read" "python object none?") + @.lua (!read "lua array read" "lua object nil?") + @.ruby (!read "ruby array read" "ruby object nil?") + @.php (!read "php array read" "php object null?") + @.scheme (!read "scheme array read" "scheme object nil?")}) + #.None)) + + (def: #export (write! index value array) + (All [a] + (-> Nat a (Array a) (Array a))) + (for {@.old + ("jvm aastore" array index value) + + @.jvm + (|> array + (:as ) + ("jvm array write object" (!int index) (:as value)) + :assume) + + @.js ("js array write" index value array) + @.python ("python array write" index value array) + @.lua ("lua array write" index value array) + @.ruby ("ruby array write" index value array) + @.php ("php array write" index value array) + @.scheme ("scheme array write" index value array)})) + + (def: #export (delete! index array) + (All [a] + (-> Nat (Array a) (Array a))) + (if (n.< (size array) index) + (for {@.old + (write! index (:assume ("jvm object null")) array) + + @.jvm + (write! index (:assume (: ("jvm object null"))) array) + + @.js ("js array delete" index array) + @.python ("python array delete" index array) + @.lua ("lua array delete" index array) + @.ruby ("ruby array delete" index array) + @.php ("php array delete" index array) + @.scheme ("scheme array delete" index array)}) + array)) + ) + +(def: #export (contains? index array) + (All [a] + (-> Nat (Array a) Bit)) + (case (..read index array) + (#.Some _) + true + + _ + false)) + +(def: #export (update! index transform array) + (All [a] + (-> Nat (-> a a) (Array a) (Array a))) + (case (read index array) + #.None + array + + (#.Some value) + (write! index (transform value) array))) + +(def: #export (upsert! index default transform array) + (All [a] + (-> Nat a (-> a a) (Array a) (Array a))) + (write! index + (|> array (read index) (maybe.default default) transform) + array)) + +(def: #export (copy! length src_start src_array dest_start dest_array) + (All [a] + (-> Nat Nat (Array a) Nat (Array a) + (Array a))) + (if (n.= 0 length) + dest_array + (list\fold (function (_ offset target) + (case (read (n.+ offset src_start) src_array) + #.None + target + + (#.Some value) + (write! (n.+ offset dest_start) value target))) + dest_array + (list.indices length)))) + +(def: #export (occupancy array) + {#.doc "Finds out how many cells in an array are occupied."} + (All [a] (-> (Array a) Nat)) + (list\fold (function (_ idx count) + (case (read idx array) + #.None + count + + (#.Some _) + (inc count))) + 0 + (list.indices (size array)))) + +(def: #export (vacancy array) + {#.doc "Finds out how many cells in an array are vacant."} + (All [a] (-> (Array a) Nat)) + (n.- (..occupancy array) (..size array))) + +(def: #export (filter! p xs) + (All [a] + (-> (Predicate a) (Array a) (Array a))) + (list\fold (function (_ idx xs') + (case (read idx xs) + #.None + xs' + + (#.Some x) + (if (p x) + xs' + (delete! idx xs')))) + xs + (list.indices (size xs)))) + +(def: #export (find p xs) + (All [a] + (-> (Predicate a) (Array a) (Maybe a))) + (let [arr_size (size xs)] + (loop [idx 0] + (if (n.< arr_size idx) + (case (read 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 Bit) (Array a) (Maybe [Nat a]))) + (let [arr_size (size xs)] + (loop [idx 0] + (if (n.< arr_size idx) + (case (read 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 (function (_ idx ys) + (case (read idx xs) + #.None + ys + + (#.Some x) + (write! 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 (function (_ x [idx arr]) + [(inc idx) (write! idx x arr)]) + [0 (new (list.size xs))] + xs))) + +(def: underflow Nat (dec 0)) + +(def: #export (to_list array) + (All [a] (-> (Array a) (List a))) + (loop [idx (dec (size array)) + output #.Nil] + (if (n.= ..underflow idx) + output + (recur (dec idx) + (case (read idx array) + (#.Some head) + (#.Cons head output) + + #.None + output))))) + +(def: #export (to_list' default array) + (All [a] (-> a (Array a) (List a))) + (loop [idx (dec (size array)) + output #.Nil] + (if (n.= ..underflow idx) + output + (recur (dec idx) + (#.Cons (maybe.default default (read idx array)) + output))))) + +(implementation: #export (equivalence (^open ",\.")) + (All [a] (-> (Equivalence a) (Equivalence (Array a)))) + + (def: (= xs ys) + (let [sxs (size xs) + sxy (size ys)] + (and (n.= sxy sxs) + (list\fold (function (_ idx prev) + (and prev + (case [(read idx xs) (read idx ys)] + [#.None #.None] + true + + [(#.Some x) (#.Some y)] + (,\= x y) + + _ + false))) + true + (list.indices sxs)))))) + +(implementation: #export monoid + (All [a] (Monoid (Array a))) + + (def: identity (new 0)) + + (def: (compose xs ys) + (let [sxs (size xs) + sxy (size ys)] + (|> (new (n.+ sxy sxs)) + (copy! sxs 0 xs 0) + (copy! sxy 0 ys sxs))))) + +(implementation: #export functor + (Functor Array) + + (def: (map f ma) + (let [arr_size (size ma)] + (if (n.= 0 arr_size) + (new arr_size) + (list\fold (function (_ idx mb) + (case (read idx ma) + #.None + mb + + (#.Some x) + (write! idx (f x) mb))) + (new arr_size) + (list.indices arr_size)) + )))) + +(implementation: #export fold + (Fold Array) + + (def: (fold f init xs) + (let [arr_size (size xs)] + (loop [so_far init + idx 0] + (if (n.< arr_size idx) + (case (read idx xs) + #.None + (recur so_far (inc idx)) + + (#.Some value) + (recur (f value so_far) (inc idx))) + so_far))))) + +(template [ ] + [(def: #export ( predicate array) + (All [a] + (-> (Predicate a) (Predicate (Array a)))) + (let [size (..size array)] + (loop [idx 0] + (if (n.< size idx) + (case (..read idx array) + (#.Some value) + ( (predicate value) + (recur (inc idx))) + + #.None + (recur (inc idx))) + ))))] + + [every? true and] + [any? false or] + ) diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux new file mode 100644 index 000000000..63e90f7c8 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -0,0 +1,177 @@ +(.module: + [library + [lux (#- not and or) + [abstract + [equivalence (#+ Equivalence)]] + [control + pipe] + [data + ["." maybe] + [collection + ["." array (#+ Array) ("#\." fold)]]] + [math + [number + ["n" nat] + ["." i64]]]]]) + +(type: #export Chunk + I64) + +(def: #export chunk-size + i64.width) + +(type: #export Bits + (Array Chunk)) + +(def: empty-chunk + Chunk + (.i64 0)) + +(def: #export empty + Bits + (array.new 0)) + +(def: #export (size bits) + (-> Bits Nat) + (array\fold (function (_ chunk total) + (|> chunk i64.count (n.+ total))) + 0 + bits)) + +(def: #export (capacity bits) + (-> Bits Nat) + (|> bits array.size (n.* chunk-size))) + +(def: #export empty? + (-> Bits Bit) + (|>> size (n.= 0))) + +(def: #export (get index bits) + (-> Nat Bits Bit) + (let [[chunk-index bit-index] (n./% chunk-size index)] + (.and (n.< (array.size bits) chunk-index) + (|> (array.read chunk-index bits) + (maybe.default empty-chunk) + (i64.set? bit-index))))) + +(def: (chunk idx bits) + (-> Nat Bits Chunk) + (if (n.< (array.size bits) idx) + (|> bits (array.read idx) (maybe.default empty-chunk)) + empty-chunk)) + +(template [ ] + [(def: #export ( index input) + (-> Nat Bits Bits) + (let [[chunk-index bit-index] (n./% chunk-size index)] + (loop [size|output (n.max (inc chunk-index) + (array.size input)) + output ..empty] + (let [idx|output (dec size|output)] + (if (n.> 0 size|output) + (case (|> (..chunk idx|output input) + (cond> [(new> (n.= chunk-index idx|output) [])] + [( bit-index)] + + ## else + []) + .nat) + 0 + ## TODO: Remove 'no-op' once new-luxc is the official compiler. + (let [no-op (recur (dec size|output) output)] + no-op) + + chunk + (|> (if (is? ..empty output) + (: Bits (array.new size|output)) + output) + (array.write! idx|output (.i64 chunk)) + (recur (dec size|output)))) + output)))))] + + [set i64.set] + [clear i64.clear] + [flip i64.flip] + ) + +(def: #export (intersects? reference sample) + (-> Bits Bits Bit) + (let [chunks (n.min (array.size reference) + (array.size sample))] + (loop [idx 0] + (if (n.< chunks idx) + (.or (|> (..chunk idx sample) + (i64.and (..chunk idx reference)) + ("lux i64 =" empty-chunk) + .not) + (recur (inc idx))) + #0)))) + +(def: #export (not input) + (-> Bits Bits) + (case (array.size input) + 0 + ..empty + + size|output + (loop [size|output size|output + output ..empty] + (let [idx (dec size|output)] + (case (|> input (..chunk idx) i64.not .nat) + 0 + (recur (dec size|output) output) + + chunk + (if (n.> 0 size|output) + (|> (if (is? ..empty output) + (: Bits (array.new size|output)) + output) + (array.write! idx (.i64 chunk)) + (recur (dec size|output))) + output)))))) + +(template [ ] + [(def: #export ( param subject) + (-> Bits Bits Bits) + (case (n.max (array.size param) + (array.size subject)) + 0 + ..empty + + size|output + (loop [size|output size|output + output ..empty] + (let [idx (dec size|output)] + (if (n.> 0 size|output) + (case (|> (..chunk idx subject) + ( (..chunk idx param)) + .nat) + 0 + (recur (dec size|output) output) + + chunk + (|> (if (is? ..empty output) + (: Bits (array.new size|output)) + output) + (array.write! idx (.i64 chunk)) + (recur (dec size|output)))) + output)))))] + + [and i64.and] + [or i64.or] + [xor i64.xor] + ) + +(implementation: #export equivalence + (Equivalence Bits) + + (def: (= reference sample) + (let [size (n.max (array.size reference) + (array.size sample))] + (loop [idx 0] + (if (n.< size idx) + (.and ("lux i64 =" + (..chunk idx reference) + (..chunk idx sample)) + (recur (inc idx))) + #1))))) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux new file mode 100644 index 000000000..3ae286db8 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -0,0 +1,732 @@ +(.module: + [library + [lux #* + [abstract + [hash (#+ Hash)] + [equivalence (#+ Equivalence)] + [functor (#+ Functor)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." maybe] + ["." product] + [collection + ["." list ("#\." fold functor monoid)] + ["." array (#+ Array) ("#\." functor fold)]]] + [math + ["." number + ["n" nat] + ["." i64]]]]]) + +## 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. + +## 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 its 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 +## Dictionaries. +(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 + (i64.left_shift (n.- 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 + (i64.left_shift (n.- 1 branching_exponent) 1)) + +## The size of hierarchy-nodes, which is 2^(branching-exponent). +(def: hierarchy_nodes_size + Nat + (i64.left_shift 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.new (inc old_size)) + (array.copy! idx 0 old_array 0) + (array.write! idx value) + (array.copy! (n.- 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.write! 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.delete! 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! (n.- idx new_size) (inc idx) array idx)))) + +## Increases the level-shift by the branching-exponent, to explore +## levels further down the tree. +(def: level_up + (-> Level Level) + (n.+ 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) + (i64.and ..hierarchy_mask + (i64.right_shift level hash))) + +## A mechanism to go from indices to bit-positions. +(def: (->bit_position index) + (-> Index BitPosition) + (i64.left_shift 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 Bit) + (|> bitmap + (i64.and bit) + (n.= clean_bitmap) + not)) + +## Figures out whether a bitmap only contains a single bit-position. +(def: only_bit_position? + (-> BitPosition BitMap Bit) + n.=) + +(def: (set_bit_position bit bitmap) + (-> BitPosition BitMap BitMap) + (i64.or bit bitmap)) + +(def: unset_bit_position + (-> BitPosition BitMap BitMap) + i64.xor) + +## Figures out the size of a bitmap-indexed array by counting all the +## 1s within the bitmap. +(def: bitmap_size + (-> BitMap Nat) + i64.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 its bit-position. +(def: (base_index bit_position bitmap) + (-> BitPosition BitMap Index) + (bitmap_size (i64.and (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))) + (\ maybe.monad map product.left + (array.find+ (function (_ 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)])) + (product.right (list\fold (function (_ idx [insertion_idx node]) + (let [[bitmap base] node] + (case (array.read idx h_array) + #.None [insertion_idx node] + (#.Some sub_node) (if (n.= except_idx idx) + [insertion_idx node] + [(inc insertion_idx) + [(set_bit_position (->bit_position idx) bitmap) + (array.write! insertion_idx (#.Left sub_node) base)]]) + ))) + [0 [clean_bitmap + (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 its balance. +(def: hierarchy_indices (List Index) (list.indices hierarchy_nodes_size)) + +(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 (function (_ hierarchy_idx (^@ default [base_idx h_array])) + (if (bit_position_is_set? (->bit_position hierarchy_idx) + bitmap) + [(inc base_idx) + (case (array.read base_idx base) + (#.Some (#.Left sub_node)) + (array.write! hierarchy_idx sub_node h_array) + + (#.Some (#.Right [key' val'])) + (array.write! hierarchy_idx + (put' (level_up level) (\ Hash hash key') key' val' Hash empty) + h_array) + + #.None + (undefined))] + default)) + [0 + (array.new hierarchy_nodes_size)] + hierarchy_indices))) + +## 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) Bit)) + (`` (case node + (#Base (~~ (static ..clean_bitmap)) _) + #1 + + _ + #0))) + +(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, check whether one can add the element to + ## a sub-node. If impossible, introduce a new singleton sub-node. + (#Hierarchy _size hierarchy) + (let [idx (level_index level hash) + [_size' sub_node] (case (array.read 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, 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.read idx base) + ## If it's being used by a node, 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, compare the keys. + (#.Some (#.Right key' val')) + (if (\ Hash = key key') + ## If the same key is found, replace the value. + (#Base bitmap (update! idx (#.Right key val) base)) + ## Otherwise, compare the hashes of the keys. + (#Base bitmap (update! idx + (#.Left (let [hash' (\ Hash hash key')] + (if (n.= hash hash') + ## If the hashes are + ## the same, a new + ## #Collisions node + ## is added. + (#Collisions hash (|> (array.new 2) + (array.write! 0 [key' val']) + (array.write! 1 [key val]))) + ## Otherwise, one can + ## just keep using + ## #Base nodes, so + ## 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))) + + #.None + (undefined))) + ## However, if the BitPosition has not been used yet, check + ## whether this #Base node is ready for a promotion. + (let [base_count (bitmap_size bitmap)] + (if (n.>= ..promotion_threshold base_count) + ## If so, 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.write! (level_index level hash) + (put' (level_up level) hash key val Hash empty)))) + ## Otherwise, 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, compare the hashes. + (#Collisions _hash _colls) + (if (n.= 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, its + ## 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, create a new #Base node that + ## contains the old #Collisions node, plus the new KV-pair. + (|> (#Base (bit_position level _hash) + (|> (array.new 1) + (array.write! 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.read 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 (is? 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 (n.<= 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.read idx base) + ## 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 (is? 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 did not 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) + + #.None + (undefined))) + ## 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 (n.= 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.read (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.read (base_index bit bitmap) base) + (#.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 + (undefined)) + #.None)) + + ## For #Collisions nodes, do a linear scan of all the known KV-pairs. + (#Collisions _hash _colls) + (\ maybe.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 n.+ 0 (array\map size' hierarchy)) + + (#Base _ base) + (array\fold n.+ 0 (array\map (function (_ 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 (function (_ sub_node tail) (list\compose (entries' sub_node) tail)) + #.Nil + hierarchy) + + (#Base bitmap base) + (array\fold (function (_ branch tail) + (case branch + (#.Left sub_node) + (list\compose (entries' sub_node) tail) + + (#.Right [key' val']) + (#.Cons [key' val'] tail))) + #.Nil + base) + + (#Collisions hash colls) + (array\fold (function (_ [key' val'] tail) (#.Cons [key' val'] tail)) + #.Nil + colls))) + +(type: #export (Dictionary k v) + {#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} + {#hash (Hash k) + #root (Node k v)}) + +(def: #export key_hash + (All [k v] (-> (Dictionary k v) (Hash k))) + (get@ #..hash)) + +(def: #export (new Hash) + (All [k v] (-> (Hash k) (Dictionary k v))) + {#hash Hash + #root empty}) + +(def: #export (put key val dict) + (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) + (let [[Hash node] dict] + [Hash (put' root_level (\ Hash hash key) key val Hash node)])) + +(def: #export (remove key dict) + (All [k v] (-> k (Dictionary k v) (Dictionary k v))) + (let [[Hash node] dict] + [Hash (remove' root_level (\ Hash hash key) key Hash node)])) + +(def: #export (get key dict) + (All [k v] (-> k (Dictionary k v) (Maybe v))) + (let [[Hash node] dict] + (get' root_level (\ Hash hash key) key Hash node))) + +(def: #export (key? dict key) + (All [k v] (-> (Dictionary k v) k Bit)) + (case (get key dict) + #.None #0 + (#.Some _) #1)) + +(exception: #export key_already_exists) + +(def: #export (try_put key val dict) + {#.doc "Only puts the KV-pair if the key is not already present."} + (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) + (case (get key dict) + #.None (#try.Success (put key val dict)) + (#.Some _) (exception.throw ..key_already_exists []))) + +(def: #export (update key f dict) + {#.doc "Transforms the value located at key (if available), using the given function."} + (All [k v] (-> k (-> v v) (Dictionary k v) (Dictionary k v))) + (case (get key dict) + #.None + dict + + (#.Some val) + (put key (f val) dict))) + +(def: #export (upsert key default f dict) + {#.doc (doc "Updates the value at the key; if it exists." + "Otherwise, puts a value by applying the function to a default.")} + (All [k v] (-> k v (-> v v) (Dictionary k v) (Dictionary k v))) + (..put key + (f (maybe.default default + (..get key dict))) + dict)) + +(def: #export size + (All [k v] (-> (Dictionary k v) Nat)) + (|>> product.right ..size')) + +(def: #export empty? + (All [k v] (-> (Dictionary k v) Bit)) + (|>> size (n.= 0))) + +(def: #export (entries dict) + (All [k v] (-> (Dictionary k v) (List [k v]))) + (entries' (product.right dict))) + +(def: #export (from_list Hash kvs) + (All [k v] (-> (Hash k) (List [k v]) (Dictionary k v))) + (list\fold (function (_ [k v] dict) + (put k v dict)) + (new Hash) + kvs)) + +(template [ ] + [(def: #export ( dict) + (All [k v] (-> (Dictionary k v) (List ))) + (|> dict entries (list\map )))] + + [keys k product.left] + [values v product.right] + ) + +(def: #export (merge dict2 dict1) + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, the values of dict2 will overwrite those of dict1.")} + (All [k v] (-> (Dictionary k v) (Dictionary k v) (Dictionary k v))) + (list\fold (function (_ [key val] dict) (put key val dict)) + dict1 + (entries dict2))) + +(def: #export (merge_with f dict2 dict1) + {#.doc (doc "Merges 2 dictionaries." + "If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1.")} + (All [k v] (-> (-> v v v) (Dictionary k v) (Dictionary k v) (Dictionary k v))) + (list\fold (function (_ [key val2] dict) + (case (get key dict) + #.None + (put key val2 dict) + + (#.Some val1) + (put key (f val2 val1) dict))) + dict1 + (entries dict2))) + +(def: #export (re_bind from_key to_key dict) + (All [k v] (-> k k (Dictionary k v) (Dictionary k v))) + (case (get from_key dict) + #.None + dict + + (#.Some val) + (|> dict + (remove from_key) + (put to_key val)))) + +(def: #export (select keys dict) + {#.doc "Creates a sub-set of the given dict, with only the specified keys."} + (All [k v] (-> (List k) (Dictionary k v) (Dictionary k v))) + (let [[Hash _] dict] + (list\fold (function (_ key new_dict) + (case (get key dict) + #.None new_dict + (#.Some val) (put key val new_dict))) + (new Hash) + keys))) + +(implementation: #export (equivalence (^open ",\.")) + (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v)))) + + (def: (= reference subject) + (and (n.= (..size reference) + (..size subject)) + (list.every? (function (_ [k rv]) + (case (..get k subject) + (#.Some sv) + (,\= rv sv) + + _ + #0)) + (..entries reference))))) + +(implementation: functor' + (All [k] (Functor (Node k))) + + (def: (map f fa) + (case fa + (#Hierarchy size hierarchy) + (#Hierarchy size (array\map (map f) hierarchy)) + + (#Base bitmap base) + (#Base bitmap (array\map (function (_ either) + (case either + (#.Left fa') + (#.Left (map f fa')) + + (#.Right [k v]) + (#.Right [k (f v)]))) + base)) + + (#Collisions hash collisions) + (#Collisions hash (array\map (function (_ [k v]) + [k (f v)]) + collisions))))) + +(implementation: #export functor + (All [k] (Functor (Dictionary k))) + + (def: (map f fa) + (update@ #root (\ ..functor' map f) fa))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux new file mode 100644 index 000000000..5c8b82ebd --- /dev/null +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -0,0 +1,584 @@ +(.module: + [library + [lux #* + [abstract + equivalence + [monad (#+ Monad do)] + ["." order (#+ Order)]] + [data + ["p" product] + ["." maybe] + [collection + ["." list ("#\." monoid fold)]]] + [macro + ["." code]] + [math + [number + ["n" nat]]]]]) + +(def: error_message + "Invariant violation") + +(type: Color + #Red + #Black) + +(type: (Node k v) + {#color Color + #key k + #value v + #left (Maybe (Node k v)) + #right (Maybe (Node k v))}) + +(template [ ] + [(def: ( key value left right) + (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) + {#color + #key key + #value value + #left left + #right right})] + + [red #Red] + [black #Black] + ) + +(type: #export (Dictionary k v) + {#&order (Order k) + #root (Maybe (Node k v))}) + +(def: #export (new order) + (All [k v] (-> (Order k) (Dictionary k v))) + {#&order order + #root #.None}) + +## TODO: Doing inneficient access of Order functions due to compiler bug. +## TODO: Must improve it as soon as bug is fixed. +(def: #export (get key dict) + (All [k v] (-> k (Dictionary k v) (Maybe v))) + (let [## (^open "_\.") (get@ #&order dict) + ] + (loop [node (get@ #root dict)] + (case node + #.None + #.None + + (#.Some node) + (let [node_key (get@ #key node)] + (cond (\ dict = node_key key) + ## (_\= node_key key) + (#.Some (get@ #value node)) + + (\ dict < node_key key) + ## (_\< node_key key) + (recur (get@ #left node)) + + ## (_\> (get@ #key node) key) + (recur (get@ #right node)))) + )))) + +## TODO: Doing inneficient access of Order functions due to compiler bug. +## TODO: Must improve it as soon as bug is fixed. +(def: #export (key? dict key) + (All [k v] (-> (Dictionary k v) k Bit)) + (let [## (^open "_\.") (get@ #&order dict) + ] + (loop [node (get@ #root dict)] + (case node + #.None + #0 + + (#.Some node) + (let [node_key (get@ #key node)] + (or (\ dict = node_key key) + ## (_\= node_key key) + (if (\ dict < node_key key) + ## (_\< node_key key) + (recur (get@ #left node)) + (recur (get@ #right node))))))))) + +(template [ ] + [(def: #export ( dict) + (All [k v] (-> (Dictionary k v) (Maybe v))) + (case (get@ #root dict) + #.None + #.None + + (#.Some node) + (loop [node node] + (case (get@ node) + #.None + (#.Some (get@ #value node)) + + (#.Some side) + (recur side)))))] + + [min #left] + [max #right] + ) + +(def: #export (size dict) + (All [k v] (-> (Dictionary k v) Nat)) + (loop [node (get@ #root dict)] + (case node + #.None + 0 + + (#.Some node) + (inc (n.+ (recur (get@ #left node)) + (recur (get@ #right node))))))) + +(def: #export empty? + (All [k v] (-> (Dictionary k v) Bit)) + (|>> ..size (n.= 0))) + +(template [ ] + [(def: ( self) + (All [k v] (-> (Node k v) (Node k v))) + (case (get@ #color self) + + (set@ #color self) + + + + ))] + + [blacken #Red #Black self] + [redden #Black #Red (error! error_message)] + ) + +(def: (balance_left_add parent self) + (All [k v] (-> (Node k v) (Node k v) (Node k v))) + (with_expansions + [ (as_is (black (get@ #key parent) + (get@ #value parent) + (#.Some self) + (get@ #right parent)))] + (case (get@ #color self) + #Red + (case (get@ #left self) + (^multi (#.Some left) + [(get@ #color left) #Red]) + (red (get@ #key self) + (get@ #value self) + (#.Some (blacken left)) + (#.Some (black (get@ #key parent) + (get@ #value parent) + (get@ #right self) + (get@ #right parent)))) + + _ + (case (get@ #right self) + (^multi (#.Some right) + [(get@ #color right) #Red]) + (red (get@ #key right) + (get@ #value right) + (#.Some (black (get@ #key self) + (get@ #value self) + (get@ #left self) + (get@ #left right))) + (#.Some (black (get@ #key parent) + (get@ #value parent) + (get@ #right right) + (get@ #right parent)))) + + _ + )) + + #Black + + ))) + +(def: (balance_right_add parent self) + (All [k v] (-> (Node k v) (Node k v) (Node k v))) + (with_expansions + [ (as_is (black (get@ #key parent) + (get@ #value parent) + (get@ #left parent) + (#.Some self)))] + (case (get@ #color self) + #Red + (case (get@ #right self) + (^multi (#.Some right) + [(get@ #color right) #Red]) + (red (get@ #key self) + (get@ #value self) + (#.Some (black (get@ #key parent) + (get@ #value parent) + (get@ #left parent) + (get@ #left self))) + (#.Some (blacken right))) + + _ + (case (get@ #left self) + (^multi (#.Some left) + [(get@ #color left) #Red]) + (red (get@ #key left) + (get@ #value left) + (#.Some (black (get@ #key parent) + (get@ #value parent) + (get@ #left parent) + (get@ #left left))) + (#.Some (black (get@ #key self) + (get@ #value self) + (get@ #right left) + (get@ #right self)))) + + _ + )) + + #Black + + ))) + +(def: (add_left addition center) + (All [k v] (-> (Node k v) (Node k v) (Node k v))) + (case (get@ #color center) + #Red + (red (get@ #key center) (get@ #value center) (#.Some addition) (get@ #right center)) + + #Black + (balance_left_add center addition) + )) + +(def: (add_right addition center) + (All [k v] (-> (Node k v) (Node k v) (Node k v))) + (case (get@ #color center) + #Red + (red (get@ #key center) (get@ #value center) (get@ #left center) (#.Some addition)) + + #Black + (balance_right_add center addition) + )) + +(def: #export (put key value dict) + (All [k v] (-> k v (Dictionary k v) (Dictionary k v))) + (let [(^open "_\.") (get@ #&order dict) + root' (loop [?root (get@ #root dict)] + (case ?root + #.None + (#.Some (red key value #.None #.None)) + + (#.Some root) + (let [reference (get@ #key root)] + (`` (cond (~~ (template [ ] + [( reference key) + (let [side_root (get@ root) + outcome (recur side_root)] + (if (is? side_root outcome) + ?root + (#.Some ( (maybe.assume outcome) + root))))] + + [_\< #left add_left] + [(order.> (get@ #&order dict)) #right add_right] + )) + + ## (_\= reference key) + (#.Some (set@ #value value root)) + ))) + ))] + (set@ #root root' dict))) + +(def: (left_balance key value ?left ?right) + (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) + (case ?left + (^multi (#.Some left) + [(get@ #color left) #Red] + [(get@ #left left) (#.Some left>>left)] + [(get@ #color left>>left) #Red]) + (red (get@ #key left) + (get@ #value left) + (#.Some (blacken left>>left)) + (#.Some (black key value (get@ #right left) ?right))) + + (^multi (#.Some left) + [(get@ #color left) #Red] + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Red]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (black (get@ #key left) + (get@ #value left) + (get@ #left left) + (get@ #left left>>right))) + (#.Some (black key value + (get@ #right left>>right) + ?right))) + + _ + (black key value ?left ?right))) + +(def: (right_balance key value ?left ?right) + (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) + (case ?right + (^multi (#.Some right) + [(get@ #color right) #Red] + [(get@ #right right) (#.Some right>>right)] + [(get@ #color right>>right) #Red]) + (red (get@ #key right) + (get@ #value right) + (#.Some (black key value ?left (get@ #left right))) + (#.Some (blacken right>>right))) + + (^multi (#.Some right) + [(get@ #color right) #Red] + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Red]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (black (get@ #key right) + (get@ #value right) + (get@ #right right>>left) + (get@ #right right)))) + + _ + (black key value ?left ?right))) + +(def: (balance_left_remove key value ?left ?right) + (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) + (case ?left + (^multi (#.Some left) + [(get@ #color left) #Red]) + (red key value (#.Some (blacken left)) ?right) + + _ + (case ?right + (^multi (#.Some right) + [(get@ #color right) #Black]) + (right_balance key value ?left (#.Some (redden right))) + + (^multi (#.Some right) + [(get@ #color right) #Red] + [(get@ #left right) (#.Some right>>left)] + [(get@ #color right>>left) #Black]) + (red (get@ #key right>>left) + (get@ #value right>>left) + (#.Some (black key value ?left (get@ #left right>>left))) + (#.Some (right_balance (get@ #key right) + (get@ #value right) + (get@ #right right>>left) + (\ maybe.functor map redden (get@ #right right))))) + + _ + (error! error_message)) + )) + +(def: (balance_right_remove key value ?left ?right) + (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v))) + (case ?right + (^multi (#.Some right) + [(get@ #color right) #Red]) + (red key value ?left (#.Some (blacken right))) + + _ + (case ?left + (^multi (#.Some left) + [(get@ #color left) #Black]) + (left_balance key value (#.Some (redden left)) ?right) + + (^multi (#.Some left) + [(get@ #color left) #Red] + [(get@ #right left) (#.Some left>>right)] + [(get@ #color left>>right) #Black]) + (red (get@ #key left>>right) + (get@ #value left>>right) + (#.Some (left_balance (get@ #key left) + (get@ #value left) + (\ maybe.functor map redden (get@ #left left)) + (get@ #left left>>right))) + (#.Some (black key value (get@ #right left>>right) ?right))) + + _ + (error! error_message) + ))) + +(def: (prepend ?left ?right) + (All [k v] (-> (Maybe (Node k v)) (Maybe (Node k v)) (Maybe (Node k v)))) + (case [?left ?right] + [#.None _] + ?right + + [_ #.None] + ?left + + [(#.Some left) (#.Some right)] + (case [(get@ #color left) (get@ #color right)] + [#Red #Red] + (do maybe.monad + [fused (prepend (get@ #right left) (get@ #right right))] + (case (get@ #color fused) + #Red + (wrap (red (get@ #key fused) + (get@ #value fused) + (#.Some (red (get@ #key left) + (get@ #value left) + (get@ #left left) + (get@ #left fused))) + (#.Some (red (get@ #key right) + (get@ #value right) + (get@ #right fused) + (get@ #right right))))) + + #Black + (wrap (red (get@ #key left) + (get@ #value left) + (get@ #left left) + (#.Some (red (get@ #key right) + (get@ #value right) + (#.Some fused) + (get@ #right right))))))) + + [#Red #Black] + (#.Some (red (get@ #key left) + (get@ #value left) + (get@ #left left) + (prepend (get@ #right left) + ?right))) + + [#Black #Red] + (#.Some (red (get@ #key right) + (get@ #value right) + (prepend ?left + (get@ #left right)) + (get@ #right right))) + + [#Black #Black] + (do maybe.monad + [fused (prepend (get@ #right left) (get@ #left right))] + (case (get@ #color fused) + #Red + (wrap (red (get@ #key fused) + (get@ #value fused) + (#.Some (black (get@ #key left) + (get@ #value left) + (get@ #left left) + (get@ #left fused))) + (#.Some (black (get@ #key right) + (get@ #value right) + (get@ #right fused) + (get@ #right right))))) + + #Black + (wrap (balance_left_remove (get@ #key left) + (get@ #value left) + (get@ #left left) + (#.Some (black (get@ #key right) + (get@ #value right) + (#.Some fused) + (get@ #right right))))) + )) + ) + + _ + (undefined))) + +(def: #export (remove key dict) + (All [k v] (-> k (Dictionary k v) (Dictionary k v))) + (let [(^open "_\.") (get@ #&order dict) + [?root found?] (loop [?root (get@ #root dict)] + (case ?root + #.None + [#.None #0] + + (#.Some root) + (let [root_key (get@ #key root) + root_val (get@ #value root)] + (if (_\= root_key key) + [(prepend (get@ #left root) + (get@ #right root)) + #1] + (let [go_left? (_\< root_key key)] + (case (recur (if go_left? + (get@ #left root) + (get@ #right root))) + [#.None #0] + [#.None #0] + + [side_outcome _] + (if go_left? + (case (get@ #left root) + (^multi (#.Some left) + [(get@ #color left) #Black]) + [(#.Some (balance_left_remove root_key root_val side_outcome (get@ #right root))) + #0] + + _ + [(#.Some (red root_key root_val side_outcome (get@ #right root))) + #0]) + (case (get@ #right root) + (^multi (#.Some right) + [(get@ #color right) #Black]) + [(#.Some (balance_right_remove root_key root_val (get@ #left root) side_outcome)) + #0] + + _ + [(#.Some (red root_key root_val (get@ #left root) side_outcome)) + #0]) + ))) + )) + ))] + (case ?root + #.None + (if found? + (set@ #root ?root dict) + dict) + + (#.Some root) + (set@ #root (#.Some (blacken root)) dict) + ))) + +(def: #export (update key transform dict) + (All [k v] (-> k (-> v v) (Dictionary k v) (Dictionary k v))) + (case (..get key dict) + (#.Some old) + (..put key (transform old) dict) + + #.None + dict)) + +(def: #export (from_list Order list) + (All [k v] (-> (Order k) (List [k v]) (Dictionary k v))) + (list\fold (function (_ [key value] dict) + (put key value dict)) + (new Order) + list)) + +(template [ ] + [(def: #export ( dict) + (All [k v] (-> (Dictionary k v) (List ))) + (loop [node (get@ #root dict)] + (case node + #.None + (list) + + (#.Some node') + ($_ list\compose + (recur (get@ #left node')) + (list ) + (recur (get@ #right node'))))))] + + [entries [k v] [(get@ #key node') (get@ #value node')]] + [keys k (get@ #key node')] + [values v (get@ #value node')] + ) + +(implementation: #export (equivalence (^open ",\.")) + (All [k v] (-> (Equivalence v) (Equivalence (Dictionary k v)))) + + (def: (= reference sample) + (let [(^open "/\.") (get@ #&order reference)] + (loop [entriesR (entries reference) + entriesS (entries sample)] + (case [entriesR entriesS] + [#.Nil #.Nil] + #1 + + [(#.Cons [keyR valueR] entriesR') (#.Cons [keyS valueS] entriesS')] + (and (/\= keyR keyS) + (,\= valueR valueS) + (recur entriesR' entriesS')) + + _ + #0))))) diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux new file mode 100644 index 000000000..f3f51c779 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/dictionary/plist.lux @@ -0,0 +1,98 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)]] + [data + ["." product] + ["." text ("#\." equivalence)] + [collection + ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]]]]) + +(type: #export (PList a) + (List [Text a])) + +(def: #export empty + PList + #.Nil) + +(def: #export size + (All [a] (-> (PList a) Nat)) + list.size) + +(def: #export empty? + (All [a] (-> (PList a) Bit)) + (|>> ..size (n.= 0))) + +(def: #export (get key properties) + (All [a] (-> Text (PList a) (Maybe a))) + (case properties + #.Nil + #.None + + (#.Cons [k' v'] properties') + (if (text\= key k') + (#.Some v') + (get key properties')))) + +(template [ ] + [(def: #export + (All [a] (-> (PList a) (List ))) + (list\map ))] + + [keys Text product.left] + [values a product.right] + ) + +(def: #export (contains? key properties) + (All [a] (-> Text (PList a) Bit)) + (case (..get key properties) + (#.Some _) + true + + #.None + false)) + +(def: #export (put key val properties) + (All [a] (-> Text a (PList a) (PList a))) + (case properties + #.Nil + (list [key val]) + + (#.Cons [k' v'] properties') + (if (text\= key k') + (#.Cons [key val] + properties') + (#.Cons [k' v'] + (put key val properties'))))) + +(def: #export (update key f properties) + (All [a] (-> Text (-> a a) (PList a) (PList a))) + (case properties + #.Nil + #.Nil + + (#.Cons [k' v'] properties') + (if (text\= key k') + (#.Cons [k' (f v')] properties') + (#.Cons [k' v'] (update key f properties'))))) + +(def: #export (remove key properties) + (All [a] (-> Text (PList a) (PList a))) + (case properties + #.Nil + properties + + (#.Cons [k' v'] properties') + (if (text\= key k') + properties' + (#.Cons [k' v'] + (remove key properties'))))) + +(def: #export equivalence + (All [a] (-> (Equivalence a) (Equivalence (PList a)))) + (|>> (product.equivalence text.equivalence) + list.equivalence)) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux new file mode 100644 index 000000000..166b4c87b --- /dev/null +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -0,0 +1,616 @@ +(.module: + [library + [lux #* + ["@" target] + [abstract + [monoid (#+ Monoid)] + [apply (#+ Apply)] + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] + [fold (#+ Fold)] + [predicate (#+ Predicate)] + ["." functor (#+ Functor)] + ["." monad (#+ do Monad)] + ["." enum]] + [data + ["." bit] + ["." product]] + [math + [number + ["n" nat]]]]]) + +## (type: (List a) +## #Nil +## (#Cons a (List a))) + +(implementation: #export fold + (Fold List) + + (def: (fold f init xs) + (case xs + #.Nil + init + + (#.Cons x xs') + (fold f (f x init) xs')))) + +(def: #export (folds f init inputs) + (All [a b] (-> (-> a b b) b (List a) (List b))) + (case inputs + #.Nil + (list init) + + (#.Cons [head tail]) + (#.Cons [init (folds f (f head init) tail)]))) + +(def: #export (reverse xs) + (All [a] + (-> (List a) (List a))) + (fold (function (_ head tail) (#.Cons head tail)) + #.Nil + xs)) + +(def: #export (filter keep? xs) + (All [a] + (-> (Predicate a) (List a) (List a))) + (case xs + #.Nil + #.Nil + + (#.Cons x xs') + (if (keep? x) + (#.Cons x (filter keep? xs')) + (filter keep? xs')))) + +(def: #export (partition satisfies? list) + {#.doc "Divide the list into all elements that satisfy a predicate, and all elements that do not."} + (All [a] (-> (Predicate a) (List a) [(List a) (List a)])) + (case list + #.Nil + [#.Nil #.Nil] + + (#.Cons head tail) + (let [[in out] (partition satisfies? tail)] + (if (satisfies? head) + [(#.Cons head in) out] + [in (#.Cons head out)])))) + +(def: #export (as_pairs xs) + {#.doc (doc "Cut the list into pairs of 2." + "Caveat emptor: If the list has an uneven number of elements, the last one will be skipped.")} + (All [a] (-> (List a) (List [a a]))) + (case xs + (^ (list& x1 x2 xs')) + (#.Cons [x1 x2] (as_pairs xs')) + + _ + #.Nil)) + +(template [ ] + [(def: #export ( n xs) + (All [a] + (-> Nat (List a) (List a))) + (if (n.> 0 n) + (case xs + #.Nil + #.Nil + + (#.Cons x xs') + ) + ))] + + [take (#.Cons x (take (dec n) xs')) #.Nil] + [drop (drop (dec n) xs') xs] + ) + +(template [ ] + [(def: #export ( predicate xs) + (All [a] + (-> (Predicate a) (List a) (List a))) + (case xs + #.Nil + #.Nil + + (#.Cons x xs') + (if (predicate x) + + )))] + + [take_while (#.Cons x (take_while predicate xs')) #.Nil] + [drop_while (drop_while predicate xs') xs] + ) + +(def: #export (split n xs) + (All [a] + (-> Nat (List a) [(List a) (List a)])) + (if (n.> 0 n) + (case xs + #.Nil + [#.Nil #.Nil] + + (#.Cons x xs') + (let [[tail rest] (split (dec n) xs')] + [(#.Cons x tail) rest])) + [#.Nil xs])) + +(def: (split_with' predicate ys xs) + (All [a] + (-> (Predicate a) (List a) (List a) [(List a) (List a)])) + (case xs + #.Nil + [ys xs] + + (#.Cons x xs') + (if (predicate x) + (split_with' predicate (#.Cons x ys) xs') + [ys xs]))) + +(def: #export (split_with predicate xs) + {#.doc "Segment the list by using a predicate to tell when to cut."} + (All [a] + (-> (Predicate a) (List a) [(List a) (List a)])) + (let [[ys' xs'] (split_with' predicate #.Nil xs)] + [(reverse ys') xs'])) + +(def: #export (chunk n xs) + {#.doc "Segment the list in chunks of size N."} + (All [a] (-> Nat (List a) (List (List a)))) + (case xs + #.Nil + (list) + + _ + (let [[pre post] (split n xs)] + (#.Cons pre (chunk n post))))) + +(def: #export (repeat n x) + {#.doc "A list of the value x, repeated n times."} + (All [a] + (-> Nat a (List a))) + (if (n.> 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') + (#.Cons x (iterate' f x')) + + #.None + (list))) + +(def: #export (iterate f x) + {#.doc "Generates a list element by element until the function returns #.None."} + (All [a] + (-> (-> a (Maybe a)) a (List a))) + (case (f x) + (#.Some x') + (#.Cons x (iterate' f x')) + + #.None + (list x))) + +(def: #export (one check xs) + (All [a b] + (-> (-> a (Maybe b)) (List a) (Maybe b))) + (case xs + #.Nil + #.None + + (#.Cons x xs') + (case (check x) + (#.Some output) + (#.Some output) + + #.None + (one check xs')))) + +(def: #export (all check xs) + (All [a b] + (-> (-> a (Maybe b)) (List a) (List b))) + (for {## TODO: Stop relying on this ASAP. + @.js + (fold (function (_ head tail) + (case (check head) + (#.Some head) + (#.Cons head tail) + + #.None + tail)) + #.Nil + (reverse xs))} + (case xs + #.Nil + #.Nil + + (#.Cons x xs') + (case (check x) + (#.Some output) + (#.Cons output (all check xs')) + + #.None + (all check xs'))))) + +(def: #export (find predicate xs) + {#.doc "Returns the first value in the list for which the predicate is #1."} + (All [a] + (-> (Predicate a) (List a) (Maybe a))) + (..one (function (_ value) + (if (predicate value) + (#.Some value) + #.None)) + xs)) + +(def: #export (interpose sep xs) + {#.doc "Puts a value between every two elements in the list."} + (All [a] + (-> a (List a) (List a))) + (case xs + #.Nil + xs + + (#.Cons x #.Nil) + xs + + (#.Cons x xs') + (list& x sep (interpose sep xs')))) + +(def: #export (size list) + (All [a] (-> (List a) Nat)) + (fold (function (_ _ acc) (n.+ 1 acc)) 0 list)) + +(template [ ] + [(def: #export ( predicate xs) + (All [a] + (-> (Predicate a) (List a) Bit)) + (loop [xs xs] + (case xs + #.Nil + + + (#.Cons x xs') + (case (predicate x) + + (recur xs') + + output + output))))] + + [every? #1 and] + [any? #0 or] + ) + +(def: #export (nth i xs) + {#.doc "Fetches the element at the specified index."} + (All [a] + (-> Nat (List a) (Maybe a))) + (case xs + #.Nil + #.None + + (#.Cons x xs') + (if (n.= 0 i) + (#.Some x) + (nth (dec i) xs')))) + +(implementation: #export (equivalence Equivalence) + (All [a] (-> (Equivalence a) (Equivalence (List a)))) + + (def: (= xs ys) + (case [xs ys] + [#.Nil #.Nil] + #1 + + [(#.Cons x xs') (#.Cons y ys')] + (and (\ Equivalence = x y) + (= xs' ys')) + + [_ _] + #0 + ))) + +(implementation: #export (hash super) + (All [a] (-> (Hash a) (Hash (List a)))) + + (def: &equivalence + (..equivalence (\ super &equivalence))) + + (def: hash + (\ ..fold fold + (function (_ member hash) + (n.+ (\ super hash member) hash)) + 0))) + +(implementation: #export monoid + (All [a] (Monoid (List a))) + + (def: identity #.Nil) + (def: (compose xs ys) + (case xs + #.Nil + ys + + (#.Cons x xs') + (#.Cons x (compose xs' ys))))) + +(open: "." ..monoid) + +(implementation: #export functor + (Functor List) + + (def: (map f ma) + (case ma + #.Nil + #.Nil + + (#.Cons a ma') + (#.Cons (f a) (map f ma'))))) + +(open: "." ..functor) + +(implementation: #export apply + (Apply List) + + (def: &functor ..functor) + + (def: (apply ff fa) + (case ff + #.Nil + #.Nil + + (#.Cons f ff') + (compose (map f fa) (apply ff' fa))))) + +(implementation: #export monad + (Monad List) + + (def: &functor ..functor) + + (def: (wrap a) + (#.Cons a #.Nil)) + + (def: join (|>> reverse (fold compose identity)))) + +(def: #export (sort < xs) + (All [a] (-> (-> a a Bit) (List a) (List a))) + (case xs + #.Nil + (list) + + (#.Cons x xs') + (let [[pre post] (fold (function (_ x' [pre post]) + (if (< x x') + [(#.Cons x' pre) post] + [pre (#.Cons x' post)])) + [(list) (list)] + xs')] + ($_ compose (sort < pre) (list x) (sort < post))))) + +(def: #export (empty? xs) + (All [a] (Predicate (List a))) + (case xs + #.Nil + true + + _ + false)) + +(def: #export (member? eq xs x) + (All [a] (-> (Equivalence a) (List a) a Bit)) + (case xs + #.Nil + #0 + + (#.Cons x' xs') + (or (\ eq = x x') + (member? eq xs' x)))) + +(template [ ] + [(def: #export ( xs) + {#.doc } + (All [a] (-> (List a) (Maybe ))) + (case xs + #.Nil + #.None + + (#.Cons x xs') + (#.Some )))] + + [head a x "Returns the first element of a list."] + [tail (List a) xs' "For a list of size N, returns the N-1 elements after the first one."] + ) + +(def: #export (indices size) + {#.doc "Produces all the valid indices for a given size."} + (All [a] (-> Nat (List Nat))) + (if (n.= 0 size) + (list) + (|> size dec (enum.range n.enum 0)))) + +(def: (identifier$ name) + (-> Text Code) + [["" 0 0] (#.Identifier "" name)]) + +(def: (nat@encode value) + (-> Nat Text) + (loop [input value + output ""] + (let [digit (case (n.% 10 input) + 0 "0" + 1 "1" + 2 "2" + 3 "3" + 4 "4" + 5 "5" + 6 "6" + 7 "7" + 8 "8" + 9 "9" + _ (undefined)) + output' ("lux text concat" digit output) + input' (n./ 10 input)] + (if (n.= 0 input') + output' + (recur input' output'))))) + +(macro: #export (zip tokens state) + {#.doc (doc "Create list zippers with the specified number of input lists." + (def: #export zip/2 (zip 2)) + (def: #export zip/3 (zip 3)) + ((zip 3) xs ys zs))} + (case tokens + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) + (let [(^open ".") ..functor + indices (..indices num_lists) + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars)] + (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) + type_vars)) + (List [(~+ type_vars)])))) + vars+lists (|> indices + (map inc) + (map (function (_ idx) + (let [base (nat@encode idx)] + [(identifier$ base) + (identifier$ ("lux text concat" base "'"))])))) + pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) + vars+lists))]) + g!step (identifier$ "0step0") + g!blank (identifier$ "0,0") + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ 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 "Cannot zip 0 lists.")) + + _ + (#.Left "Wrong syntax for zip"))) + +(def: #export zip/2 (zip 2)) +(def: #export zip/3 (zip 3)) + +(macro: #export (zip_with tokens state) + {#.doc (doc "Create list zippers with the specified number of input lists." + (def: #export zip_with/2 (zip_with 2)) + (def: #export zip_with/3 (zip_with 3)) + ((zip_with 2) + xs ys))} + (case tokens + (^ (list [_ (#.Nat num_lists)])) + (if (n.> 0 num_lists) + (let [(^open ".") ..functor + indices (..indices num_lists) + g!return_type (identifier$ "0return_type0") + g!func (identifier$ "0func0") + type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) + zip_type (` (All [(~+ type_vars) (~ g!return_type)] + (-> (-> (~+ type_vars) (~ g!return_type)) + (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) + type_vars)) + (List (~ g!return_type))))) + vars+lists (|> indices + (map inc) + (map (function (_ idx) + (let [base (nat@encode idx)] + [(identifier$ base) + (identifier$ ("lux text concat" base "'"))])))) + pattern (` [(~+ (map (function (_ [v vs]) (` (#.Cons (~ v) (~ vs)))) + vars+lists))]) + g!step (identifier$ "0step0") + g!blank (identifier$ "0,0") + list_vars (map product.right vars+lists) + code (` (: (~ zip_type) + (function ((~ 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 "Cannot zip_with 0 lists.")) + + _ + (#.Left "Wrong syntax for zip_with"))) + +(def: #export zip_with/2 (zip_with 2)) +(def: #export zip_with/3 (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) + {#.doc (doc "For a list of size N, returns the first N-1 elements." + "Empty lists will result in a #.None value being returned instead.")} + (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)) + +(implementation: #export (with monad) + (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) + + (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) + + (def: wrap (|>> (\ ..monad wrap) (\ monad wrap))) + + (def: (join MlMla) + (do {! monad} + [lMla MlMla + ## TODO: Remove this version ASAP and use one below. + lla (for {@.old + (: (($ 0) (List (List ($ 1)))) + (monad.seq ! lMla))} + (monad.seq ! lMla))] + (wrap (concat lla))))) + +(def: #export (lift monad) + (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) + (\ monad map (\ ..monad wrap))) + +(def: #export (enumeration xs) + {#.doc "Pairs every element in the list with its index, starting at 0."} + (All [a] (-> (List a) (List [Nat a]))) + (loop [idx 0 + xs xs] + (case xs + #.Nil + #.Nil + + (#.Cons x xs') + (#.Cons [idx x] (recur (inc idx) xs'))))) diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux new file mode 100644 index 000000000..cb4d9106f --- /dev/null +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -0,0 +1,93 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [functor (#+ Functor)]] + [data + [collection + ["." list ("#\." monoid functor)]]] + [math + [number + ["n" nat]]]]]) + +(type: #export (Queue a) + {#front (List a) + #rear (List a)}) + +(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\compose 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] + (n.+ (list.size front) + (list.size rear)))) + +(def: #export empty? + (All [a] (-> (Queue a) Bit)) + (|>> (get@ #front) list.empty?)) + +(def: #export (member? equivalence queue member) + (All [a] (-> (Equivalence a) (Queue a) a Bit)) + (let [(^slots [#front #rear]) queue] + (or (list.member? equivalence front member) + (list.member? equivalence rear member)))) + +(def: #export (pop queue) + (All [a] (-> (Queue a) (Queue a))) + (case (get@ #front queue) + ## Empty... + (^ (list)) + queue + + ## Front has dried up... + (^ (list _)) + (|> queue + (set@ #front (list.reverse (get@ #rear queue))) + (set@ #rear (list))) + + ## Consume front! + (^ (list& _ front')) + (|> queue + (set@ #front front')))) + +(def: #export (push val queue) + (All [a] (-> a (Queue a) (Queue a))) + (case (get@ #front queue) + #.Nil + (set@ #front (list val) queue) + + _ + (update@ #rear (|>> (#.Cons val)) queue))) + +(implementation: #export (equivalence super) + (All [a] (-> (Equivalence a) (Equivalence (Queue a)))) + + (def: (= reference subject) + (\ (list.equivalence super) = + (..to_list reference) + (..to_list subject)))) + +(implementation: #export functor + (Functor Queue) + + (def: (map f fa) + {#front (|> fa (get@ #front) (list\map f)) + #rear (|> fa (get@ #rear) (list\map f))})) diff --git a/stdlib/source/library/lux/data/collection/queue/priority.lux b/stdlib/source/library/lux/data/collection/queue/priority.lux new file mode 100644 index 000000000..d044a5023 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -0,0 +1,121 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do Monad)]] + [data + ["." maybe] + [collection + ["." tree #_ + ["#" finger (#+ Tree)]]]] + [math + [number + ["n" nat ("#\." interval)]]] + [type (#+ :by_example) + [abstract (#+ abstract: :abstraction :representation)]]]]) + +(type: #export Priority + Nat) + +(def: #export max Priority n\top) +(def: #export min Priority n\bottom) + +(def: builder + (tree.builder n.maximum)) + +(def: :@: + (:by_example [@] + (tree.Builder @ Priority) + ..builder + + @)) + +(abstract: #export (Queue a) + (Maybe (Tree :@: Priority a)) + + (def: #export empty + Queue + (:abstraction #.None)) + + (def: #export (peek queue) + (All [a] (-> (Queue a) (Maybe a))) + (do maybe.monad + [tree (:representation queue)] + (tree.search (n.= (tree.tag tree)) + tree))) + + (def: #export (size queue) + (All [a] (-> (Queue a) Nat)) + (case (:representation queue) + #.None + 0 + + (#.Some tree) + (loop [node tree] + (case (tree.root node) + (0 #0 _) + 1 + + (0 #1 [left right]) + (n.+ (recur left) (recur right)))))) + + (def: #export (member? equivalence queue member) + (All [a] (-> (Equivalence a) (Queue a) a Bit)) + (case (:representation queue) + #.None + false + + (#.Some tree) + (loop [node tree] + (case (tree.root node) + (0 #0 reference) + (\ equivalence = reference member) + + (0 #1 [left right]) + (or (recur left) + (recur right)))))) + + (def: #export (pop queue) + (All [a] (-> (Queue a) (Queue a))) + (:abstraction + (do maybe.monad + [tree (:representation queue) + #let [highest_priority (tree.tag tree)]] + (loop [node tree] + (case (tree.root node) + (0 #0 reference) + (if (n.= highest_priority (tree.tag node)) + #.None + (#.Some node)) + + (0 #1 left right) + (if (n.= highest_priority (tree.tag left)) + (case (recur left) + #.None + (#.Some right) + + (#.Some =left) + (#.Some (\ ..builder branch =left right))) + (case (recur right) + #.None + (#.Some left) + + (#.Some =right) + (#.Some (\ ..builder branch left =right))))))))) + + (def: #export (push priority value queue) + (All [a] (-> Priority a (Queue a) (Queue a))) + (let [addition (\ ..builder leaf priority value)] + (:abstraction + (case (:representation queue) + #.None + (#.Some addition) + + (#.Some tree) + (#.Some (\ ..builder branch tree addition)))))) + ) + +(def: #export empty? + (All [a] (-> (Queue a) Bit)) + (|>> ..size (n.= 0))) diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux new file mode 100644 index 000000000..0bb304c35 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -0,0 +1,490 @@ +## https://hypirion.com/musings/understanding-persistent-vector-pt-1 +## https://hypirion.com/musings/understanding-persistent-vector-pt-2 +## https://hypirion.com/musings/understanding-persistent-vector-pt-3 +(.module: + [library + [lux #* + ["@" target] + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad do)] + [equivalence (#+ Equivalence)] + [monoid (#+ Monoid)] + [fold (#+ Fold)] + [predicate (#+ Predicate)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["p" parser + ["s" code (#+ Parser)]]] + [data + ["." maybe] + ["." product] + [collection + ["." list ("#\." fold functor monoid)] + ["." array (#+ Array) ("#\." functor fold)]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + [math + [number + ["." i64] + ["n" nat]]]]]) + +(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) + +(template [ ] + [(def: + (-> Level Level) + ( branching_exponent))] + + [level_up n.+] + [level_down n.-] + ) + +(def: full_node_size + Nat + (i64.left_shift branching_exponent 1)) + +(def: branch_idx_mask + Nat + (dec full_node_size)) + +(def: branch_idx + (-> Index Index) + (i64.and branch_idx_mask)) + +(def: (new_hierarchy _) + (All [a] (-> Any (Hierarchy a))) + (array.new full_node_size)) + +(def: (tail_off row_size) + (-> Nat Nat) + (if (n.< full_node_size row_size) + 0 + (|> (dec row_size) + (i64.right_shift branching_exponent) + (i64.left_shift branching_exponent)))) + +(def: (new_path level tail) + (All [a] (-> Level (Base a) (Node a))) + (if (n.= 0 level) + (#Base tail) + (|> (new_hierarchy []) + (array.write! 0 (new_path (level_down level) tail)) + #Hierarchy))) + +(def: (new_tail singleton) + (All [a] (-> a (Base a))) + (|> (array.new 1) + (array.write! 0 singleton))) + +(def: (push_tail size level tail parent) + (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) + (let [sub_idx (branch_idx (i64.right_shift level (dec size))) + ## If we're currently on a bottom node + sub_node (if (n.= branching_exponent level) + ## Just add the tail to it + (#Base tail) + ## Otherwise, check whether there's a vacant spot + (case (array.read 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.write! sub_idx sub_node)))) + +(def: (expand_tail val tail) + (All [a] (-> a (Base a) (Base a))) + (let [tail_size (array.size tail)] + (|> (array.new (inc tail_size)) + (array.copy! tail_size 0 tail 0) + (array.write! tail_size val)))) + +(def: (put' level idx val hierarchy) + (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a))) + (let [sub_idx (branch_idx (i64.right_shift level idx))] + (case (array.read sub_idx hierarchy) + (#.Some (#Hierarchy sub_node)) + (|> (array.clone hierarchy) + (array.write! sub_idx (#Hierarchy (put' (level_down level) idx val sub_node)))) + + (^multi (#.Some (#Base base)) + (n.= 0 (level_down level))) + (|> (array.clone hierarchy) + (array.write! sub_idx (|> (array.clone base) + (array.write! (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 (i64.right_shift level (n.- 2 size)))] + (cond (n.= 0 sub_idx) + #.None + + (n.> branching_exponent level) + (do maybe.monad + [base|hierarchy (array.read sub_idx hierarchy) + sub (case base|hierarchy + (#Hierarchy sub) + (pop_tail size (level_down level) sub) + + (#Base _) + (undefined))] + (|> (array.clone hierarchy) + (array.write! sub_idx (#Hierarchy sub)) + #.Some)) + + ## Else... + (|> (array.clone hierarchy) + (array.delete! 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 (function (_ sub acc) (list\compose (to_list' sub) acc)) + #.Nil)))) + +(type: #export (Row a) + {#level Level + #size Nat + #root (Hierarchy a) + #tail (Base a)}) + +(def: #export empty + Row + {#level (level_up root_level) + #size 0 + #root (array.new full_node_size) + #tail (array.new 0)}) + +(def: #export (size row) + (All [a] (-> (Row a) Nat)) + (get@ #size row)) + +(def: #export (add val row) + (All [a] (-> a (Row a) (Row a))) + ## Check if there is room in the tail. + (let [row_size (get@ #size row)] + (if (|> row_size (n.- (tail_off row_size)) (n.< full_node_size)) + ## If so, append to it. + (|> row + (update@ #size inc) + (update@ #tail (expand_tail val))) + ## Otherwise, push tail into the tree + ## -------------------------------------------------------- + ## Will the root experience an overflow with this addition? + (|> (if (n.> (i64.left_shift (get@ #level row) 1) + (i64.right_shift branching_exponent row_size)) + ## If so, a brand-new root must be established, that is + ## 1-level taller. + (|> row + (set@ #root (|> (for {@.old + (: (Hierarchy ($ 0)) + (new_hierarchy []))} + (new_hierarchy [])) + (array.write! 0 (#Hierarchy (get@ #root row))) + (array.write! 1 (new_path (get@ #level row) (get@ #tail row))))) + (update@ #level level_up)) + ## Otherwise, just push the current tail onto the root. + (|> row + (update@ #root (push_tail row_size (get@ #level row) (get@ #tail row))))) + ## Finally, update the size of the row and grow a new + ## tail with the new element as it's sole member. + (update@ #size inc) + (set@ #tail (new_tail val))) + ))) + +(exception: incorrect_row_structure) + +(exception: #export [a] (index_out_of_bounds {row (Row a)} {index Nat}) + (exception.report ["Size" (\ n.decimal encode (get@ #size row))] + ["Index" (\ n.decimal encode index)])) + +(exception: base_was_not_found) + +(def: #export (within_bounds? row idx) + (All [a] (-> (Row a) Nat Bit)) + (n.< (get@ #size row) idx)) + +(def: (base_for idx row) + (All [a] (-> Index (Row a) (Try (Base a)))) + (if (within_bounds? row idx) + (if (n.>= (tail_off (get@ #size row)) idx) + (#try.Success (get@ #tail row)) + (loop [level (get@ #level row) + hierarchy (get@ #root row)] + (case [(n.> branching_exponent level) + (array.read (branch_idx (i64.right_shift level idx)) hierarchy)] + [#1 (#.Some (#Hierarchy sub))] + (recur (level_down level) sub) + + [#0 (#.Some (#Base base))] + (#try.Success base) + + [_ #.None] + (exception.throw ..base_was_not_found []) + + _ + (exception.throw ..incorrect_row_structure [])))) + (exception.throw ..index_out_of_bounds [row idx]))) + +(def: #export (nth idx row) + (All [a] (-> Nat (Row a) (Try a))) + (do try.monad + [base (base_for idx row)] + (case (array.read (branch_idx idx) base) + (#.Some value) + (#try.Success value) + + #.None + (exception.throw ..incorrect_row_structure [])))) + +(def: #export (put idx val row) + (All [a] (-> Nat a (Row a) (Try (Row a)))) + (let [row_size (get@ #size row)] + (if (within_bounds? row idx) + (#try.Success (if (n.>= (tail_off row_size) idx) + (update@ #tail (for {@.old + (: (-> (Base ($ 0)) (Base ($ 0))) + (|>> array.clone (array.write! (branch_idx idx) val)))} + (|>> array.clone (array.write! (branch_idx idx) val))) + row) + (update@ #root (put' (get@ #level row) idx val) + row))) + (exception.throw ..index_out_of_bounds [row idx])))) + +(def: #export (update idx f row) + (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) + (do try.monad + [val (..nth idx row)] + (..put idx (f val) row))) + +(def: #export (pop row) + (All [a] (-> (Row a) (Row a))) + (case (get@ #size row) + 0 + empty + + 1 + empty + + row_size + (if (|> row_size (n.- (tail_off row_size)) (n.> 1)) + (let [old_tail (get@ #tail row) + new_tail_size (dec (array.size old_tail))] + (|> row + (update@ #size dec) + (set@ #tail (|> (array.new new_tail_size) + (array.copy! new_tail_size 0 old_tail 0))))) + (maybe.assume + (do maybe.monad + [new_tail (base_for (n.- 2 row_size) row) + #let [[level' root'] (let [init_level (get@ #level row)] + (loop [level init_level + root (maybe.default (new_hierarchy []) + (pop_tail row_size init_level (get@ #root row)))] + (if (n.> branching_exponent level) + (case [(array.read 1 root) (array.read 0 root)] + [#.None (#.Some (#Hierarchy sub_node))] + (recur (level_down level) sub_node) + + ## [#.None (#.Some (#Base _))] + ## (undefined) + + _ + [level root]) + [level root])))]] + (wrap (|> row + (update@ #size dec) + (set@ #level level') + (set@ #root root') + (set@ #tail new_tail)))))) + )) + +(def: #export (to_list row) + (All [a] (-> (Row a) (List a))) + (list\compose (to_list' (#Hierarchy (get@ #root row))) + (to_list' (#Base (get@ #tail row))))) + +(def: #export from_list + (All [a] (-> (List a) (Row a))) + (list\fold ..add ..empty)) + +(def: #export (member? a/Equivalence row val) + (All [a] (-> (Equivalence a) (Row a) a Bit)) + (list.member? a/Equivalence (to_list row) val)) + +(def: #export empty? + (All [a] (-> (Row a) Bit)) + (|>> (get@ #size) (n.= 0))) + +(syntax: #export (row {elems (p.some s.any)}) + {#.doc (doc "Row literals." + (row +10 +20 +30 +40))} + (wrap (list (` (..from_list (list (~+ elems))))))) + +(implementation: (node_equivalence Equivalence) + (All [a] (-> (Equivalence a) (Equivalence (Node a)))) + + (def: (= v1 v2) + (case [v1 v2] + [(#Base b1) (#Base b2)] + (\ (array.equivalence Equivalence) = b1 b2) + + [(#Hierarchy h1) (#Hierarchy h2)] + (\ (array.equivalence (node_equivalence Equivalence)) = h1 h2) + + _ + #0))) + +(implementation: #export (equivalence Equivalence) + (All [a] (-> (Equivalence a) (Equivalence (Row a)))) + + (def: (= v1 v2) + (and (n.= (get@ #size v1) (get@ #size v2)) + (let [(^open "node\.") (node_equivalence Equivalence)] + (and (node\= (#Base (get@ #tail v1)) + (#Base (get@ #tail v2))) + (node\= (#Hierarchy (get@ #root v1)) + (#Hierarchy (get@ #root v2)))))))) + +(implementation: node_fold + (Fold Node) + + (def: (fold f init xs) + (case xs + (#Base base) + (array\fold f init base) + + (#Hierarchy hierarchy) + (array\fold (function (_ node init') (fold f init' node)) + init + hierarchy)))) + +(implementation: #export fold + (Fold Row) + + (def: (fold f init xs) + (let [(^open ".") node_fold] + (fold f + (fold f + init + (#Hierarchy (get@ #root xs))) + (#Base (get@ #tail xs)))))) + +(implementation: #export monoid + (All [a] (Monoid (Row a))) + + (def: identity ..empty) + + (def: (compose xs ys) + (list\fold add xs (..to_list ys)))) + +(implementation: node_functor + (Functor Node) + + (def: (map f xs) + (case xs + (#Base base) + (#Base (array\map f base)) + + (#Hierarchy hierarchy) + (#Hierarchy (array\map (map f) hierarchy))))) + +(implementation: #export functor + (Functor Row) + + (def: (map f xs) + {#level (get@ #level xs) + #size (get@ #size xs) + #root (|> xs (get@ #root) (array\map (\ node_functor map f))) + #tail (|> xs (get@ #tail) (array\map f))})) + +(implementation: #export apply + (Apply Row) + + (def: &functor ..functor) + + (def: (apply ff fa) + (let [(^open ".") ..functor + (^open ".") ..fold + (^open ".") ..monoid + results (map (function (_ f) (map f fa)) + ff)] + (fold compose identity results)))) + +(implementation: #export monad + (Monad Row) + + (def: &functor ..functor) + + (def: wrap (|>> row)) + + (def: join + (let [(^open ".") ..fold + (^open ".") ..monoid] + (fold (function (_ post pre) (compose pre post)) identity)))) + +(def: #export reverse + (All [a] (-> (Row a) (Row a))) + (|>> ..to_list list.reverse (list\fold add ..empty))) + +(template [ ] + [(def: #export + (All [a] + (-> (Predicate a) (Row a) Bit)) + (let [help (: (All [a] + (-> (Predicate a) (Node a) Bit)) + (function (help predicate node) + (case node + (#Base base) + ( predicate base) + + (#Hierarchy hierarchy) + ( (help predicate) hierarchy))))] + (function ( predicate row) + (let [(^slots [#root #tail]) row] + ( (help predicate (#Hierarchy root)) + (help predicate (#Base tail)))))))] + + [every? array.every? #1 and] + [any? array.any? #0 or] + ) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux new file mode 100644 index 000000000..a7fa5cb75 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -0,0 +1,151 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [comonad (#+ CoMonad)]] + [control + ["//" continuation (#+ Cont)] + ["<>" parser + ["<.>" code (#+ Parser)]]] + [macro (#+ with_gensyms) + [syntax (#+ syntax:)] + ["." code]] + [data + ["." bit] + [collection + ["." list ("#\." monad)]]] + [math + [number + ["n" nat]]]]]) + +(type: #export (Sequence a) + {#.doc "An infinite sequence of values."} + (Cont [a (Sequence a)])) + +(def: #export (iterate f x) + {#.doc "Create a sequence by applying a function to a value, and to its result, on and on..."} + (All [a] + (-> (-> a a) a (Sequence a))) + (//.pending [x (iterate f (f x))])) + +(def: #export (repeat x) + {#.doc "Repeat a value forever."} + (All [a] + (-> a (Sequence a))) + (//.pending [x (repeat x)])) + +(def: #export (cycle [start next]) + {#.doc (doc "Go over the elements of a list forever." + "The list should not be empty.")} + (All [a] + (-> [a (List a)] (Sequence a))) + (loop [head start + tail next] + (//.pending [head (case tail + #.Nil + (recur start next) + + (#.Cons head' tail') + (recur head' tail'))]))) + +(template [ ] + [(def: #export ( sequence) + (All [a] (-> (Sequence a) )) + (let [[head tail] (//.run sequence)] + ))] + + [head a] + [tail (Sequence a)] + ) + +(def: #export (nth idx sequence) + (All [a] (-> Nat (Sequence a) a)) + (let [[head tail] (//.run sequence)] + (case idx + 0 head + _ (nth (dec idx) tail)))) + +(template [ ] + [(def: #export ( pred xs) + (All [a] + (-> (Sequence a) (List a))) + (let [[x xs'] (//.run xs)] + (if + (list& x ( xs')) + (list)))) + + (def: #export ( pred xs) + (All [a] + (-> (Sequence a) (Sequence a))) + (let [[x xs'] (//.run xs)] + (if + ( xs') + xs))) + + (def: #export ( pred xs) + (All [a] + (-> (Sequence a) [(List a) (Sequence a)])) + (let [[x xs'] (//.run xs)] + (if + (let [[tail next] ( xs')] + [(#.Cons [x tail]) next]) + [(list) xs])))] + + [take_while drop_while split_while (-> a Bit) (pred x) pred] + [take drop split Nat (n.> 0 pred) (dec pred)] + ) + +(def: #export (unfold step init) + {#.doc "A stateful way of infinitely calculating the values of a sequence."} + (All [a b] + (-> (-> a [a b]) a (Sequence b))) + (let [[next x] (step init)] + (//.pending [x (unfold step next)]))) + +(def: #export (filter predicate sequence) + (All [a] (-> (-> a Bit) (Sequence a) (Sequence a))) + (let [[head tail] (//.run sequence)] + (if (predicate head) + (//.pending [head (filter predicate tail)]) + (filter predicate tail)))) + +(def: #export (partition left? xs) + {#.doc (doc "Split a sequence in two based on a predicate." + "The left side contains all entries for which the predicate is #1." + "The right side contains all entries for which the predicate is #0.")} + (All [a] (-> (-> a Bit) (Sequence a) [(Sequence a) (Sequence a)])) + [(filter left? xs) (filter (bit.complement left?) xs)]) + +(implementation: #export functor + (Functor Sequence) + + (def: (map f fa) + (let [[head tail] (//.run fa)] + (//.pending [(f head) (map f tail)])))) + +(implementation: #export comonad + (CoMonad Sequence) + + (def: &functor ..functor) + + (def: unwrap head) + + (def: (split wa) + (let [[head tail] (//.run wa)] + (//.pending [wa (split tail)])))) + +(syntax: #export (^sequence& {patterns (.form (<>.many .any))} + body + {branches (<>.some .any)}) + {#.doc (doc "Allows destructuring of sequences in pattern-matching expressions." + "Caveat emptor: Only use it for destructuring, and not for testing values within the sequences." + (let [(^sequence& x y z _tail) (some_sequence_func +1 +2 +3)] + (func x y z)))} + (with_gensyms [g!sequence] + (let [body+ (` (let [(~+ (list\join (list\map (function (_ pattern) + (list (` [(~ pattern) (~ g!sequence)]) + (` ((~! //.run) (~ g!sequence))))) + patterns)))] + (~ body)))] + (wrap (list& g!sequence body+ branches))))) diff --git a/stdlib/source/library/lux/data/collection/set.lux b/stdlib/source/library/lux/data/collection/set.lux new file mode 100644 index 000000000..0ae6cee25 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/set.lux @@ -0,0 +1,105 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] + [predicate (#+ Predicate)] + [monoid (#+ Monoid)]] + [data + [collection + ["." list ("#\." fold)]]] + [math + [number + ["n" nat]]]]] + ["." // #_ + ["#" dictionary (#+ Dictionary)]]) + +(type: #export (Set a) + (Dictionary a Any)) + +(def: #export member_hash + (All [a] (-> (Set a) (Hash a))) + //.key_hash) + +(def: #export new + (All [a] (-> (Hash a) (Set a))) + //.new) + +(def: #export size + (All [a] (-> (Set a) Nat)) + //.size) + +(def: #export (add elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set (//.put elem []))) + +(def: #export remove + (All [a] (-> a (Set a) (Set a))) + //.remove) + +(def: #export member? + (All [a] (-> (Set a) a Bit)) + //.key?) + +(def: #export to_list + (All [a] (-> (Set a) (List a))) + //.keys) + +(def: #export union + (All [a] (-> (Set a) (Set a) (Set a))) + //.merge) + +(def: #export (difference sub base) + (All [a] (-> (Set a) (Set a) (Set a))) + (list\fold ..remove base (..to_list sub))) + +(def: #export (intersection filter base) + (All [a] (-> (Set a) (Set a) (Set a))) + (//.select (//.keys filter) + base)) + +(implementation: #export equivalence + (All [a] (Equivalence (Set a))) + + (def: (= (^@ reference [hash _]) sample) + (and (n.= (..size reference) + (..size sample)) + (list.every? (..member? reference) + (..to_list sample))))) + +(implementation: #export hash + (All [a] (Hash (Set a))) + + (def: &equivalence ..equivalence) + + (def: (hash set) + (|> set + ..to_list + (\ (list.hash (..member_hash set)) hash)))) + +(implementation: #export (monoid hash) + (All [a] (-> (Hash a) (Monoid (Set a)))) + + (def: identity (..new hash)) + (def: compose ..union)) + +(def: #export empty? + (All [a] (-> (Set a) Bit)) + (|>> ..size (n.= 0))) + +(def: #export (from_list hash elements) + (All [a] (-> (Hash a) (List a) (Set a))) + (list\fold ..add (..new hash) elements)) + +(def: #export (sub? super sub) + (All [a] (-> (Set a) (Set a) Bit)) + (list.every? (..member? super) (..to_list sub))) + +(def: #export (super? sub super) + (All [a] (-> (Set a) (Set a) Bit)) + (..sub? super sub)) + +(def: #export predicate + (All [a] (-> (Set a) (Predicate a))) + ..member?) diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux new file mode 100644 index 000000000..efd266c18 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -0,0 +1,158 @@ +## https://en.wikipedia.org/wiki/Multiset +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]] + [control + ["." function]] + [math + [number + ["n" nat]]] + [type + [abstract (#+ abstract: :abstraction :representation ^:representation)]]]] + ["." // + [// + ["." list ("#\." fold monoid)] + ["." dictionary (#+ Dictionary)] + [// + ["." maybe]]]]) + +(abstract: #export (Set a) + (Dictionary a Nat) + + (def: #export new + (All [a] (-> (Hash a) (Set a))) + (|>> dictionary.new :abstraction)) + + (def: #export size + (All [a] (-> (Set a) Nat)) + (|>> :representation dictionary.values (list\fold n.+ 0))) + + (def: #export (add multiplicity elem set) + (All [a] (-> Nat a (Set a) (Set a))) + (case multiplicity + 0 set + _ (|> set + :representation + (dictionary.upsert elem 0 (n.+ multiplicity)) + :abstraction))) + + (def: #export (remove multiplicity elem set) + (All [a] (-> Nat a (Set a) (Set a))) + (case multiplicity + 0 set + _ (case (dictionary.get elem (:representation set)) + (#.Some current) + (:abstraction + (if (n.> multiplicity current) + (dictionary.update elem (n.- multiplicity) (:representation set)) + (dictionary.remove elem (:representation set)))) + + #.None + set))) + + (def: #export (multiplicity set elem) + (All [a] (-> (Set a) a Nat)) + (|> set :representation (dictionary.get elem) (maybe.default 0))) + + (def: #export to_list + (All [a] (-> (Set a) (List a))) + (|>> :representation + dictionary.entries + (list\fold (function (_ [elem multiplicity] output) + (list\compose (list.repeat multiplicity elem) output)) + #.Nil))) + + (template [ ] + [(def: #export ( parameter subject) + (All [a] (-> (Set a) (Set a) (Set a))) + (:abstraction (dictionary.merge_with (:representation parameter) (:representation subject))))] + + [union n.max] + [sum n.+] + ) + + (def: #export (intersection parameter (^:representation subject)) + (All [a] (-> (Set a) (Set a) (Set a))) + (list\fold (function (_ [elem multiplicity] output) + (..add (n.min (..multiplicity parameter elem) + multiplicity) + elem + output)) + (..new (dictionary.key_hash subject)) + (dictionary.entries subject))) + + (def: #export (difference parameter subject) + (All [a] (-> (Set a) (Set a) (Set a))) + (|> parameter + :representation + dictionary.entries + (list\fold (function (_ [elem multiplicity] output) + (..remove multiplicity elem output)) + subject))) + + (def: #export (sub? reference subject) + (All [a] (-> (Set a) (Set a) Bit)) + (|> subject + :representation + dictionary.entries + (list.every? (function (_ [elem multiplicity]) + (|> elem + (..multiplicity reference) + (n.>= multiplicity)))))) + + (def: #export (support set) + (All [a] (-> (Set a) (//.Set a))) + (let [(^@ set [hash _]) (:representation set)] + (|> set + dictionary.keys + (//.from_list hash)))) + + (implementation: #export equivalence + (All [a] (Equivalence (Set a))) + + (def: (= (^:representation reference) sample) + (and (n.= (dictionary.size reference) + (dictionary.size (:representation sample))) + (|> reference + dictionary.entries + (list.every? (function (_ [elem multiplicity]) + (|> elem + (..multiplicity sample) + (n.= multiplicity)))))))) + + (implementation: #export hash + (All [a] (Hash (Set a))) + + (def: &equivalence ..equivalence) + + (def: (hash (^:representation set)) + (let [[hash _] set] + (list\fold (function (_ [elem multiplicity] acc) + (|> elem (\ hash hash) (n.* multiplicity) (n.+ acc))) + 0 + (dictionary.entries set))))) + ) + +(def: #export (member? set elem) + (All [a] (-> (Set a) a Bit)) + (|> elem (..multiplicity set) (n.> 0))) + +(def: #export empty? + (All [a] (-> (Set a) Bit)) + (|>> ..size (n.= 0))) + +(def: #export (from_list hash subject) + (All [a] (-> (Hash a) (List a) (Set a))) + (list\fold (..add 1) (..new hash) subject)) + +(def: #export (from_set subject) + (All [a] (-> (//.Set a) (Set a))) + (..from_list (//.member_hash subject) + (//.to_list subject))) + +(def: #export super? + (All [a] (-> (Set a) (Set a) Bit)) + (function.flip sub?)) diff --git a/stdlib/source/library/lux/data/collection/set/ordered.lux b/stdlib/source/library/lux/data/collection/set/ordered.lux new file mode 100644 index 000000000..b61bfb546 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/set/ordered.lux @@ -0,0 +1,85 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [order (#+ Order)]] + [data + [collection + ["." list ("#\." fold)] + [dictionary + ["/" ordered]]]] + [type + abstract]]]) + +(abstract: #export (Set a) + (/.Dictionary a a) + + (def: #export new + (All [a] (-> (Order a) (Set a))) + (|>> /.new :abstraction)) + + (def: #export (member? set elem) + (All [a] (-> (Set a) a Bit)) + (/.key? (:representation set) elem)) + + (template [ ] + [(def: #export + (All [a] (-> (Set a) )) + (|>> :representation ))] + + [(Maybe a) min /.min] + [(Maybe a) max /.max] + [Nat size /.size] + [Bit empty? /.empty?] + ) + + (def: #export (add elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (/.put elem elem) :abstraction)) + + (def: #export (remove elem set) + (All [a] (-> a (Set a) (Set a))) + (|> set :representation (/.remove elem) :abstraction)) + + (def: #export to_list + (All [a] (-> (Set a) (List a))) + (|>> :representation /.keys)) + + (def: #export (from_list &order list) + (All [a] (-> (Order a) (List a) (Set a))) + (list\fold add (..new &order) list)) + + (def: #export (union left right) + (All [a] (-> (Set a) (Set a) (Set a))) + (list\fold ..add right (..to_list left))) + + (def: #export (intersection left right) + (All [a] (-> (Set a) (Set a) (Set a))) + (|> (..to_list right) + (list.filter (..member? left)) + (..from_list (get@ #/.&order (:representation right))))) + + (def: #export (difference param subject) + (All [a] (-> (Set a) (Set a) (Set a))) + (|> (..to_list subject) + (list.filter (|>> (..member? param) not)) + (..from_list (get@ #/.&order (:representation subject))))) + + (implementation: #export equivalence + (All [a] (Equivalence (Set a))) + + (def: (= reference sample) + (\ (list.equivalence (\ (:representation reference) &equivalence)) + = (..to_list reference) (..to_list sample)))) + ) + +(def: #export (sub? super sub) + (All [a] (-> (Set a) (Set a) Bit)) + (|> sub + ..to_list + (list.every? (..member? super)))) + +(def: #export (super? sub super) + (All [a] (-> (Set a) (Set a) Bit)) + (sub? super sub)) diff --git a/stdlib/source/library/lux/data/collection/stack.lux b/stdlib/source/library/lux/data/collection/stack.lux new file mode 100644 index 000000000..c81240c29 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -0,0 +1,66 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [functor (#+ Functor)]] + [data + [collection + ["//" list]]] + [type + abstract]]]) + +(abstract: #export (Stack a) + (List a) + + (def: #export empty + Stack + (:abstraction (list))) + + (def: #export size + (All [a] (-> (Stack a) Nat)) + (|>> :representation //.size)) + + (def: #export empty? + (All [a] (-> (Stack a) Bit)) + (|>> :representation //.empty?)) + + (def: #export (peek stack) + (All [a] (-> (Stack a) (Maybe a))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons value _) + (#.Some value))) + + (def: #export (pop stack) + (All [a] (-> (Stack a) (Maybe [a (Stack a)]))) + (case (:representation stack) + #.Nil + #.None + + (#.Cons top stack') + (#.Some [top (:abstraction stack')]))) + + (def: #export (push value stack) + (All [a] (-> a (Stack a) (Stack a))) + (:abstraction (#.Cons value (:representation stack)))) + + (implementation: #export (equivalence super) + (All [a] + (-> (Equivalence a) + (Equivalence (Stack a)))) + + (def: (= reference subject) + (\ (//.equivalence super) = (:representation reference) (:representation subject)))) + + (implementation: #export functor + (Functor Stack) + + (def: (map f value) + (|> value + :representation + (\ //.functor map f) + :abstraction))) + ) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux new file mode 100644 index 000000000..f6b3746e7 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -0,0 +1,85 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [equivalence (#+ Equivalence)] + [fold (#+ Fold)] + [monad (#+ do)]] + [control + ["<>" parser + ["" code (#+ Parser)]]] + [data + [collection + ["." list ("#\." monad fold)]]] + [macro + [syntax (#+ syntax:)] + ["." code]]]]) + +(type: #export (Tree a) + {#value a + #children (List (Tree a))}) + +(def: #export (flatten tree) + (All [a] (-> (Tree a) (List a))) + (#.Cons (get@ #value tree) + (list\join (list\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}) + +(type: #rec Tree-Code + [Code (List Tree-Code)]) + +(def: tree^ + (Parser Tree-Code) + (|> (|>> <>.some + .record + (<>.and .any)) + <>.rec + <>.some + .record + (<>.default (list)) + (<>.and .any))) + +(syntax: #export (tree {root tree^}) + {#.doc (doc "Tree literals." + (: (Tree Nat) + (tree 10 + {20 {} + 30 {} + 40 {}})))} + (wrap (list (` (~ (loop [[value children] root] + (` {#value (~ value) + #children (list (~+ (list\map recur children)))}))))))) + +(implementation: #export (equivalence super) + (All [a] (-> (Equivalence a) (Equivalence (Tree a)))) + + (def: (= tx ty) + (and (\ super = (get@ #value tx) (get@ #value ty)) + (\ (list.equivalence (equivalence super)) = (get@ #children tx) (get@ #children ty))))) + +(implementation: #export functor + (Functor Tree) + + (def: (map f fa) + {#value (f (get@ #value fa)) + #children (list\map (map f) + (get@ #children fa))})) + +(implementation: #export fold + (Fold Tree) + + (def: (fold f init tree) + (list\fold (function (_ tree' init') (fold f init' tree')) + (f (get@ #value tree) + init) + (get@ #children tree)))) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux new file mode 100644 index 000000000..a3b1be634 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -0,0 +1,108 @@ +(.module: + [library + [lux #* + [abstract + [predicate (#+ Predicate)] + ["." monoid (#+ Monoid)]] + [data + [collection + ["." list ("#\." monoid)]]] + [type + [abstract (#+ abstract: :abstraction :representation)]]]]) + +(abstract: #export (Tree @ t v) + {#monoid (Monoid t) + #tag t + #root (| v + [(Tree @ t v) (Tree @ t v)])} + + (interface: #export (Builder @ t) + (: (All [v] + (-> t v (Tree @ t v))) + leaf) + (: (All [v] + (-> (Tree @ t v) + (Tree @ t v) + (Tree @ t v))) + branch)) + + (template [ ] + [(def: #export + (All [@ t v] (-> (Tree @ t v) )) + (|>> :representation (get@ )))] + + [tag #tag t] + [root #root (Either v [(Tree @ t v) (Tree @ t v)])] + ) + + (implementation: #export (builder monoid) + (All [t] (Ex [@] (-> (Monoid t) (Builder @ t)))) + + (def: (leaf tag value) + (:abstraction + {#monoid monoid + #tag tag + #root (0 #0 value)})) + + (def: (branch left right) + (:abstraction + {#monoid monoid + #tag (\ monoid compose (..tag left) (..tag right)) + #root (0 #1 [left right])}))) + + (def: #export (value tree) + (All [@ t v] (-> (Tree @ t v) v)) + (case (get@ #root (:representation tree)) + (0 #0 value) + value + + (0 #1 [left right]) + (value left))) + + (def: #export (tags tree) + (All [@ t v] (-> (Tree @ t v) (List t))) + (case (get@ #root (:representation tree)) + (0 #0 value) + (list (get@ #tag (:representation tree))) + + (0 #1 [left right]) + (list\compose (tags left) + (tags right)))) + + (def: #export (values tree) + (All [@ t v] (-> (Tree @ t v) (List v))) + (case (get@ #root (:representation tree)) + (0 #0 value) + (list value) + + (0 #1 [left right]) + (list\compose (values left) + (values right)))) + + (def: #export (search predicate tree) + (All [@ t v] (-> (Predicate t) (Tree @ t v) (Maybe v))) + (let [[monoid tag root] (:representation tree)] + (if (predicate tag) + (let [(^open "tag//.") monoid] + (loop [_tag tag//identity + _node root] + (case _node + (0 #0 value) + (#.Some value) + + (0 #1 [left right]) + (let [shifted_tag (tag//compose _tag (..tag left))] + (if (predicate shifted_tag) + (recur _tag (get@ #root (:representation left))) + (recur shifted_tag (get@ #root (:representation right)))))))) + #.None))) + ) + +(def: #export (found? predicate tree) + (All [@ t v] (-> (Predicate t) (Tree @ t v) Bit)) + (case (..search predicate tree) + (#.Some _) + true + + #.None + false)) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux new file mode 100644 index 000000000..bb36e3e38 --- /dev/null +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -0,0 +1,318 @@ +(.module: + [library + [lux #* + ["@" target] + [abstract + [functor (#+ Functor)] + [comonad (#+ CoMonad)] + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [data + ["." product] + ["." maybe ("#\." monad)] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor fold monoid)]]]]] + ["." // (#+ Tree) ("#\." functor)]) + +(type: (Family Zipper a) + {#parent (Zipper a) + #lefts (List (Tree a)) + #rights (List (Tree a))}) + +(type: #export (Zipper a) + {#.doc "Tree zippers, for easy navigation and editing of trees."} + {#family (Maybe (Family Zipper a)) + #node (Tree a)}) + +(implementation: #export (equivalence super) + (All [a] + (-> (Equivalence a) + (Equivalence (Zipper a)))) + + (def: (= reference sample) + (let [== ($_ product.equivalence + (maybe.equivalence + ($_ product.equivalence + = + (list.equivalence (//.equivalence super)) + (list.equivalence (//.equivalence super)))) + (//.equivalence super))] + (== reference sample)))) + +(def: #export (zip tree) + (All [a] (-> (Tree a) (Zipper a))) + {#family #.None + #node tree}) + +(def: #export unzip + (All [a] (-> (Zipper a) (Tree a))) + (get@ #node)) + +(def: #export value + (All [a] (-> (Zipper a) a)) + (get@ [#node #//.value])) + +(def: #export set + (All [a] (-> a (Zipper a) (Zipper a))) + (set@ [#node #//.value])) + +(def: #export update + (All [a] (-> (-> a a) (Zipper a) (Zipper a))) + (update@ [#node #//.value])) + +(def: children + (All [a] (-> (Zipper a) (List (Tree a)))) + (get@ [#node #//.children])) + +(def: #export leaf? + (All [a] (-> (Zipper a) Bit)) + (|>> ..children list.empty?)) + +(def: #export branch? + (All [a] (-> (Zipper a) Bit)) + (|>> ..leaf? not)) + +(def: #export (start? zipper) + (All [a] (-> (Zipper a) Bit)) + (case (get@ #family zipper) + #.None + true + + _ + false)) + +(def: #export (down zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case (..children zipper) + #.Nil + #.None + + (#.Cons head tail) + (#.Some {#family (#.Some {#parent (set@ [#node #//.children] (list) zipper) + #lefts #.Nil + #rights tail}) + #node head}))) + +(def: #export (up zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (do maybe.monad + [family (get@ #family zipper)] + (wrap (let [(^slots [#parent #lefts #rights]) family] + (for {@.old + (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) + (set@ #//.children (list\compose (list.reverse lefts) + (#.Cons (get@ #node zipper) + rights)))) + parent)} + (set@ [#node #//.children] + (list\compose (list.reverse lefts) + (#.Cons (get@ #node zipper) + rights)) + parent)))))) + +(template [ ] + [(def: #export ( zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case (get@ #family zipper) + (#.Some family) + (case (get@ family) + (#.Cons next side') + (#.Some (for {@.old + {#family (#.Some (|> family + (set@ side') + (update@ (|>> (#.Cons (get@ #node zipper)))))) + #node next}} + (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) + (function (_ side' zipper) + (|>> (set@ side') + (update@ (|>> (#.Cons (get@ #node zipper)))))))] + {#family (#.Some (move side' zipper family)) + #node next}))) + + #.Nil + #.None) + + #.None + #.None)) + + (def: #export ( zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case (get@ #family zipper) + #.None + #.None + + (#.Some family) + (case (list.reverse (get@ family)) + #.Nil + #.None + + (#.Cons last prevs) + (#.Some (for {@.old {#family (#.Some (|> family + (set@ #.Nil) + (update@ (|>> (#.Cons (get@ #node zipper)) + (list\compose prevs))))) + #node last}} + (let [move (: (All [a] (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a))) + (function (_ prevs zipper) + (|>> (set@ #.Nil) + (update@ (|>> (#.Cons (get@ #node zipper)) + (list\compose prevs))))))] + {#family (#.Some (move prevs zipper family)) + #node last}))))))] + + [right rightmost #rights #lefts] + [left leftmost #lefts #rights] + ) + +(def: #export (next zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case (..down zipper) + (#.Some forward) + (#.Some forward) + + #.None + (loop [@ zipper] + (case (..right @) + (#.Some forward) + (#.Some forward) + + #.None + (do maybe.monad + [@ (..up @)] + (recur @)))))) + +(def: (bottom zipper) + (All [a] (-> (Zipper a) (Zipper a))) + (case (..right zipper) + (#.Some forward) + (bottom forward) + + #.None + (case (..down zipper) + (#.Some forward) + (bottom forward) + + #.None + zipper))) + +(def: #export (previous zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case (..left zipper) + #.None + (..up zipper) + + (#.Some backward) + (#.Some (case (..down backward) + (#.Some then) + (..bottom then) + + #.None + backward)))) + +(template [ ] + [(def: #export ( zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (case ( zipper) + #.None + #.None + + (#.Some @) + (loop [@ @] + (case ( @) + #.None + (#.Some @) + + (#.Some @) + (recur @)))))] + + [end ..next] + [start ..previous] + ) + +(def: #export (end? zipper) + (All [a] (-> (Zipper a) Bit)) + (case (..end zipper) + #.None + true + + (#.Some _) + false)) + +(def: #export (interpose value zipper) + (All [a] (-> a (Zipper a) (Zipper a))) + (update@ [#node #//.children] + (|>> (//.branch value) list) + zipper)) + +(def: #export (adopt value zipper) + (All [a] (-> a (Zipper a) (Zipper a))) + (update@ [#node #//.children] + (|>> (#.Cons (//.leaf value))) + zipper)) + +(def: #export (remove zipper) + (All [a] (-> (Zipper a) (Maybe (Zipper a)))) + (do maybe.monad + [family (get@ #family zipper)] + (case (get@ #lefts family) + #.Nil + (wrap (set@ [#node #//.children] + (get@ #rights family) + (get@ #parent family))) + + (#.Cons next side) + (wrap (|> zipper + (set@ #family (|> family + (set@ #lefts side) + #.Some)) + (set@ #node next)))))) + +(template [ ] + [(def: #export ( value zipper) + (All [a] (-> a (Zipper a) (Maybe (Zipper a)))) + (case (get@ #family zipper) + #.None + #.None + + (#.Some family) + (#.Some (set@ #family + (#.Some (update@ (|>> (#.Cons (//.leaf value))) family)) + zipper))))] + + [insert-left #lefts] + [insert-right #rights] + ) + +(implementation: #export functor + (Functor Zipper) + + (def: (map f (^slots [#family #node])) + {#family (maybe\map (function (_ (^slots [#parent #lefts #rights])) + {#parent (map f parent) + #lefts (list\map (//\map f) lefts) + #rights (list\map (//\map f) rights)}) + family) + #node (//\map f node)})) + +(implementation: #export comonad + (CoMonad Zipper) + + (def: &functor ..functor) + + (def: unwrap (get@ [#node #//.value])) + + (def: (split (^slots [#family #node])) + (let [tree-splitter (: (All [a] (-> (Tree a) (Tree (Zipper a)))) + (function (tree-splitter tree) + {#//.value (..zip tree) + #//.children (|> tree + (get@ #//.children) + (list\map tree-splitter))}))] + {#family (maybe\map (function (_ (^slots [#parent #lefts #rights])) + {#parent (split parent) + #lefts (list\map tree-splitter lefts) + #rights (list\map tree-splitter rights)}) + family) + #node (tree-splitter node)}))) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux new file mode 100644 index 000000000..72847c91d --- /dev/null +++ b/stdlib/source/library/lux/data/color.lux @@ -0,0 +1,425 @@ +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [monoid (#+ Monoid)] + ["." hash (#+ Hash)]] + [data + [collection + ["." list ("#\." functor)]]] + ["." math + [number + ["n" nat] + ["f" frac] + ["." int] + ["." rev ("#\." interval)] + ["." i64]]] + [type + abstract]]]) + +(def: rgb 256) +(def: top (dec rgb)) + +(def: rgb_factor (|> top .int int.frac)) + +(def: down + (-> Nat Frac) + (|>> .int int.frac (f./ rgb_factor))) + +(def: up + (-> Frac Nat) + (|>> (f.* rgb_factor) f.int .nat)) + +(type: #export RGB + {#red Nat + #green Nat + #blue Nat}) + +(type: #export HSL + [Frac Frac Frac]) + +(type: #export CMYK + {#cyan Frac + #magenta Frac + #yellow Frac + #key Frac}) + +(type: #export HSB + [Frac Frac Frac]) + +(abstract: #export Color + RGB + + (def: #export (from_rgb [red green blue]) + (-> RGB Color) + (:abstraction {#red (n.% ..rgb red) + #green (n.% ..rgb green) + #blue (n.% ..rgb blue)})) + + (def: #export to_rgb + (-> Color RGB) + (|>> :representation)) + + (implementation: #export equivalence + (Equivalence Color) + + (def: (= reference sample) + (let [[rR gR bR] (:representation reference) + [rS gS bS] (:representation sample)] + (and (n.= rR rS) + (n.= gR gS) + (n.= bR bS))))) + + (implementation: #export hash + (Hash Color) + + (def: &equivalence ..equivalence) + + (def: (hash value) + (let [[r g b] (:representation value)] + ($_ i64.or + (i64.left_shift 16 r) + (i64.left_shift 8 g) + b)))) + + (def: #export black + (..from_rgb {#red 0 + #green 0 + #blue 0})) + + (def: #export white + (..from_rgb {#red ..top + #green ..top + #blue ..top})) + + (implementation: #export addition + (Monoid Color) + + (def: identity ..black) + + (def: (compose left right) + (let [[lR lG lB] (:representation left) + [rR rG rB] (:representation right)] + (:abstraction {#red (n.max lR rR) + #green (n.max lG rG) + #blue (n.max lB rB)})))) + + (def: (complement' value) + (-> Nat Nat) + (|> ..top (n.- value))) + + (def: #export (complement color) + (-> Color Color) + (let [[red green blue] (:representation color)] + (:abstraction {#red (complement' red) + #green (complement' green) + #blue (complement' blue)}))) + + (implementation: #export subtraction + (Monoid Color) + + (def: identity ..white) + + (def: (compose left right) + (let [[lR lG lB] (:representation (..complement left)) + [rR rG rB] (:representation right)] + (:abstraction {#red (n.min lR rR) + #green (n.min lG rG) + #blue (n.min lB rB)})))) + ) + +(def: #export (to_hsl color) + (-> Color HSL) + (let [[red green blue] (to_rgb color) + red (..down red) + green (..down green) + blue (..down blue) + max ($_ f.max red green blue) + min ($_ f.min red green blue) + luminance (|> (f.+ max min) (f./ +2.0))] + (if (f.= max min) + ## Achromatic + [+0.0 + +0.0 + luminance] + ## Chromatic + (let [diff (|> max (f.- min)) + saturation (|> diff + (f./ (if (f.> +0.5 luminance) + (|> +2.0 (f.- max) (f.- min)) + (|> max (f.+ min))))) + hue' (cond (f.= red max) + (|> green (f.- blue) (f./ diff) + (f.+ (if (f.< blue green) +6.0 +0.0))) + + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ +2.0)) + + ## (f.= blue max) + (|> red (f.- green) (f./ diff) + (f.+ +4.0)))] + [(|> hue' (f./ +6.0)) + saturation + luminance])))) + +(def: (hue_to_rgb p q t) + (-> Frac Frac Frac Frac) + (let [t (cond (f.< +0.0 t) (f.+ +1.0 t) + (f.> +1.0 t) (f.- +1.0 t) + ## else + t) + f2/3 (f./ +3.0 +2.0)] + (cond (f.< (f./ +6.0 +1.0) t) + (|> q (f.- p) (f.* +6.0) (f.* t) (f.+ p)) + + (f.< (f./ +2.0 +1.0) t) + q + + (f.< f2/3 t) + (|> q (f.- p) (f.* (|> f2/3 (f.- t))) (f.* +6.0) (f.+ p)) + + ## else + p))) + +(def: #export (from_hsl [hue saturation luminance]) + (-> HSL Color) + (if (f.= +0.0 saturation) + ## Achromatic + (let [intensity (..up luminance)] + (from_rgb {#red intensity + #green intensity + #blue intensity})) + ## Chromatic + (let [q (if (f.< +0.5 luminance) + (|> saturation (f.+ +1.0) (f.* luminance)) + (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) + p (|> luminance (f.* +2.0) (f.- q)) + third (|> +1.0 (f./ +3.0))] + (from_rgb {#red (..up (|> hue (f.+ third) (hue_to_rgb p q))) + #green (..up (|> hue (hue_to_rgb p q))) + #blue (..up (|> hue (f.- third) (hue_to_rgb p q)))})))) + +(def: #export (to_hsb color) + (-> Color HSB) + (let [[red green blue] (to_rgb color) + red (..down red) + green (..down green) + blue (..down blue) + max ($_ f.max red green blue) + min ($_ f.min red green blue) + brightness max + diff (|> max (f.- min)) + saturation (if (f.= +0.0 max) + +0.0 + (|> diff (f./ max)))] + (if (f.= max min) + ## Achromatic + [+0.0 saturation brightness] + ## Chromatic + (let [hue (cond (f.= red max) + (|> green (f.- blue) (f./ diff) + (f.+ (if (f.< blue green) +6.0 +0.0))) + + (f.= green max) + (|> blue (f.- red) (f./ diff) + (f.+ +2.0)) + + ## (f.= blue max) + (|> red (f.- green) (f./ diff) + (f.+ +4.0)))] + [(|> hue (f./ +6.0)) + saturation + brightness])))) + +(def: #export (from_hsb [hue saturation brightness]) + (-> HSB Color) + (let [hue (|> hue (f.* +6.0)) + i (math.floor hue) + f (|> hue (f.- i)) + p (|> +1.0 (f.- saturation) (f.* brightness)) + q (|> +1.0 (f.- (f.* f saturation)) (f.* brightness)) + t (|> +1.0 (f.- (|> +1.0 (f.- f) (f.* saturation))) (f.* brightness)) + v brightness + mod (|> i (f.% +6.0) f.int .nat) + red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) + green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) + blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] + (from_rgb {#red (..up red) + #green (..up green) + #blue (..up blue)}))) + +(def: #export (to_cmyk color) + (-> Color CMYK) + (let [[red green blue] (to_rgb color) + red (..down red) + green (..down green) + blue (..down blue) + key (|> +1.0 (f.- ($_ f.max red green blue))) + f (if (f.< +1.0 key) + (|> +1.0 (f./ (|> +1.0 (f.- key)))) + +0.0) + cyan (|> +1.0 (f.- red) (f.- key) (f.* f)) + magenta (|> +1.0 (f.- green) (f.- key) (f.* f)) + yellow (|> +1.0 (f.- blue) (f.- key) (f.* f))] + {#cyan cyan + #magenta magenta + #yellow yellow + #key key})) + +(def: #export (from_cmyk [cyan magenta yellow key]) + (-> CMYK Color) + (if (f.= +1.0 key) + (from_rgb {#red 0 + #green 0 + #blue 0}) + (let [red (|> (|> +1.0 (f.- cyan)) + (f.* (|> +1.0 (f.- key)))) + green (|> (|> +1.0 (f.- magenta)) + (f.* (|> +1.0 (f.- key)))) + blue (|> (|> +1.0 (f.- yellow)) + (f.* (|> +1.0 (f.- key))))] + (from_rgb {#red (..up red) + #green (..up green) + #blue (..up blue)})))) + +(def: (normalize ratio) + (-> Frac Frac) + (cond (f.> +1.0 ratio) + (f.% +1.0 ratio) + + (f.< +0.0 ratio) + (|> ratio (f.% +1.0) (f.+ +1.0)) + + ## else + ratio)) + +(def: #export (interpolate ratio end start) + (-> Frac Color Color Color) + (let [dS (..normalize ratio) + dE (|> +1.0 (f.- dS)) + interpolate' (: (-> Nat Nat Nat) + (function (_ end start) + (|> (|> start .int int.frac (f.* dS)) + (f.+ (|> end .int int.frac (f.* dE))) + f.int + .nat))) + [redS greenS blueS] (to_rgb start) + [redE greenE blueE] (to_rgb end)] + (from_rgb {#red (interpolate' redE redS) + #green (interpolate' greenE greenS) + #blue (interpolate' blueE blueS)}))) + +(template [ ] + [(def: #export ( ratio color) + (-> Frac Color Color) + (..interpolate ratio color))] + + [darker black] + [brighter white] + ) + +(template [ ] + [(def: #export ( ratio color) + (-> Frac Color Color) + (let [[hue saturation luminance] (to_hsl color)] + (from_hsl [hue + (|> saturation + (f.* (|> +1.0 ( (..normalize ratio)))) + (f.min +1.0)) + luminance])))] + + [saturate f.+] + [de_saturate f.-] + ) + +(def: #export (gray_scale color) + (-> Color Color) + (let [[_ _ luminance] (to_hsl color)] + (from_hsl [+0.0 + +0.0 + luminance]))) + +(template [ <1> <2>] + [(def: #export ( color) + (-> Color [Color Color Color]) + (let [[hue saturation luminance] (to_hsl color)] + [color + (from_hsl [(|> hue (f.+ <1>) ..normalize) + saturation + luminance]) + (from_hsl [(|> hue (f.+ <2>) ..normalize) + saturation + luminance])]))] + + [triad (|> +1.0 (f./ +3.0)) (|> +2.0 (f./ +3.0))] + [clash (|> +1.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [split_complement (|> +1.0 (f./ +5.0)) (|> +3.0 (f./ +5.0))] + ) + +(template [ <1> <2> <3>] + [(def: #export ( color) + (-> Color [Color Color Color Color]) + (let [[hue saturation luminance] (to_hsb color)] + [color + (from_hsb [(|> hue (f.+ <1>) ..normalize) + saturation + luminance]) + (from_hsb [(|> hue (f.+ <2>) ..normalize) + saturation + luminance]) + (from_hsb [(|> hue (f.+ <3>) ..normalize) + saturation + luminance])]))] + + [square (|> +1.0 (f./ +4.0)) (|> +2.0 (f./ +4.0)) (|> +3.0 (f./ +4.0))] + [tetradic (|> +2.0 (f./ +12.0)) (|> +6.0 (f./ +12.0)) (|> +8.0 (f./ +12.0))] + ) + +(type: #export Spread + Frac) + +(type: #export Palette + (-> Spread Nat Color (List Color))) + +(def: #export (analogous spread variations color) + (-> Spread Nat Color (List Color)) + (let [[hue saturation brightness] (to_hsb color) + spread (..normalize spread)] + (list\map (function (_ idx) + (from_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) + saturation + brightness])) + (list.indices variations)))) + +(def: #export (monochromatic spread variations color) + (-> Spread Nat Color (List Color)) + (let [[hue saturation brightness] (to_hsb color) + spread (..normalize spread)] + (|> (list.indices variations) + (list\map (|>> inc .int int.frac + (f.* spread) + (f.+ brightness) + ..normalize + [hue saturation] + from_hsb))))) + +(type: #export Alpha + Rev) + +(def: #export transparent + Alpha + rev\bottom) + +(def: #export translucent + Alpha + .5) + +(def: #export opaque + Alpha + rev\top) + +(type: #export Pigment + {#color Color + #alpha Alpha}) diff --git a/stdlib/source/library/lux/data/color/named.lux b/stdlib/source/library/lux/data/color/named.lux new file mode 100644 index 000000000..a9a9ab4ab --- /dev/null +++ b/stdlib/source/library/lux/data/color/named.lux @@ -0,0 +1,156 @@ +(.module: + [library + [lux #* + [math + [number (#+ hex)]]]] + ["." // (#+ Color)]) + +(template [ ] + [(def: #export + Color + (//.from_rgb {#//.red (hex ) + #//.green (hex ) + #//.blue (hex )}))] + + ["F0" "F8" "FF" alice_blue] + ["FA" "EB" "D7" antique_white] + ["00" "FF" "FF" aqua] + ["7F" "FF" "D4" aquamarine] + ["F0" "FF" "FF" azure] + ["F5" "F5" "DC" beige] + ["FF" "E4" "C4" bisque] + ["00" "00" "00" black] + ["FF" "EB" "CD" blanched_almond] + ["00" "00" "FF" blue] + ["8A" "2B" "E2" blue_violet] + ["A5" "2A" "2A" brown] + ["DE" "B8" "87" burly_wood] + ["5F" "9E" "A0" cadet_blue] + ["7F" "FF" "00" chartreuse] + ["D2" "69" "1E" chocolate] + ["FF" "7F" "50" coral] + ["64" "95" "ED" cornflower_blue] + ["FF" "F8" "DC" cornsilk] + ["DC" "14" "3C" crimson] + ["00" "FF" "FF" cyan] + ["00" "00" "8B" dark_blue] + ["00" "8B" "8B" dark_cyan] + ["B8" "86" "0B" dark_goldenrod] + ["A9" "A9" "A9" dark_gray] + ["00" "64" "00" dark_green] + ["BD" "B7" "6B" dark_khaki] + ["8B" "00" "8B" dark_magenta] + ["55" "6B" "2F" dark_olive_green] + ["FF" "8C" "00" dark_orange] + ["99" "32" "CC" dark_orchid] + ["8B" "00" "00" dark_red] + ["E9" "96" "7A" dark_salmon] + ["8F" "BC" "8F" dark_sea_green] + ["48" "3D" "8B" dark_slate_blue] + ["2F" "4F" "4F" dark_slate_gray] + ["00" "CE" "D1" dark_turquoise] + ["94" "00" "D3" dark_violet] + ["FF" "14" "93" deep_pink] + ["00" "BF" "FF" deep_sky_blue] + ["69" "69" "69" dim_gray] + ["1E" "90" "FF" dodger_blue] + ["B2" "22" "22" fire_brick] + ["FF" "FA" "F0" floral_white] + ["22" "8B" "22" forest_green] + ["FF" "00" "FF" fuchsia] + ["DC" "DC" "DC" gainsboro] + ["F8" "F8" "FF" ghost_white] + ["FF" "D7" "00" gold] + ["DA" "A5" "20" goldenrod] + ["80" "80" "80" gray] + ["00" "80" "00" green] + ["AD" "FF" "2F" green_yellow] + ["F0" "FF" "F0" honey_dew] + ["FF" "69" "B4" hot_pink] + ["CD" "5C" "5C" indian_red] + ["4B" "00" "82" indigo] + ["FF" "FF" "F0" ivory] + ["F0" "E6" "8C" khaki] + ["E6" "E6" "FA" lavender] + ["FF" "F0" "F5" lavender_blush] + ["7C" "FC" "00" lawn_green] + ["FF" "FA" "CD" lemon_chiffon] + ["AD" "D8" "E6" light_blue] + ["F0" "80" "80" light_coral] + ["E0" "FF" "FF" light_cyan] + ["FA" "FA" "D2" light_goldenrod_yellow] + ["D3" "D3" "D3" light_gray] + ["90" "EE" "90" light_green] + ["FF" "B6" "C1" light_pink] + ["FF" "A0" "7A" light_salmon] + ["20" "B2" "AA" light_sea_green] + ["87" "CE" "FA" light_sky_blue] + ["77" "88" "99" light_slate_gray] + ["B0" "C4" "DE" light_steel_blue] + ["FF" "FF" "E0" light_yellow] + ["00" "FF" "00" lime] + ["32" "CD" "32" lime_green] + ["FA" "F0" "E6" linen] + ["FF" "00" "FF" magenta] + ["80" "00" "00" maroon] + ["66" "CD" "AA" medium_aquamarine] + ["00" "00" "CD" medium_blue] + ["BA" "55" "D3" medium_orchid] + ["93" "70" "DB" medium_purple] + ["3C" "B3" "71" medium_sea_green] + ["7B" "68" "EE" medium_slate_blue] + ["00" "FA" "9A" medium_spring_green] + ["48" "D1" "CC" medium_turquoise] + ["C7" "15" "85" medium_violet_red] + ["19" "19" "70" midnight_blue] + ["F5" "FF" "FA" mint_cream] + ["FF" "E4" "E1" misty_rose] + ["FF" "E4" "B5" moccasin] + ["FF" "DE" "AD" navajo_white] + ["00" "00" "80" navy] + ["FD" "F5" "E6" old_lace] + ["80" "80" "00" olive] + ["6B" "8E" "23" olive_drab] + ["FF" "A5" "00" orange] + ["FF" "45" "00" orange_red] + ["DA" "70" "D6" orchid] + ["EE" "E8" "AA" pale_goldenrod] + ["98" "FB" "98" pale_green] + ["AF" "EE" "EE" pale_turquoise] + ["DB" "70" "93" pale_violet_red] + ["FF" "EF" "D5" papaya_whip] + ["FF" "DA" "B9" peach_puff] + ["CD" "85" "3F" peru] + ["FF" "C0" "CB" pink] + ["DD" "A0" "DD" plum] + ["B0" "E0" "E6" powder_blue] + ["80" "00" "80" purple] + ["66" "33" "99" rebecca_purple] + ["FF" "00" "00" red] + ["BC" "8F" "8F" rosy_brown] + ["41" "69" "E1" royal_blue] + ["8B" "45" "13" saddle_brown] + ["FA" "80" "72" salmon] + ["F4" "A4" "60" sandy_brown] + ["2E" "8B" "57" sea_green] + ["FF" "F5" "EE" sea_shell] + ["A0" "52" "2D" sienna] + ["C0" "C0" "C0" silver] + ["87" "CE" "EB" sky_blue] + ["6A" "5A" "CD" slate_blue] + ["70" "80" "90" slate_gray] + ["FF" "FA" "FA" snow] + ["00" "FF" "7F" spring_green] + ["46" "82" "B4" steel_blue] + ["D2" "B4" "8C" tan] + ["00" "80" "80" teal] + ["D8" "BF" "D8" thistle] + ["FF" "63" "47" tomato] + ["40" "E0" "D0" turquoise] + ["EE" "82" "EE" violet] + ["F5" "DE" "B3" wheat] + ["FF" "FF" "FF" white] + ["F5" "F5" "F5" white_smoke] + ["FF" "FF" "00" yellow] + ["9A" "CD" "32" yellow_green] + ) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux new file mode 100644 index 000000000..7103f7d9d --- /dev/null +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -0,0 +1,292 @@ +(.module: + [library + [lux (#- and or nat int rev list type) + [type (#+ :share)] + [abstract + [monoid (#+ Monoid)] + [monad (#+ Monad do)] + [equivalence (#+ Equivalence)]] + [control + [pipe (#+ case>)] + ["." function] + ["." try (#+ Try)] + ["<>" parser ("#\." monad) + ["/" binary (#+ Offset Size Parser)]]] + [data + ["." product] + ["." binary (#+ Binary)] + [text + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." list] + ["." row (#+ Row) ("#\." functor)] + ["." set (#+ Set)]]] + [math + [number + ["." i64] + ["n" nat] + ["." frac]]]]]) + +(def: mask + (-> Size (I64 Any)) + (|>> (n.* i64.bits_per_byte) i64.mask)) + +(type: #export Mutation + (-> [Offset Binary] [Offset Binary])) + +(type: #export Specification + [Size Mutation]) + +(def: #export no_op + Specification + [0 function.identity]) + +(def: #export (instance [size mutation]) + (-> Specification Binary) + (|> size binary.create [0] mutation product.right)) + +(implementation: #export monoid + (Monoid Specification) + + (def: identity + ..no_op) + + (def: (compose [sizeL mutL] [sizeR mutR]) + [(n.+ sizeL sizeR) + (|>> mutL mutR)])) + +(type: #export (Writer a) + (-> a Specification)) + +(def: #export (run writer value) + (All [a] (-> (Writer a) a Binary)) + (..instance (writer value))) + +(template [ ] + [(def: #export + (Writer (I64 Any)) + (function (_ value) + [ + (function (_ [offset binary]) + [(n.+ offset) + (|> binary + ( offset value) + try.assume)])]))] + + [bits/8 /.size/8 binary.write/8] + [bits/16 /.size/16 binary.write/16] + [bits/32 /.size/32 binary.write/32] + [bits/64 /.size/64 binary.write/64] + ) + +(def: #export (or left right) + (All [l r] (-> (Writer l) (Writer r) (Writer (| l r)))) + (function (_ altV) + (case altV + (^template [ ] + [( caseV) + (let [[caseS caseT] ( caseV)] + [(.inc caseS) + (function (_ [offset binary]) + (|> binary + (binary.write/8 offset ) + try.assume + [(.inc offset)] + caseT))])]) + ([0 #.Left left] + [1 #.Right right]) + ))) + +(def: #export (and pre post) + (All [a b] (-> (Writer a) (Writer b) (Writer [a b]))) + (function (_ [preV postV]) + (\ ..monoid compose (pre preV) (post postV)))) + +(def: #export (rec body) + (All [a] (-> (-> (Writer a) (Writer a)) (Writer a))) + (function (recur value) + (body recur value))) + +(def: #export any + (Writer Any) + (function.constant ..no_op)) + +(def: #export bit + (Writer Bit) + (|>> (case> #0 0 #1 1) ..bits/8)) + +(template [ ] + [(def: #export (Writer ) ..bits/64)] + + [nat Nat] + [int Int] + [rev Rev] + ) + +(def: #export frac + (Writer Frac) + (|>> frac.to_bits ..bits/64)) + +(def: #export (segment size) + (-> Nat (Writer Binary)) + (function (_ value) + [size + (function (_ [offset binary]) + [(n.+ size offset) + (try.assume + (binary.copy (n.min size (binary.size value)) + 0 + value + offset + binary))])])) + +(template [ ] + [(def: #export + (Writer Binary) + (let [mask (..mask )] + (function (_ value) + (let [size (|> value binary.size (i64.and mask)) + size' (n.+ size)] + [size' + (function (_ [offset binary]) + [(n.+ size' offset) + (try.assume + (do try.monad + [_ ( offset size binary)] + (binary.copy size 0 value (n.+ offset) binary)))])]))))] + + [binary/8 ..bits/8 /.size/8 binary.write/8] + [binary/16 ..bits/16 /.size/16 binary.write/16] + [binary/32 ..bits/32 /.size/32 binary.write/32] + [binary/64 ..bits/64 /.size/64 binary.write/64] + ) + +(template [ ] + [(def: #export + (Writer Text) + (|>> (\ utf8.codec encode) ))] + + [utf8/8 ..binary/8] + [utf8/16 ..binary/16] + [utf8/32 ..binary/32] + [utf8/64 ..binary/64] + ) + +(def: #export text ..utf8/64) + +(template [ ] + [(def: #export ( valueW) + (All [v] (-> (Writer v) (Writer (Row v)))) + (function (_ value) + (let [original_count (row.size value) + capped_count (i64.and (..mask ) + original_count) + value (if (n.= original_count capped_count) + value + (|> value row.to_list (list.take capped_count) row.from_list)) + (^open "specification\.") ..monoid + [size mutation] (|> value + (row\map valueW) + (\ row.fold fold + (function (_ post pre) + (specification\compose pre post)) + specification\identity))] + [(n.+ size) + (function (_ [offset binary]) + (try.assume + (do try.monad + [_ ( offset capped_count binary)] + (wrap (mutation [(n.+ offset) binary])))))])))] + + [row/8 /.size/8 binary.write/8] + [row/16 /.size/16 binary.write/16] + [row/32 /.size/32 binary.write/32] + [row/64 /.size/64 binary.write/64] + ) + +(def: #export maybe + (All [a] (-> (Writer a) (Writer (Maybe a)))) + (..or ..any)) + +(def: #export (list value) + (All [a] (-> (Writer a) (Writer (List a)))) + (..rec + (|>> (..and value) + (..or ..any)))) + +(def: #export (set value) + (All [a] (-> (Writer a) (Writer (Set a)))) + (|>> set.to_list (..list value))) + +(def: #export name + (Writer Name) + (..and ..text ..text)) + +(def: #export type + (Writer Type) + (..rec + (function (_ recur) + (let [pair (..and recur recur) + indexed ..nat + quantified (..and (..list recur) recur)] + (function (_ altV) + (case altV + (^template [ ] + [( caseV) + (let [[caseS caseT] ( caseV)] + [(.inc caseS) + (function (_ [offset binary]) + (|> binary + (binary.write/8 offset ) + try.assume + [(.inc offset)] + caseT))])]) + ([0 #.Primitive (..and ..text (..list recur))] + [1 #.Sum pair] + [2 #.Product pair] + [3 #.Function pair] + [4 #.Parameter indexed] + [5 #.Var indexed] + [6 #.Ex indexed] + [7 #.UnivQ quantified] + [8 #.ExQ quantified] + [9 #.Apply pair] + [10 #.Named (..and ..name recur)]) + )))))) + +(def: #export location + (Writer Location) + ($_ ..and ..text ..nat ..nat)) + +(def: #export code + (Writer Code) + (..rec + (function (_ recur) + (let [sequence (..list recur)] + (..and ..location + (function (_ altV) + (case altV + (^template [ ] + [( caseV) + (let [[caseS caseT] ( caseV)] + [(.inc caseS) + (function (_ [offset binary]) + (|> binary + (binary.write/8 offset ) + try.assume + [(.inc offset)] + caseT))])]) + ([0 #.Bit ..bit] + [1 #.Nat ..nat] + [2 #.Int ..int] + [3 #.Rev ..rev] + [4 #.Frac ..frac] + [5 #.Text ..text] + [6 #.Identifier ..name] + [7 #.Tag ..name] + [8 #.Form sequence] + [9 #.Tuple sequence] + [10 #.Record (..list (..and recur recur))]) + ))))))) diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux new file mode 100644 index 000000000..041feace9 --- /dev/null +++ b/stdlib/source/library/lux/data/format/css.lux @@ -0,0 +1,126 @@ +(.module: + [library + [lux (#- and) + [data + ["." maybe] + [number + ["." nat]] + ["." text + ["%" format (#+ format)] + ["." encoding (#+ Encoding)]] + [collection + ["." list ("#\." functor)]]] + [type + abstract] + [world + [net (#+ URL)]]]] + ["." / #_ + ["#." selector (#+ Selector Combinator)] + ["#." value (#+ Value Animation Percentage)] + ["#." font (#+ Font)] + ["#." style (#+ Style)] + ["#." query (#+ Query)]]) + +(abstract: #export Common Any) +(abstract: #export Special Any) + +(abstract: #export (CSS brand) + Text + + (def: #export css (-> (CSS Any) Text) (|>> :representation)) + + (def: #export empty (CSS Common) (:abstraction "")) + + (def: #export (rule selector style) + (-> (Selector Any) Style (CSS Common)) + (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}"))) + + (def: #export char-set + (-> Encoding (CSS Special)) + (|>> encoding.name + %.text + (text.enclose ["@charset " ";"]) + :abstraction)) + + (def: #export (font font) + (-> Font (CSS Special)) + (let [with-unicode (case (get@ #/font.unicode-range font) + (#.Some unicode-range) + (let [unicode-range' (format "U+" (\ nat.hex encode (get@ #/font.start unicode-range)) + "-" (\ nat.hex encode (get@ #/font.end unicode-range)))] + (list ["unicode-range" unicode-range'])) + + #.None + (list))] + (|> (list& ["font-family" (get@ #/font.family font)] + ["src" (format "url(" (get@ #/font.source font) ")")] + ["font-stretch" (|> font (get@ #/font.stretch) (maybe.default /value.normal-stretch) /value.value)] + ["font-style" (|> font (get@ #/font.style) (maybe.default /value.normal-style) /value.value)] + ["font-weight" (|> font (get@ #/font.weight) (maybe.default /value.normal-weight) /value.value)] + with-unicode) + (list\map (function (_ [property value]) + (format property ": " value ";"))) + (text.join-with /style.separator) + (text.enclose ["{" "}"]) + (format "@font-face") + :abstraction))) + + (def: #export (import url query) + (-> URL (Maybe Query) (CSS Special)) + (:abstraction (format (format "@import url(" (%.text url) ")") + (case query + (#.Some query) + (format " " (/query.query query)) + + #.None + "") + ";"))) + + (def: css-separator text.new-line) + + (type: #export Frame + {#when Percentage + #what Style}) + + (def: #export (key-frames animation frames) + (-> (Value Animation) (List Frame) (CSS Special)) + (:abstraction (format "@keyframes " (/value.value animation) " {" + (|> frames + (list\map (function (_ frame) + (format (/value.percentage (get@ #when frame)) " {" + (/style.inline (get@ #what frame)) + "}"))) + (text.join-with ..css-separator)) + "}"))) + + (template: (!compose 
 )
+    (:abstraction (format (:representation 
) ..css-separator
+                          (:representation ))))
+  
+  (def: #export (and pre post)
+    (-> (CSS Any) (CSS Any) (CSS Any))
+    (!compose pre post))
+
+  (def: #export (alter combinator selector css)
+    (-> Combinator (Selector Any) (CSS Common) (CSS Common))
+    (|> css
+        :representation
+        (text.split-all-with ..css-separator)
+        (list\map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag "")))))))
+        (text.join-with ..css-separator)
+        :abstraction))
+
+  (def: #export (dependent combinator selector style inner)
+    (-> Combinator (Selector Any) Style (CSS Common) (CSS Common))
+    (!compose (..rule selector style)
+              (..alter combinator selector inner)))
+
+  (template [ ]
+    [(def: #export 
+       (-> (Selector Any) Style (CSS Common) (CSS Common))
+       (..dependent ))]
+
+    [with-descendants /selector.in]
+    [with-children /selector.sub]
+    )
+  )
diff --git a/stdlib/source/library/lux/data/format/css/font.lux b/stdlib/source/library/lux/data/format/css/font.lux
new file mode 100644
index 000000000..c153ec0b8
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/font.lux
@@ -0,0 +1,26 @@
+(.module:
+  [library
+   [lux #*
+    [type
+     abstract]
+    [control
+     [parser
+      ["s" code]]]
+    ["." macro
+     [syntax (#+ syntax:)]]
+    [world
+     [net (#+ URL)]]]]
+  ["." // #_
+   ["#." value (#+ Value Font-Stretch Font-Style Font-Weight)]])
+
+(type: #export Unicode-Range
+  {#start Nat
+   #end Nat})
+
+(type: #export Font
+  {#family Text
+   #source URL
+   #stretch (Maybe (Value Font-Stretch))
+   #style (Maybe (Value Font-Style))
+   #weight (Maybe (Value Font-Weight))
+   #unicode-range (Maybe Unicode-Range)})
diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux
new file mode 100644
index 000000000..273ab75b8
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/property.lux
@@ -0,0 +1,503 @@
+(.module:
+  [library
+   [lux (#- All Cursor)
+    [control
+     [parser
+      ["s" code]]]
+    [type
+     abstract]
+    [macro
+     ["." template]
+     ["." code]
+     [syntax (#+ syntax:)]]]]
+  [//
+   [value (#+ All
+              Number
+              Length Thickness Time
+              Color
+              Location Fit
+              Slice
+              Alignment Animation-Direction
+              Animation Animation-Fill
+              Column-Fill Column-Span
+              Iteration Count
+              Play
+              Timing Visibility Attachment
+              Blend Span Image
+              Angle Repeat Border
+              Collapse Box-Decoration-Break Caption
+              Float Clear
+              Content
+              Cursor
+              Shadow Clip
+              Text-Direction
+              Display Empty
+              Filter
+              Flex-Direction Flex-Wrap
+              Font Font-Kerning Font-Size Font-Variant
+              Grid Grid-Content Grid-Flow Grid-Span Grid-Template
+              Hanging-Punctuation Hyphens Isolation
+              List-Style-Position List-Style-Type
+              Overflow Page-Break Pointer-Events
+              Position
+              Quotes
+              Resize Scroll-Behavior Table-Layout
+              Text-Align Text-Align-Last
+              Text-Decoration-Line Text-Decoration-Style
+              Text-Justification Text-Overflow Text-Transform
+              Transform Transform-Origin Transform-Style
+              Transition
+              Bidi User-Select
+              Vertical-Align
+              White-Space Word-Break Word-Wrap Writing-Mode
+              Z-Index)]])
+
+(syntax: (text-identifier {identifier s.text})
+  (wrap (list (code.local-identifier identifier))))
+
+(abstract: #export (Property brand)
+  Text
+
+  (def: #export name
+    (-> (Property Any) Text)
+    (|>> :representation))
+
+  (template [ + +]
+    [(`` (template [ ]
+           [(def: #export 
+              (Property )
+              (:abstraction ))]
+
+           (~~ (template.splice +))))
+
+     (with-expansions [ (template.splice +)]
+       (template []
+         [(`` (def: #export (~~ (text-identifier ))
+                (Property )
+                (:abstraction )))]
+         
+         ))]
+
+    [All
+     []
+     [["all"]]]
+
+    [Length
+     []
+     [["border-image-outset"]
+      ["border-image-width"]
+      ["bottom"]
+      ["column-gap"]
+      ["column-width"]
+      ["flex-basis"]
+      ["grid-column-gap"]
+      ["grid-gap"]
+      ["grid-row-gap"]
+      ["height"]
+      ["left"]
+      ["letter-spacing"]
+      ["line-height"]
+      ["margin"]
+      ["margin-bottom"]
+      ["margin-left"]
+      ["margin-right"]
+      ["margin-top"]
+      ["max-height"]
+      ["max-width"]
+      ["min-height"]
+      ["min-width"]
+      ["outline-offset"]
+      ["padding"]
+      ["padding-bottom"]
+      ["padding-left"]
+      ["padding-right"]
+      ["padding-top"]
+      ["perspective"]
+      ["right"]
+      ["text-indent"]
+      ["top"]
+      ["width"]
+      ["word-spacing"]]]
+
+    [Time
+     []
+     [["animation-delay"]
+      ["animation-duration"]
+      ["transition-delay"]
+      ["transition-duration"]]]
+
+    [Slice
+     []
+     [["border-image-slice"]]]
+
+    [Color
+     [[text-color "color"]]
+     [["background-color"]
+      ["border-color"]
+      ["border-bottom-color"]
+      ["border-left-color"]
+      ["border-right-color"]
+      ["border-top-color"]
+      ["caret-color"]
+      ["column-rule-color"]
+      ["outline-color"]
+      ["text-decoration-color"]]]
+
+    [Alignment
+     []
+     [["align-content"]
+      ["align-items"]
+      ["align-self"]
+      ["justify-content"]]]
+
+    [Animation
+     []
+     [["animation-name"]]]
+
+    [Animation-Direction
+     []
+     [["animation-direction"]]]
+
+    [Animation-Fill
+     []
+     [["animation-fill-mode"]]]
+
+    [Column-Fill
+     []
+     [["column-fill"]]]
+
+    [Column-Span
+     []
+     [["column-span"]]]
+
+    [Iteration
+     []
+     [["animation-iteration-count"]]]
+
+    [Count
+     []
+     [["column-count"]
+      ["flex-grow"]
+      ["flex-shrink"]
+      ["order"]
+      ["tab-size"]]]
+
+    [Play
+     []
+     [["animation-play-state"]]]
+
+    [Timing
+     []
+     [["animation-timing-function"]
+      ["transition-timing-function"]]]
+
+    [Visibility
+     []
+     [["backface-visibility"]
+      ["visibility"]]]
+
+    [Attachment
+     []
+     [["background-attachment"]]]
+
+    [Blend
+     []
+     [["background-blend-mode"]
+      ["mix-blend-mode"]]]
+
+    [Image
+     []
+     [["background-image"]
+      ["border-image-source"]
+      ["list-style-image"]]]
+
+    [Span
+     []
+     [["background-clip"]
+      ["background-origin"]
+      ["box-sizing"]]]
+
+    [Location
+     []
+     [["background-position"]
+      ["object-position"]
+      ["perspective-origin"]]]
+
+    [Repeat
+     []
+     [["background-repeat"]
+      ["border-image-repeat"]]]
+
+    [Fit
+     []
+     [["background-size"]
+      ["border-radius"]
+      ["border-bottom-left-radius"]
+      ["border-bottom-right-radius"]
+      ["border-top-left-radius"]
+      ["border-top-right-radius"]
+      ["border-spacing"]
+      ["object-fit"]]]
+
+    [Border
+     []
+     [["border-style"]
+      ["border-bottom-style"]
+      ["border-left-style"]
+      ["border-right-style"]
+      ["border-top-style"]
+      ["column-rule-style"]
+      ["outline-style"]]]
+
+    [Thickness
+     []
+     [["border-width"]
+      ["border-bottom-width"]
+      ["border-left-width"]
+      ["border-right-width"]
+      ["border-top-width"]
+      ["column-rule-width"]
+      ["outline-width"]]]
+
+    [Collapse
+     []
+     [["border-collapse"]]]
+
+    [Box-Decoration-Break
+     []
+     [["box-decoration-break"]]]
+
+    [Caption
+     []
+     [["caption-side"]]]
+
+    [Clear
+     []
+     [["clear"]]]
+
+    [Shadow
+     []
+     [["box-shadow"]
+      ["text-shadow"]]]
+    
+    [Clip
+     []
+     [["clip"]]]
+
+    [Content
+     []
+     [["counter-reset"]
+      ["counter-increment"]]]
+
+    [Cursor
+     []
+     [["cursor"]]]
+
+    [Text-Direction
+     [[text-direction "direction"]]
+     []]
+
+    [Display
+     []
+     [["display"]]]
+
+    [Empty
+     []
+     [["empty-cells"]]]
+
+    [Filter
+     []
+     [["filter"]]]
+
+    [Flex-Direction
+     []
+     [["flex-direction"]]]
+
+    [Flex-Wrap
+     []
+     [["flex-wrap"]]]
+
+    [Float
+     []
+     [["float"]]]
+
+    [Font
+     []
+     [["font-family"]]]
+
+    [Font-Kerning
+     []
+     [["font-kerning"]]]
+
+    [Font-Size
+     []
+     [["font-size"]]]
+
+    [Number
+     []
+     [["font-size-adjust"]
+      ["opacity"]]]
+
+    [Font-Variant
+     []
+     [["font-variant"]]]
+
+    [Grid
+     []
+     [["grid-area"]]]
+
+    [Grid-Content
+     []
+     [["grid-auto-columns"]
+      ["grid-auto-rows"]
+      ["grid-template-columns"]
+      ["grid-template-rows"]]]
+
+    [Grid-Flow
+     []
+     [["grid-auto-flow"]]]
+
+    [Grid-Span
+     []
+     [["grid-column-end"]
+      ["grid-column-start"]
+      ["grid-row-end"]
+      ["grid-row-start"]]]
+
+    [Grid-Template
+     []
+     [["grid-template-areas"]]]
+
+    [Hanging-Punctuation
+     []
+     [["hanging-punctuation"]]]
+
+    [Hyphens
+     []
+     [["hyphens"]]]
+
+    [Isolation
+     []
+     [["isolation"]]]
+
+    [List-Style-Position
+     []
+     [["list-style-position"]]]
+
+    [List-Style-Type
+     []
+     [["list-style-type"]]]
+
+    [Overflow
+     []
+     [["overflow"]
+      ["overflow-x"]
+      ["overflow-y"]]]
+
+    [Page-Break
+     []
+     [["page-break-after"]
+      ["page-break-before"]
+      ["page-break-inside"]]]
+
+    [Pointer-Events
+     []
+     [["pointer-events"]]]
+
+    [Position
+     []
+     [["position"]]]
+
+    [Quotes
+     []
+     [["quotes"]]]
+
+    [Resize
+     []
+     [["resize"]]]
+
+    [Scroll-Behavior
+     []
+     [["scroll-behavior"]]]
+
+    [Table-Layout
+     []
+     [["table-layout"]]]
+
+    [Text-Align
+     []
+     [["text-align"]]]
+
+    [Text-Align-Last
+     []
+     [["text-align-last"]]]
+
+    [Text-Decoration-Line
+     []
+     [["text-decoration-line"]]]
+
+    [Text-Decoration-Style
+     []
+     [["text-decoration-style"]]]
+
+    [Text-Justification
+     []
+     [["text-justify"]]]
+
+    [Text-Overflow
+     []
+     [["text-overflow"]]]
+
+    [Text-Transform
+     []
+     [["text-transform"]]]
+
+    [Transform
+     []
+     [["transform"]]]
+
+    [Transform-Origin
+     []
+     [["transform-origin"]]]
+
+    [Transform-Style
+     []
+     [["transform-style"]]]
+
+    [Transition
+     []
+     [["transition-property"]]]
+
+    [Bidi
+     []
+     [["unicode-bidi"]]]
+
+    [User-Select
+     []
+     [["user-select"]]]
+
+    [Vertical-Align
+     []
+     [["vertical-align"]]]
+
+    [White-Space
+     []
+     [["white-space"]]]
+
+    [Word-Break
+     []
+     [["word-break"]]]
+
+    [Word-Wrap
+     []
+     [["word-wrap"]]]
+
+    [Writing-Mode
+     []
+     [["writing-mode"]]]
+
+    [Z-Index
+     []
+     [["z-index"]]]
+    )
+  )
diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux
new file mode 100644
index 000000000..3e40701eb
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/query.lux
@@ -0,0 +1,135 @@
+(.module:
+  [library
+   [lux (#- and or not)
+    [control
+     [parser
+      ["s" code]]]
+    [data
+     [text
+      ["%" format (#+ format)]]]
+    [macro
+     ["." template]
+     ["." code]
+     [syntax (#+ syntax:)]]
+    [type
+     abstract]]]
+  ["." // #_
+   ["#." value (#+ Value Length Count Resolution Ratio
+                   Orientation Scan Boolean Update
+                   Block-Overflow Inline-Overflow
+                   Display-Mode Color-Gamut Inverted-Colors
+                   Pointer Hover
+                   Light Scripting Motion Color-Scheme)]])
+
+(syntax: (text-identifier {identifier s.text})
+  (wrap (list (code.local-identifier identifier))))
+
+(abstract: #export Media
+  Text
+
+  (def: #export media
+    (-> Media Text)
+    (|>> :representation))
+
+  (template []
+    [(`` (def: #export (~~ (text-identifier ))
+           Media
+           (:abstraction )))]
+
+    ["all"]
+    ["print"]
+    ["screen"]
+    ["speech"]
+    ))
+
+(abstract: #export Feature
+  Text
+
+  (def: #export feature
+    (-> Feature Text)
+    (|>> :representation))
+
+  (template [ ]
+    [(`` (def: #export ((~~ (text-identifier )) input)
+           (-> (Value ) Feature)
+           (:abstraction (format "("  ": " (//value.value input) ")"))))]
+
+    ["min-color" Count]
+    ["color" Count]
+    ["max-color" Count]
+
+    ["min-color-index" Count]
+    ["color-index" Count]
+    ["max-color-index" Count]
+
+    ["min-monochrome" Count]
+    ["monochrome" Count]
+    ["max-monochrome" Count]
+
+    ["min-height" Length]
+    ["height" Length]
+    ["max-height" Length]
+
+    ["min-width" Length]
+    ["width" Length]
+    ["max-width" Length]
+
+    ["min-resolution" Resolution]
+    ["resolution" Resolution]
+    ["max-resolution" Resolution]
+
+    ["aspect-ratio" Ratio]
+    ["max-aspect-ratio" Ratio]
+    ["min-aspect-ratio" Ratio]
+
+    ["display-mode" Display-Mode]
+    ["color-gamut" Color-Gamut]
+    ["grid" Boolean]
+    ["orientation" Orientation]
+    ["overflow-block" Block-Overflow]
+    ["overflow-inline" Inline-Overflow]
+    ["scan" Scan]
+    ["update" Update]
+    ["inverted-colors" Inverted-Colors]
+    ["pointer" Pointer]
+    ["any-pointer" Pointer]
+    ["hover" Hover]
+    ["any-hover" Hover]
+    ["light-level" Light]
+    ["scripting" Scripting]
+    ["prefers-reduced-motion" Motion]
+    ["prefers-color-scheme" Color-Scheme]
+    )
+  )
+
+(abstract: #export Query
+  Text
+
+  (def: #export query
+    (-> Query Text)
+    (|>> :representation))
+
+  (template [ ]
+    [(def: #export 
+       (-> Media Query)
+       (|>> ..media (format ) :abstraction))]
+
+    [except "not "]
+    [only "only "]
+    )
+
+  (def: #export not
+    (-> Feature Query)
+    (|>> ..feature (format "not ") :abstraction))
+
+  (template [ ]
+    [(def: #export ( left right)
+       (-> Query Query Query)
+       (:abstraction (format (:representation left)
+                             
+                             (:representation right))))]
+
+    [and " and "]
+    [or " or "]
+    )
+  )
diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux
new file mode 100644
index 000000000..2a0210f7a
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/selector.lux
@@ -0,0 +1,205 @@
+(.module:
+  [library
+   [lux (#- or and for is? not)
+    [data
+     ["." text
+      ["%" format (#+ format)]]
+     [number
+      ["i" int]]]
+    [type
+     abstract]
+    [macro
+     ["." template]]
+    ["." locale (#+ Locale)]]])
+
+(type: #export Label Text)
+
+(type: #export Tag Label)
+(type: #export ID Label)
+(type: #export Class Label)
+(type: #export Attribute Label)
+
+(abstract: #export (Generic brand) Any)
+
+(template [ ]
+  [(abstract:  Any)
+   (type: #export  (Generic ))]
+
+  [Can-Chain Can-Chain']
+  [Cannot-Chain Cannot-Chain']
+  )
+
+(abstract: #export Unique Any)
+(abstract: #export Specific Any)
+(abstract: #export Composite Any)
+
+(abstract: #export (Selector kind)
+  Text
+
+  (def: #export selector
+    (-> (Selector Any) Text)
+    (|>> :representation))
+
+  (def: #export any
+    (Selector Cannot-Chain)
+    (:abstraction "*"))
+
+  (def: #export tag
+    (-> Tag (Selector Cannot-Chain))
+    (|>> :abstraction))
+
+  (template [   ]
+    [(def: #export 
+       (->  (Selector ))
+       (|>> (format ) :abstraction))]
+
+    [id ID "#" Unique]
+    [class Class "." Can-Chain]
+    )
+
+  (template [   +]
+    [(`` (template [ ]
+           [(def: #export ( right left)
+              (-> (Selector ) (Selector ) (Selector ))
+              (:abstraction (format (:representation left)
+                                    
+                                    (:representation right))))]
+
+           (~~ (template.splice +))))]
+
+    [Can-Chain (Generic Any) Can-Chain
+     [["" and]]]
+    [Unique (Generic Any) Composite
+     [["" for]]]
+    [Specific (Generic Any) Composite
+     [["" at]]]
+    [Any Any Composite
+     [["," or]
+      [" " in]
+      [">" sub]
+      ["+" next]
+      ["~" later]]]
+    )
+
+  (type: #export Combinator
+    (-> (Selector Any) (Selector Any) (Selector Composite)))
+
+  (def: #export (with? attribute)
+    (-> Attribute (Selector Can-Chain))
+    (:abstraction (format "[" attribute "]")))
+
+  (template [ ]
+    [(def: #export ( attribute value)
+       (-> Attribute Text (Selector Can-Chain))
+       (:abstraction (format "[" attribute  value "]")))]
+
+    ["=" is?]
+    ["~=" has?]
+    ["|=" has-start?]
+    ["^=" starts?]
+    ["$=" ends?]
+    ["*=" contains?]
+    )
+
+  (template [ +]
+    [(`` (template [ ]
+           [(def: #export 
+              (Selector Can-Chain)
+              (:abstraction ))]
+
+           (~~ (template.splice +))))]
+
+    [Can-Chain
+     [[active ":active"]
+      [checked ":checked"]
+      [default ":default"]
+      [disabled ":disabled"]
+      [empty ":empty"]
+      [enabled ":enabled"]
+      [first-child ":first-child"]
+      [first-of-type ":first-of-type"]
+      [focused ":focus"]
+      [hovered ":hover"]
+      [in-range ":in-range"]
+      [indeterminate ":indeterminate"]
+      [invalid ":invalid"]
+      [last-child ":last-child"]
+      [last-of-type ":last-of-type"]
+      [link ":link"]
+      [only-of-type ":only-of-type"]
+      [only-child ":only-child"]
+      [optional ":optional"]
+      [out-of-range ":out-of-range"]
+      [read-only ":read-only"]
+      [read-write ":read-write"]
+      [required ":required"]
+      [root ":root"]
+      [target ":target"]
+      [valid ":valid"]
+      [visited ":visited"]]]
+    
+    [Specific
+     [[after "::after"]
+      [before "::before"]
+      [first-letter "::first-letter"]
+      [first-line "::first-line"]
+      [placeholder "::placeholder"]
+      [selection "::selection"]]]
+    )
+
+  (def: #export (language locale)
+    (-> Locale (Selector Can-Chain))
+    (|> locale
+        locale.code
+        (text.enclose ["(" ")"])
+        (format ":lang")
+        :abstraction))
+
+  (def: #export not
+    (-> (Selector Any) (Selector Can-Chain))
+    (|>> :representation
+         (text.enclose ["(" ")"])
+         (format ":not")
+         :abstraction))
+
+  (abstract: #export Index
+    Text
+
+    (def: #export index
+      (-> Nat Index)
+      (|>> %.nat :abstraction))
+
+    (template [ ]
+      [(def: #export  Index (:abstraction ))]
+      
+      [odd "odd"]
+      [even "even"]
+      )
+
+    (type: #export Formula
+      {#constant Int
+       #variable Int})
+
+    (def: #export (formula input)
+      (-> Formula Index)
+      (let [(^slots [#constant #variable]) input]
+        (:abstraction (format (if (i.< +0 variable)
+                                (%.int variable)
+                                (%.nat (.nat variable)))
+                              (%.int constant)))))
+    
+    (template [ ]
+      [(def: #export ( index)
+         (-> Index (Selector Can-Chain))
+         (|> (:representation index)
+             (text.enclose ["(" ")"])
+             (format )
+             (:abstraction Selector)))]
+
+      [nth-child ":nth-child"]
+      [nth-last-child ":nth-last-child"]
+      [nth-last-of-type ":nth-last-of-type"]
+      [nth-of-type ":nth-of-type"]
+      )
+    )
+  )
diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux
new file mode 100644
index 000000000..5f2c68888
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/style.lux
@@ -0,0 +1,36 @@
+(.module:
+  [library
+   [lux #*
+    [data
+     [text
+      ["%" format (#+ format)]]]
+    [type
+     abstract]]]
+  ["." // #_
+   ["#." value (#+ Value)]
+   ["#." property (#+ Property)]])
+
+(abstract: #export Style
+  Text
+
+  {#.doc "The style associated with a CSS selector."}
+
+  (def: #export empty
+    Style
+    (:abstraction ""))
+
+  (def: #export separator
+    " ")
+
+  (def: #export (with [property value])
+    (All [brand]
+      (-> [(Property brand) (Value brand)]
+          (-> Style Style)))
+    (|>> :representation
+         (format (//property.name property) ": " (//value.value value) ";" ..separator)
+         :abstraction))
+
+  (def: #export inline
+    (-> Style Text)
+    (|>> :representation))
+  )
diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux
new file mode 100644
index 000000000..f85272a04
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/css/value.lux
@@ -0,0 +1,1329 @@
+(.module:
+  [library
+   [lux (#- All Cursor and static false true)
+    [control
+     [parser
+      ["s" code]]]
+    [data
+     ["." color]
+     ["." product]
+     ["." maybe]
+     [number
+      ["n" nat]
+      ["i" int]
+      ["r" rev]
+      ["f" frac]]
+     ["." text
+      ["%" format (#+ Format format)]]
+     [collection
+      ["." list ("#\." functor)]]]
+    [type
+     abstract]
+    [macro
+     ["." template]
+     ["." code]
+     [syntax (#+ syntax:)]]
+    [world
+     [net (#+ URL)]]]]
+  [//
+   [selector (#+ Label)]])
+
+(syntax: (text-identifier {identifier s.text})
+  (wrap (list (code.local-identifier identifier))))
+
+(template: (enumeration:    + +)
+  (abstract: #export 
+    
+
+    (def: #export 
+      (->  )
+      (|>> :representation))
+
+    (`` (template [ ]
+          [(def: #export   (:abstraction ))]
+
+          (~~ (template.splice +))
+          ))
+
+    (template.splice +)))
+
+(template: (multi:   )
+  (def: #export ( pre post)
+    (-> (Value ) (Value ) (Value ))
+    (:abstraction (format (:representation pre)
+                          
+                          (:representation post)))))
+
+(def: (%number value)
+  (Format Frac)
+  (let [raw (%.frac value)]
+    (if (f.< +0.0 value)
+      raw
+      (|> raw (text.split 1) maybe.assume product.right))))
+
+(abstract: #export (Value brand)
+  Text
+
+  (def: #export value
+    (-> (Value Any) Text)
+    (|>> :representation))
+
+  (template [ ]
+    [(def: #export  Value (:abstraction ))]
+
+    [initial "initial"]
+    [inherit "inherit"]
+    [unset "unset"]
+    )
+  
+  (template [ + +]
+    [(abstract: #export  Any)
+
+     (`` (template [ ]
+           [(def: #export 
+              (Value )
+              (:abstraction ))]
+           
+           (~~ (template.splice +))))
+
+     (with-expansions [ (template.splice +)]
+       (template []
+         [(`` (def: #export (~~ (text-identifier ))
+                (Value )
+                (:abstraction )))]
+         
+         ))]
+
+    [All
+     []
+     []]
+
+    [Number
+     []
+     []]
+
+    [Length
+     []
+     []]
+
+    [Time
+     []
+     []]
+
+    [Thickness
+     []
+     [["medium"]
+      ["thin"]
+      ["thick"]]]
+
+    [Slice
+     [[full-slice "fill"]]
+     []]
+
+    [Alignment
+     [[auto-alignment "auto"]]
+     [["stretch"]
+      ["center"]
+      ["flex-start"]
+      ["flex-end"]
+      ["baseline"]
+      ["space-between"]
+      ["space-around"]]]
+
+    [Animation
+     []
+     []]
+
+    [Animation-Direction
+     [[normal-direction "normal"]]
+     [["reverse"]
+      ["alternate"]
+      ["alternate-reverse"]]]
+
+    [Animation-Fill
+     [[fill-forwards "forwards"]
+      [fill-backwards "backwards"]
+      [fill-both "both"]]
+     []]
+
+    [Column-Fill
+     []
+     [["balance"]
+      ["auto"]]]
+
+    [Column-Span
+     []
+     [["all"]]]
+
+    [Iteration
+     []
+     [["infinite"]]]
+
+    [Count
+     []
+     []]
+
+    [Play
+     []
+     [["paused"]
+      ["running"]]]
+
+    [Timing
+     []
+     [["linear"]
+      ["ease"]
+      ["ease-in"]
+      ["ease-out"]
+      ["ease-in-out"]
+      ["step-start"]
+      ["step-end"]]]
+
+    [Visibility
+     [[invisible "hidden"]
+      [collapse-visibility "collapse"]]
+     [["visible"]]]
+
+    [Attachment
+     [[scroll-attachment "scroll"]
+      [fixed-attachment "fixed"]
+      [local-attachment "local"]]
+     []]
+
+    [Blend
+     [[normal-blend "normal"]]
+     [["multiply"]
+      ["screen"]
+      ["overlay"]
+      ["darken"]
+      ["lighten"]
+      ["color-dodge"]
+      ["color-burn"]
+      ["difference"]
+      ["exclusion"]
+      ["hue"]
+      ["saturation"]
+      ["color"]
+      ["luminosity"]]]
+
+    [Span
+     []
+     [["border-box"]
+      ["padding-box"]
+      ["content-box"]]]
+
+    [Image
+     [[no-image "none"]]
+     []]
+
+    [Repeat
+     [[stretch-repeat "stretch"]]
+     [["repeat"]
+      ["repeat-x"]
+      ["repeat-y"]
+      ["no-repeat"]
+      ["space"]
+      ["round"]]]
+
+    [Location
+     [[left-top "left top"]
+      [left-center "left center"]
+      [left-bottom "left bottom"]
+      [right-top "right top"]
+      [right-center "right center"]
+      [right-bottom "right bottom"]
+      [center-top "center top"]
+      [center-center "center center"]
+      [center-bottom "center bottom"]]
+     []]
+
+    [Fit
+     [[no-fit "none"]]
+     [["fill"]
+      ["cover"]
+      ["contain"]
+      ["scale-down"]]]
+
+    [Border
+     []
+     [["hidden"]
+      ["dotted"]
+      ["dashed"]
+      ["solid"]
+      ["double"]
+      ["groove"]
+      ["ridge"]
+      ["inset"]
+      ["outset"]]]
+
+    [Collapse
+     []
+     [["separate"]
+      ["collapse"]]]
+
+    [Box-Decoration-Break
+     []
+     [["slice"]
+      ["clone"]]]
+
+    [Caption
+     []
+     [["top"]
+      ["bottom"]]]
+
+    [Float
+     [[float-left "left"]
+      [float-right "right"]]
+     []]
+
+    [Clear
+     [[clear-left "left"]
+      [clear-right "right"]
+      [clear-both "both"]]
+     []]
+
+    [Counter
+     []
+     []]
+
+    [Content
+     []
+     [["open-quote"]
+      ["close-quote"]
+      ["no-open-quote"]
+      ["no-close-quote"]]]
+
+    [Cursor
+     [[horizontal-text "text"]
+      [no-cursor "none"]]
+     [["alias"]
+      ["all-scroll"]
+      ["cell"]
+      ["context-menu"]
+      ["col-resize"]
+      ["copy"]
+      ["crosshair"]
+      ["default"]
+      ["e-resize"]
+      ["ew-resize"]
+      ["grab"]
+      ["grabbing"]
+      ["help"]
+      ["move"]
+      ["n-resize"]
+      ["ne-resize"]
+      ["nesw-resize"]
+      ["ns-resize"]
+      ["nw-resize"]
+      ["nwse-resize"]
+      ["no-drop"]
+      ["not-allowed"]
+      ["pointer"]
+      ["progress"]
+      ["row-resize"]
+      ["s-resize"]
+      ["se-resize"]
+      ["sw-resize"]
+      ["vertical-text"]
+      ["w-resize"]
+      ["wait"]
+      ["zoom-in"]
+      ["zoom-out"]]]
+
+    [Shadow
+     []
+     []]
+
+    [Clip
+     []
+     []]
+
+    [Text-Direction
+     [[left-to-right "ltr"]
+      [right-to-left "rtl"]]
+     []]
+
+    [Display
+     [[grid-display "grid"]
+      [no-display "none"]]
+     [["inline"]
+      ["block"]
+      ["contents"]
+      ["flex"]
+      ["inline-block"]
+      ["inline-flex"]
+      ["inline-grid"]
+      ["inline-table"]
+      ["list-item"]
+      ["run-in"]
+      ["table"]
+      ["table-caption"]
+      ["table-column-group"]
+      ["table-header-group"]
+      ["table-footer-group"]
+      ["table-row-group"]
+      ["table-cell"]
+      ["table-column"]
+      ["table-row"]]]
+
+    [Empty
+     []
+     [["show"]
+      ["hide"]]]
+
+    [Filter
+     []
+     []]
+
+    [Flex-Direction
+     []
+     [["row"]
+      ["row-reverse"]
+      ["column"]
+      ["column-reverse"]]]
+
+    [Flex-Wrap
+     [[no-wrap "nowrap"]]
+     [["wrap"]
+      ["wrap-reverse"]]]
+
+    [Font-Kerning
+     [[auto-kerning "auto"]
+      [normal-kerning "normal"]
+      [no-kerning "none"]]
+     []]
+
+    [Font-Size
+     [[medium-size "medium"]
+      [xx-small-size "xx-small"]
+      [x-small-size "x-small"]
+      [small-size "small"]
+      [large-size "large"]
+      [x-large-size "x-large"]
+      [xx-large-size "xx-large"]
+      [smaller-size "smaller"]
+      [larger-size "larger"]]
+     []]
+
+    [Font-Stretch
+     [[normal-stretch "normal"]]
+     [["condensed"]
+      ["ultra-condensed"]
+      ["extra-condensed"]
+      ["semi-condensed"]
+      ["expanded"]
+      ["semi-expanded"]
+      ["extra-expanded"]
+      ["ultra-expanded"]]]
+
+    [Font-Style
+     [[normal-style "normal"]]
+     [["italic"]
+      ["oblique"]]]
+
+    [Font-Weight
+     [[normal-weight "normal"]
+      [weight-100 "100"]
+      [weight-200 "200"]
+      [weight-300 "300"]
+      [weight-400 "400"]
+      [weight-500 "500"]
+      [weight-600 "600"]
+      [weight-700 "700"]
+      [weight-800 "800"]
+      [weight-900 "900"]]
+     [["bold"]]]
+
+    [Font-Variant
+     [[normal-font "normal"]]
+     [["small-caps"]]]
+
+    [Grid
+     []
+     []]
+
+    [Grid-Content
+     [[auto-content "auto"]]
+     [["max-content"]
+      ["min-content"]]]
+
+    [Grid-Flow
+     [[row-flow "row"]
+      [column-flow "column"]
+      [dense-flow "dense"]
+      [row-dense-flow "row dense"]
+      [column-dense-flow "column dense"]]
+     []]
+
+    [Grid-Span
+     [[auto-span "auto"]]
+     []]
+
+    [Grid-Template
+     []
+     []]
+
+    [Hanging-Punctuation
+     [[no-hanging-punctuation "none"]]
+     [["first"]
+      ["last"]
+      ["allow-end"]
+      ["force-end"]]]
+
+    [Hyphens
+     [[no-hyphens "none"]
+      [manual-hyphens "manual"]
+      [auto-hyphens "auto"]]
+     []]
+
+    [Orientation
+     []
+     [["portrait"]
+      ["landscape"]]]
+
+    [Resolution
+     []
+     []]
+
+    [Scan
+     []
+     [["interlace"]
+      ["progressive"]]]
+
+    [Boolean
+     [[false "0"]
+      [true "1"]]
+     []]
+
+    [Update
+     [[no-update "none"]
+      [slow-update "slow"]
+      [fast-update "fast"]]
+     []]
+
+    [Block-Overflow
+     [[no-block-overflow "none"]
+      [scroll-block-overflow "scroll"]
+      [optional-paged-block-overflow "optional-paged"]
+      [paged-block-overflow "paged"]]
+     []]
+
+    [Inline-Overflow
+     [[no-inline-overflow "none"]
+      [scroll-inline-overflow "scroll"]]
+     []]
+
+    [Display-Mode
+     []
+     [["fullscreen"]
+      ["standalone"]
+      ["minimal-ui"]
+      ["browser"]]]
+
+    [Color-Gamut
+     []
+     [["srgb"]
+      ["p3"]
+      ["rec2020"]]]
+
+    [Inverted-Colors
+     [[no-inverted-colors "none"]
+      [inverted-colors "inverted"]]
+     []]
+
+    [Pointer
+     [[no-pointer "none"]
+      [coarse-pointer "coarse"]
+      [fine-pointer "fine"]]
+     []]
+
+    [Hover
+     [[no-hover "none"]]
+     [["hover"]]]
+
+    [Light
+     [[dim-light "dim"]
+      [normal-light "normal"]
+      [washed-light "washed"]]
+     []]
+
+    [Ratio
+     []
+     []]
+
+    [Scripting
+     [[no-scripting "none"]
+      [initial-scripting-only "initial-only"]
+      [scripting-enabled "enabled"]]
+     []]
+
+    [Motion
+     [[no-motion-preference "no-preference"]
+      [reduced-motion "reduce"]]
+     []]
+
+    [Color-Scheme
+     [[no-color-scheme-preference "no-preference"]
+      [light-color-scheme "light"]
+      [dark-color-scheme "dark"]]
+     []]
+
+    [Isolation
+     [[auto-isolation "auto"]]
+     [["isolate"]]]
+
+    [List-Style-Position
+     []
+     [["inside"]
+      ["outside"]]]
+
+    [List-Style-Type
+     [[no-list-style "none"]]
+     [["disc"]
+      ["armenian"]
+      ["circle"]
+      ["cjk-ideographic"]
+      ["decimal"]
+      ["decimal-leading-zero"]
+      ["georgian"]
+      ["hebrew"]
+      ["hiragana"]
+      ["hiragana-iroha"]
+      ["katakana"]
+      ["katakana-iroha"]
+      ["lower-alpha"]
+      ["lower-greek"]
+      ["lower-latin"]
+      ["lower-roman"]
+      ["square"]
+      ["upper-alpha"]
+      ["upper-greek"]
+      ["upper-latin"]
+      ["upper-roman"]]]
+
+    [Color
+     []
+     []]
+
+    [Overflow
+     [[visible-overflow "visible"]
+      [hidden-overflow "hidden"]
+      [scroll-overflow "scroll"]
+      [auto-overflow "auto"]]
+     []]
+
+    [Page-Break
+     [[auto-page-break "auto"]
+      [always-page-break "always"]
+      [avoid-page-break "avoid"]
+      [left-page-break "left"]
+      [right-page-break "right"]]
+     []]
+
+    [Pointer-Events
+     [[auto-pointer-events "auto"]
+      [no-pointer-events "none"]]
+     []]
+
+    [Position
+     []
+     [["static"]
+      ["absolute"]
+      ["fixed"]
+      ["relative"]
+      ["sticky"]]]
+
+    [Quotes
+     [[no-quotes "none"]]
+     []]
+
+    [Resize
+     [[resize-none "none"]
+      [resize-both "both"]
+      [resize-horizontal "horizontal"]
+      [resize-vertical "vertical"]]
+     []]
+
+    [Scroll-Behavior
+     [[auto-scroll-behavior "auto"]
+      [smooth-scroll-behavior "smooth"]]
+     []]
+
+    [Table-Layout
+     [[auto-table-layout "auto"]
+      [fixed-table-layout "fixed"]]
+     []]
+
+    [Text-Align
+     [[left-text-align "left"]
+      [right-text-align "right"]
+      [center-text-align "center"]
+      [justify-text-align "justify"]]
+     []]
+
+    [Text-Align-Last
+     [[auto-text-align-last "auto"]
+      [left-text-align-last "left"]
+      [right-text-align-last "right"]
+      [center-text-align-last "center"]
+      [justify-text-align-last "justify"]
+      [start-text-align-last "start"]
+      [end-text-align-last "end"]]
+     []]
+
+    [Text-Decoration-Line
+     [[no-text-decoration-line "none"]
+      [underline-text-decoration-line "underline"]
+      [overline-text-decoration-line "overline"]
+      [line-through-text-decoration-line "line-through"]]
+     []]
+
+    [Text-Decoration-Style
+     [[solid-text-decoration-style "solid"]
+      [double-text-decoration-style "double"]
+      [dotted-text-decoration-style "dotted"]
+      [dashed-text-decoration-style "dashed"]
+      [wavy-text-decoration-style "wavy"]]
+     []]
+
+    [Text-Justification
+     [[auto-text-justification "auto"]
+      [inter-word-text-justification "inter-word"]
+      [inter-character-text-justification "inter-character"]
+      [no-text-justification "none"]]
+     []]
+
+    [Text-Overflow
+     [[clip-text-overflow "clip"]
+      [ellipsis-text-overflow "ellipsis"]]
+     []]
+
+    [Text-Transform
+     [[no-text-transform "none"]]
+     [["capitalize"]
+      ["uppercase"]
+      ["lowercase"]]]
+
+    [Transform
+     [[no-transform "none"]]
+     []]
+
+    [Transform-Origin
+     []
+     []]
+
+    [Transform-Style
+     []
+     [["flat"]
+      ["preserve-3d"]]]
+
+    [Transition
+     [[transition-none "none"]
+      [transition-all "all"]]
+     []]
+
+    [Bidi
+     [[bidi-normal "normal"]
+      [bidi-embed "embed"]
+      [bidi-isolate "isolate"]
+      [bidi-isolate-override "isolate-override"]
+      [bidi-plaintext "plaintext"]]
+     [["bidi-override"]]]
+
+    [User-Select
+     [[user-select-auto "auto"]
+      [user-select-none "none"]
+      [user-select-text "text"]
+      [user-select-all "all"]]
+     []]
+
+    [Vertical-Align
+     [[vertical-align-baseline "baseline"]
+      [vertical-align-sub "sub"]
+      [vertical-align-super "super"]
+      [vertical-align-top "top"]
+      [vertical-align-text-top "text-top"]
+      [vertical-align-middle "middle"]
+      [vertical-align-bottom "bottom"]
+      [vertical-align-text-bottom "text-bottom"]]
+     []]
+
+    [White-Space
+     [[normal-white-space "normal"]
+      [no-wrap-white-space "nowrap"]
+      [pre-white-space "pre"]
+      [pre-line-white-space "pre-line"]
+      [pre-wrap-white-space "pre-wrap"]]
+     []]
+
+    [Word-Break
+     [[normal-word-break "normal"]]
+     [["break-all"]
+      ["keep-all"]
+      ["break-word"]]]
+
+    [Word-Wrap
+     [[normal-word-wrap "normal"]
+      [break-word-word-wrap "break-word"]]
+     []]
+
+    [Writing-Mode
+     [[top-to-bottom-writing-mode "horizontal-tb"]
+      [left-to-right-writing-mode "vertical-rl"]
+      [right-to-left-writing-mode "vertical-lr"]]
+     []]
+
+    [Z-Index
+     []
+     []]
+    )
+
+  (def: value-separator ",")
+
+  (def: (apply name inputs)
+    (-> Text (List Text) Value)
+    (|> inputs
+        (text.join-with ..value-separator)
+        (text.enclose ["(" ")"])
+        (format name)
+        :abstraction))
+
+  (enumeration: Step Text
+    step
+    [[start "start"]
+     [end "end"]]
+    [])
+
+  (def: #export (steps intervals step)
+    (-> Nat Step (Value Timing))
+    (..apply "steps" (list (%.nat intervals) (..step step))))
+
+  (def: #export (cubic-bezier p0 p1 p2 p3)
+    (-> Frac Frac Frac Frac (Value Timing))
+    (|> (list p0 p1 p2 p3)
+        (list\map %number)
+        (..apply "cubic-bezier")))
+
+  (template [ ]
+    [(def: #export 
+       (-> Nat (Value ))
+       (|>> %.nat :abstraction))]
+
+    [iteration Iteration]
+    [count Count]
+    [slice-number/1 Slice]
+    [span-line Grid-Span]
+    )
+
+  (def: #export animation
+    (-> Label (Value Animation))
+    (|>> :abstraction))
+
+  (def: #export (rgb color)
+    (-> color.Color (Value Color))
+    (let [[red green blue] (color.to-rgb color)]
+      (..apply "rgb" (list (%.nat red)
+                           (%.nat green)
+                           (%.nat blue)))))
+
+  (def: #export (rgba pigment)
+    (-> color.Pigment (Value Color))
+    (let [(^slots [#color.color #color.alpha]) pigment
+          [red green blue] (color.to-rgb color)]
+      (..apply "rgba" (list (%.nat red)
+                            (%.nat green)
+                            (%.nat blue)
+                            (if (r.= (\ r.interval top) alpha)
+                              "1.0"
+                              (format "0" (%.rev alpha)))))))
+
+  (template [ ]
+    [(def: #export ( value)
+       (-> Frac (Value Length))
+       (:abstraction (format (%number value) )))]
+
+    [em "em"]
+    [ex "ex"]
+    [rem "rem"]
+    [ch "ch"]
+    [vw "vw"]
+    [vh "vh"]
+    [vmin "vmin"]
+    [vmax "vmax"]
+    [% "%"]
+    [cm "cm"]
+    [mm "mm"]
+    [in "in"]
+    [px "px"]
+    [pt "pt"]
+    [pc "pc"]
+    [fr "fr"]
+    )
+
+  (def: (%int value)
+    (Format Int)
+    (if (i.< +0 value)
+      (%.int value)
+      (%.nat (.nat value))))
+
+  (template [ ]
+    [(def: #export ( value)
+       (-> Int (Value Time))
+       (:abstraction (format (if (i.< +0 value)
+                               (%.int value)
+                               (%.nat (.nat value)))
+                             )))]
+
+    
+    [seconds "s"]
+    [milli-seconds "ms"]
+    )
+
+  (def: #export thickness
+    (-> (Value Length) (Value Thickness))
+    (|>> :transmutation))
+
+  (def: slice-separator " ")
+
+  (def: #export (slice-number/2 horizontal vertical)
+    (-> Nat Nat (Value Slice))
+    (:abstraction (format (%.nat horizontal) ..slice-separator
+                          (%.nat vertical))))
+
+  (abstract: #export Stop
+    Text
+
+    (def: #export stop
+      (-> (Value Color) Stop)
+      (|>> (:representation Value) (:abstraction Stop)))
+
+    (def: stop-separator " ")
+
+    (def: #export (single-stop length color)
+      (-> (Value Length) (Value Color) Stop)
+      (:abstraction (format (:representation Value color) ..stop-separator
+                            (:representation Value length))))
+
+    (def: #export (double-stop start end color)
+      (-> (Value Length) (Value Length) (Value Color) Stop)
+      (:abstraction (format (:representation Value color) ..stop-separator
+                            (:representation Value start) ..stop-separator
+                            (:representation Value end))))
+
+    (abstract: #export Hint
+      Text
+
+      (def: #export hint
+        (-> (Value Length) Hint)
+        (|>> (:representation Value) (:abstraction Hint)))
+
+      (def: (with-hint [hint stop])
+        (-> [(Maybe Hint) Stop] Text)
+        (case hint
+          #.None
+          (:representation Stop stop)
+          
+          (#.Some hint)
+          (format (:representation Hint hint) ..value-separator (:representation Stop stop))))))
+
+  (type: #export (List/1 a)
+    [a (List a)])
+
+  (abstract: #export Angle
+    Text
+
+    (def: #export angle
+      (-> Angle Text)
+      (|>> :representation))
+
+    (def: #export (turn value)
+      (-> Rev Angle)
+      (:abstraction (format (%.rev value) "turn")))
+
+    (def: degree-limit Nat 360)
+    
+    (def: #export (degree value)
+      (-> Nat Angle)
+      (:abstraction (format (%.nat (n.% ..degree-limit value)) "deg")))
+
+    (template [ ]
+      [(def: #export  Angle (..degree ))]
+      
+      [000 to-top]
+      [090 to-right]
+      [180 to-bottom]
+      [270 to-left]
+      )
+
+    (template [ ]
+      [(def: #export ( angle start next)
+         (-> Angle Stop (List/1 [(Maybe Hint) Stop]) (Value Image))
+         (let [[now after] next]
+           (..apply  (list& (:representation Angle angle)
+                                      (with-hint now)
+                                      (list\map with-hint after)))))]
+
+      [linear-gradient "linear-gradient"]
+      [repeating-linear-gradient "repeating-linear-gradient"]
+      )
+    )
+
+  (abstract: #export Percentage
+    Text
+
+    (def: #export percentage
+      (-> Percentage Text)
+      (|>> :representation))
+
+    (def: percentage-limit Nat (.inc 100))
+
+    (def: #export (%% value)
+      (-> Nat Percentage)
+      (:abstraction (format (%.nat (n.% percentage-limit value)) "%")))
+
+    (def: #export slice-percent/1
+      (-> Percentage (Value Slice))
+      (|>> :representation (:abstraction Value)))
+
+    (def: #export (slice-percent/2 horizontal vertical)
+      (-> Percentage Percentage (Value Slice))
+      (:abstraction Value (format (:representation horizontal) ..slice-separator
+                                  (:representation vertical))))
+
+    (template [ 
 +]
+      [(`` (template [ ]
+             [(def: #export 
+                (->  (Value Filter))
+                (|>> 
 (list) (..apply )))]
+
+             (~~ (template.splice +))))]
+
+      [Nat (<| (:representation Value) ..px n.frac)
+       [[blur "blur"]]]
+      [Nat (<| ..angle ..degree)
+       [[hue-rotate "hue-rotate"]]]
+      [Percentage (:representation Percentage)
+       [[brightness "brightness"]
+        [contrast "contrast"]
+        [grayscale "grayscale"]
+        [invert "invert"]
+        [opacity "opacity"]
+        [saturate "saturate"]
+        [sepia "sepia"]]]
+      )
+    )
+
+  (def: #export svg-filter
+    (-> URL (Value Filter))
+    (|>> (list) (..apply "url")))
+
+  (def: default-shadow-length (px +0.0))
+
+  (def: #export (drop-shadow horizontal vertical blur spread color)
+    (-> (Value Length) (Value Length)
+        (Maybe (Value Length)) (Maybe (Value Length))
+        (Value Color)
+        (Value Filter))
+    (|> (list (:representation horizontal)
+              (:representation vertical)
+              (|> blur (maybe.default ..default-shadow-length) :representation)
+              (|> spread (maybe.default ..default-shadow-length) :representation)
+              (:representation color))
+        (text.join-with " ")
+        (list)
+        (..apply "drop-shadow")))
+
+  (def: length-separator " ")
+
+  (template [ ]
+    [(def: #export ( horizontal vertical)
+       (-> (Value Length) (Value Length) (Value ))
+       (:abstraction (format (:representation horizontal)
+                             ..length-separator
+                             (:representation vertical))))]
+
+    [location Location]
+    [fit Fit]
+    )
+
+  (def: #export (fit/1 length)
+    (-> (Value Length) (Value Fit))
+    (..fit length length))
+
+  (def: #export image
+    (-> URL (Value Image))
+    (|>> %.text
+         (list)
+         (..apply "url")))
+
+  (enumeration: Shape Text
+    shape
+    [[ellipse-shape "ellipse"]
+     [circle-shape "circle"]]
+    [])
+
+  (enumeration: Extent Text
+    extent
+    [[closest-side "closest-side"]
+     [closest-corner "closest-corner"]
+     [farthest-side "farthest-side"]
+     [farthest-corner "farthest-corner"]]
+    [])
+
+  (template [ ]
+    [(def: #export ( shape extent location start next)
+       (-> Shape (Maybe Extent) (Value Location)
+           Stop (List/1 [(Maybe Hint) Stop])
+           (Value Image))
+       (let [after-extent (format "at " (:representation location))
+             with-extent (case extent
+                           (#.Some extent)
+                           (format (..extent extent) " " after-extent)
+                           
+                           #.None
+                           after-extent)
+             where (format (..shape shape) " " with-extent)
+             [now after] next]
+         (..apply  (list& (..shape shape)
+                                    (with-hint now)
+                                    (list\map with-hint after)))))]
+    
+    [radial-gradient "radial-gradient"]
+    [repeating-radial-gradient "repeating-radial-gradient"]
+    )
+
+  (def: #export (shadow horizontal vertical blur spread color inset?)
+    (-> (Value Length) (Value Length)
+        (Maybe (Value Length)) (Maybe (Value Length))
+        (Value Color) Bit
+        (Value Shadow))
+    (let [with-inset (if inset?
+                       (list "inset")
+                       (list))]
+      (|> (list& (:representation horizontal)
+                 (:representation vertical)
+                 (|> blur (maybe.default ..default-shadow-length) :representation)
+                 (|> spread (maybe.default ..default-shadow-length) :representation)
+                 (:representation color)
+                 with-inset)
+          (text.join-with " ")
+          :abstraction)))
+
+  (type: #export Rectangle
+    {#top (Value Length)
+     #right (Value Length)
+     #bottom (Value Length)
+     #left (Value Length)})
+
+  (def: #export (clip rectangle)
+    (-> Rectangle (Value Clip))
+    (`` (..apply "rect" (list (~~ (template []
+                                    [(:representation (get@  rectangle))]
+
+                                    [#top] [#right] [#bottom] [#left]))))))
+
+  (def: #export counter
+    (-> Label (Value Counter))
+    (|>> :abstraction))
+
+  (def: #export current-count
+    (-> (Value Counter) (Value Content))
+    (|>> :representation (list) (..apply "counter")))
+
+  (def: #export text
+    (-> Text (Value Content))
+    (|>> %.text :abstraction))
+
+  (def: #export attribute
+    (-> Label (Value Content))
+    (|>> (list) (..apply "attr")))
+
+  (def: #export media
+    (-> URL (Value Content))
+    (|>> (list) (..apply "url")))
+
+  (enumeration: Font Text
+    font-name
+    [[serif "serif"]
+     [sans-serif "sans-serif"]
+     [cursive "cursive"]
+     [fantasy "fantasy"]
+     [monospace "monospace"]]
+    [(def: #export font
+       (-> Text Font)
+       (|>> %.text :abstraction))
+
+     (def: #export (font-family options)
+       (-> (List Font) (Value Font))
+       (case options
+         (#.Cons _)
+         (|> options
+             (list\map ..font-name)
+             (text.join-with ",")
+             (:abstraction Value))
+         
+         #.Nil
+         ..initial))])
+
+  (def: #export font-size
+    (-> (Value Length) (Value Font-Size))
+    (|>> :transmutation))
+
+  (def: #export number
+    (-> Frac (Value Number))
+    (|>> %number :abstraction))
+
+  (def: #export grid
+    (-> Label (Value Grid))
+    (|>> :abstraction))
+
+  (def: #export fit-content
+    (-> (Value Length) (Value Grid-Content))
+    (|>> :representation (list) (..apply "fit-content")))
+
+  (def: #export (min-max min max)
+    (-> (Value Grid-Content) (Value Grid-Content) (Value Grid-Content))
+    (..apply "minmax" (list (:representation min)
+                            (:representation max))))
+
+  (def: #export grid-span
+    (-> Nat (Value Grid-Span))
+    (|>> %.nat (format "span ") :abstraction))
+
+  (def: grid-column-separator " ")
+  (def: grid-row-separator " ")
+
+  (def: #export grid-template
+    (-> (List (List (Maybe (Value Grid)))) (Value Grid-Template))
+    (let [empty (: (Value Grid)
+                   (:abstraction "."))]
+      (|>> (list\map (|>> (list\map (|>> (maybe.default empty)
+                                         :representation))
+                          (text.join-with ..grid-column-separator)
+                          (text.enclose ["'" "'"])))
+           (text.join-with ..grid-row-separator)
+           :abstraction)))
+
+  (def: #export (resolution dpi)
+    (-> Nat (Value Resolution))
+    (:abstraction (format (%.nat dpi) "dpi")))
+
+  (def: #export (ratio numerator denominator)
+    (-> Nat Nat (Value Ratio))
+    (:abstraction (format (%.nat numerator) "/" (%.nat denominator))))
+
+  (enumeration: Quote Text
+    quote-text
+    [[double-quote "\0022"]
+     [single-quote "\0027"]
+     [single-left-angle-quote "\2039"]
+     [single-right-angle-quote "\203A"]
+     [double-left-angle-quote "\00AB"]
+     [double-right-angle-quote "\00BB"]
+     [single-left-quote "\2018"]
+     [single-right-quote "\2019"]
+     [double-left-quote "\201C"]
+     [double-right-quote "\201D"]
+     [low-double-quote "\201E"]]
+    [(def: #export quote
+       (-> Text Quote)
+       (|>> :abstraction))])
+
+  (def: quote-separator " ")
+
+  (def: #export (quotes [left0 right0] [left1 right1])
+    (-> [Quote Quote] [Quote Quote] (Value Quotes))
+    (|> (list left0 right0 left1 right1)
+        (list\map (|>> ..quote-text %.text))
+        (text.join-with ..quote-separator)
+        :abstraction))
+
+  (def: #export (matrix-2d [a b] [c d] [tx ty])
+    (-> [Frac Frac]
+        [Frac Frac]
+        [Frac Frac]
+        (Value Transform))
+    (|> (list a b c d tx ty)
+        (list\map %number)
+        (..apply "matrix")))
+
+  (def: #export (matrix-3d [a0 b0 c0 d0] [a1 b1 c1 d1] [a2 b2 c2 d2] [a3 b3 c3 d3])
+    (-> [Frac Frac Frac Frac]
+        [Frac Frac Frac Frac]
+        [Frac Frac Frac Frac]
+        [Frac Frac Frac Frac]
+        (Value Transform))
+    (|> (list a0 b0 c0 d0 a1 b1 c1 d1 a2 b2 c2 d2 a3 b3 c3 d3)
+        (list\map %number)
+        (..apply "matrix3d")))
+
+  (template [   ]
+    [(`` (def: #export ( [(~~ (template.splice ))])
+           (-> [(~~ (template.splice ))] (Value Transform))
+           (|> (list (~~ (template.splice )))
+               (list\map %number)
+               (..apply ))))]
+
+    [translate-2d "translate" [Frac Frac] [x y]]
+    [translate-3d "translate3d" [Frac Frac Frac] [x y z]]
+    [translate-x "translateX" [Frac] [value]]
+    [translate-y "translateY" [Frac] [value]]
+    [translate-z "translateZ" [Frac] [value]]
+
+    [scale-2d "scale" [Frac Frac] [x y]]
+    [scale-3d "scale3d" [Frac Frac Frac] [x y z]]
+    [scale-x "scaleX" [Frac] [value]]
+    [scale-y "scaleY" [Frac] [value]]
+    [scale-z "scaleZ" [Frac] [value]]
+
+    [perspective "perspective" [Frac] [value]]
+    )
+
+  (template [   ]
+    [(`` (def: #export ( [(~~ (template.splice ))])
+           (-> [(~~ (template.splice ))] (Value Transform))
+           (|> (list (~~ (template.splice )))
+               (list\map ..angle)
+               (..apply ))))]
+
+    [rotate-2d "rotate" [Angle] [angle]]
+    [rotate-x "rotateX" [Angle] [angle]]
+    [rotate-y "rotateY" [Angle] [angle]]
+    [rotate-z "rotateZ" [Angle] [angle]]
+
+    [skew "skew" [Angle Angle] [x-angle y-angle]]
+    [skew-x "skewX" [Angle] [angle]]
+    [skew-y "skewY" [Angle] [angle]]
+    )
+
+  (def: #export (rotate-3d [x y z angle])
+    (-> [Frac Frac Frac Angle] (Value Transform))
+    (..apply "rotate3d"
+             (list (%number x) (%number y) (%number z) (..angle angle))))
+
+  (def: origin-separator " ")
+
+  (def: #export (origin-2d x y)
+    (-> (Value Length) (Value Length) (Value Transform-Origin))
+    (:abstraction (format (:representation x) ..origin-separator
+                          (:representation y))))
+
+  (def: #export (origin-3d x y z)
+    (-> (Value Length) (Value Length) (Value Length) (Value Transform-Origin))
+    (:abstraction (format (:representation x) ..origin-separator
+                          (:representation y) ..origin-separator
+                          (:representation z))))
+
+  (def: #export vertical-align
+    (-> (Value Length) (Value Vertical-Align))
+    (|>> :transmutation))
+
+  (def: #export (z-index index)
+    (-> Int (Value Z-Index))
+    (:abstraction (if (i.< +0 index)
+                    (%.int index)
+                    (%.nat (.nat index)))))
+
+  (multi: multi-image Image ",")
+  (multi: multi-shadow Shadow ",")
+  (multi: multi-content Content " ")
+  )
diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux
new file mode 100644
index 000000000..6a8e0b24f
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/html.lux
@@ -0,0 +1,563 @@
+(.module:
+  [library
+   [lux (#- Meta Source comment and)
+    ["." function]
+    [data
+     ["." product]
+     ["." maybe ("#\." functor)]
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [host
+     ["." js]]
+    [macro
+     ["." template]]
+    [world
+     [net (#+ URL)]]]]
+  [//
+   [css
+    ["." selector]
+    ["." style (#+ Style)]]
+   ["." xml (#+ XML)]])
+
+(type: #export Tag selector.Tag)
+(type: #export ID selector.ID)
+(type: #export Class selector.Class)
+
+(type: #export Attributes
+  {#.doc "Attributes for an HTML tag."}
+  (List [Text Text]))
+
+(type: #export Script js.Statement)
+
+(type: #export Target
+  #Blank
+  #Parent
+  #Self
+  #Top
+  (#Frame Text))
+
+(def: (target value)
+  (-> Target Text)
+  (case value
+    #Blank "_blank"
+    #Parent "_parent"
+    #Self "_self"
+    #Top "_top"
+    (#Frame name) name))
+
+(def: sanitize
+  {#.doc "Properly formats text to ensure no injection can happen on the HTML."}
+  (-> Text Text)
+  (|>> (text.replace-all "&" "&")
+       (text.replace-all "<" "<")
+       (text.replace-all ">" ">")
+       (text.replace-all text.double-quote """)
+       (text.replace-all "'" "'")
+       (text.replace-all "/" "/")))
+
+(def: attributes
+  (-> Attributes Text)
+  (|>> (list\map (function (_ [key val])
+                   (format key "=" text.double-quote (..sanitize val) text.double-quote)))
+       (text.join-with " ")))
+
+(def: (open tag attributes)
+  (-> Tag Attributes Text)
+  (|> attributes
+      ..attributes
+      (format tag " ")
+      (text.enclose ["<" ">"])))
+
+(def: close
+  (-> Tag Text)
+  (text.enclose [""]))
+
+(abstract: #export (HTML brand)
+  Text
+
+  (template [ ]
+    [(abstract: #export  Any)
+     (type: #export  (HTML ))]
+
+    [Meta Meta']
+    [Head Head']
+    [Item Item']
+    [Option Option']
+    [Input Input']
+    [Cell Cell']
+    [Header Header']
+    [Row Row']
+    [Column Column']
+    [Parameter Parameter']
+    [Body Body']
+    [Document Document']
+    )
+
+  (template [  +]
+    [(abstract: #export ( brand) Any)
+     (type: #export  (HTML ( Any)))
+
+     (`` (template [ ]
+           [(abstract: #export  Any)
+            (type: #export  (HTML ( )))]
+
+           (~~ (template.splice +))))]
+
+    [Element Element'
+     [[Content Content']
+      [Image Image']]]
+
+    [Media Media'
+     [[Source Source']
+      [Track Track']]]
+    )
+
+  (def: #export html
+    (-> Document Text)
+    (|>> :representation))
+
+  (def: #export (and pre post)
+    (All [brand] (-> (HTML brand) (HTML brand) (HTML brand)))
+    (:abstraction (format (:representation pre) (:representation post))))
+
+  (def: #export (comment content node)
+    (All [brand] (-> Text (HTML brand) (HTML brand)))
+    (:abstraction
+     (format (text.enclose [""] content)
+             (:representation node))))
+
+  (def: (empty name attributes)
+    (-> Tag Attributes HTML)
+    (:abstraction
+     (format (..open name attributes)
+             (..close name))))
+
+  (def: (simple tag attributes)
+    (-> Tag Attributes HTML)
+    (|> attributes
+        (..open tag)
+        :abstraction))
+
+  (def: (tag name attributes content)
+    (-> Tag Attributes (HTML Any) HTML)
+    (:abstraction
+     (format (..open name attributes)
+             (:representation content)
+             (..close name))))
+
+  (def: (raw tag attributes content)
+    (-> Text Attributes Text HTML)
+    (:abstraction
+     (format (..open tag attributes)
+             content
+             (..close tag))))
+
+  (template [  ]
+    [(def: #export 
+       (-> Attributes )
+       (..simple ))]
+
+    [link "link" Meta]
+    [meta "meta" Meta]
+    [input "input" Input]
+    [embedded "embed" Element]
+    [column "col" Column]
+    [parameter "param" Parameter]
+    )
+
+  (def: #export (base href target)
+    (-> URL (Maybe Target) Meta)
+    (let [partial (list ["href" href])
+          full (case target
+                 (#.Some target)
+                 (list& ["target" (..target target)] partial)
+                 
+                 #.None
+                 partial)]
+      (..simple "base" full)))
+
+  (def: #export style
+    (-> Style Meta)
+    (|>> style.inline (..raw "style" (list))))
+
+  (def: #export (script attributes inline)
+    (-> Attributes (Maybe Script) Meta)
+    (|> inline
+        (maybe\map js.code)
+        (maybe.default "")
+        (..raw "script" attributes)))
+
+  (def: #export text
+    (-> Text Content)
+    (|>> ..sanitize
+         :abstraction))
+
+  (template [  ]
+    [(def: #export 
+       Element
+       (..simple  (list)))
+
+     (def: #export  )]
+    ["br"  br  line-break]
+    ["wbr" wbr word-break]
+    ["hr"  hr  separator]
+    )
+
+  (def: #export (image source attributes)
+    (-> URL Attributes Image)
+    (|> attributes
+        (#.Cons ["src" source])
+        (..simple "img")))
+
+  (def: #export (svg attributes content)
+    (-> Attributes XML Element)
+    (|> content
+        (\ xml.codec encode)
+        (..raw "svg" attributes)))
+
+  (type: #export Coord
+    {#horizontal Nat
+     #vertical Nat})
+
+  (def: metric-separator ",")
+  (def: coord-separator ",")
+
+  (def: (%coord [horizontal vertical])
+    (Format Coord)
+    (format (%.nat horizontal) ..metric-separator (%.nat vertical)))
+  
+  (type: #export Rectangle
+    {#start Coord
+     #end Coord})
+
+  (type: #export Circle
+    {#center Coord
+     #radius Nat})
+
+  (type: #export Polygon
+    {#first Coord
+     #second Coord
+     #third Coord
+     #extra (List Coord)})
+
+  (def: (%rectangle [start end])
+    (Format Rectangle)
+    (format (%coord start) ..coord-separator (%coord end)))
+
+  (def: (%circle [center radius])
+    (Format Circle)
+    (format (%coord center) ..metric-separator (%.nat radius)))
+
+  (def: (%polygon [first second third extra])
+    (Format Polygon)
+    (|> (list& first second third extra)
+        (list\map %coord)
+        (text.join-with ..coord-separator)))
+  
+  (type: #export Shape
+    (#Rectangle Rectangle)
+    (#Circle Circle)
+    (#Polygon Polygon))
+
+  (template [   ]
+    [(def: ( attributes shape)
+       (-> Attributes  (HTML Any))
+       (..simple "area" (list& ["shape" ]
+                               ["coords" ( shape)]
+                               attributes)))]
+
+    [rectangle "rect" Rectangle ..%rectangle]
+    [circle "circle" Circle ..%circle]
+    [polygon "poly" Polygon ..%polygon]
+    )
+  
+  (def: (area attributes shape)
+    (-> Attributes Shape (HTML Any))
+    (case shape
+      (#Rectangle rectangle)
+      (..rectangle attributes rectangle)
+      
+      (#Circle circle)
+      (..circle attributes circle)
+      
+      (#Polygon polygon)
+      (..polygon attributes polygon)))
+
+  (def: #export (map attributes areas for)
+    (-> Attributes (List [Attributes Shape]) Image Image)
+    ($_ ..and
+        for
+        (case (list\map (product.uncurry ..area) areas)
+          #.Nil
+          (..empty "map" attributes)
+          
+          (#.Cons head tail)
+          (..tag "map" attributes
+                 (list\fold (function.flip ..and) head tail)))))
+
+  (template [  ]
+    [(def: #export 
+       (-> Attributes )
+       (..empty ))]
+
+    [canvas "canvas" Element]
+    [progress "progress" Element]
+    [output "output" Input]
+    [source "source" Source]
+    [track "track" Track]
+    )
+
+  (template [ ]
+    [(def: #export ( attributes media on-unsupported)
+       (-> Attributes Media (Maybe Content) Element)
+       (..tag  attributes
+              (|> on-unsupported
+                  (maybe.default (..text ""))
+                  (..and media))))]
+
+    [audio "audio"]
+    [video "video"]
+    )
+
+  (def: #export (picture attributes sources image)
+    (-> Attributes Source Image Element)
+    (..tag "picture" attributes (..and sources image)))
+
+  (def: #export (anchor href attributes content)
+    (-> URL Attributes Element Element)
+    (..tag "a" (list& ["href" href] attributes) content))
+
+  (def: #export label
+    (-> ID Input)
+    (|>> ["for"] list (..empty "label")))
+
+  (template [   ]
+    [(def: #export ( description attributes content)
+       (-> (Maybe Content) Attributes  )
+       (..tag  attributes
+              (case description
+                (#.Some description)
+                ($_ ..and
+                    (..tag  (list) description)
+                    content)
+                
+                #.None
+                content)))]
+
+    [details "details" "summary" Element]
+    [field-set "fieldset" "legend" Input]
+    [figure "figure" "figcaption" Element]
+    )
+
+  (template [  ]
+    [(def: #export ( attributes content)
+       (-> Attributes (Maybe Content) )
+       (|> content
+           (maybe.default (..text ""))
+           (..tag  attributes)))]
+
+    [text-area "textarea" Input]
+    [iframe "iframe" Element]
+    )
+
+  (type: #export Phrase (-> Attributes Content Element))
+
+  (template [ ]
+    [(def: #export 
+       Phrase
+       (..tag ))]
+
+    [abbrebiation "abbr"]
+    [block-quote "blockquote"]
+    [bold "b"]
+    [cite "cite"]
+    [code "code"]
+    [definition "dfn"]
+    [deleted "del"]
+    [emphasized "em"]
+    [h1 "h1"]
+    [h2 "h2"]
+    [h3 "h3"]
+    [h4 "h4"]
+    [h5 "h5"]
+    [h6 "h6"]
+    [inserted "ins"]
+    [italic "i"]
+    [keyboard "kbd"]
+    [marked "mark"]
+    [meter "meter"]
+    [pre "pre"]
+    [quote "q"]
+    [sample "samp"]
+    [struck "s"]
+    [small "small"]
+    [sub "sub"]
+    [super "sup"]
+    [strong "strong"]
+    [time "time"]
+    [underlined "u"]
+    [variable "var"]
+    )
+
+  (def: #export incorrect ..struck)
+
+  (def: (ruby-pronunciation pronunciation)
+    (-> Content (HTML Any))
+    (..tag "rt" (list)
+           ($_ ..and
+               (..tag "rp" (list) (..text "("))
+               pronunciation
+               (..tag "rp" (list) (..text ")")))))
+
+  (def: #export (ruby attributes content pronunciation)
+    (-> Attributes Content Content Element)
+    (..tag "ruby" attributes
+           ($_ ..and
+               content
+               (ruby-pronunciation pronunciation))))
+
+  (type: #export Composite (-> Attributes Element Element))
+
+  (template [ ]
+    [(def: #export 
+       Composite
+       (..tag ))]
+
+    [article "article"]
+    [aside "aside"]
+    [dialog "dialog"]
+    [div "div"]
+    [footer "footer"]
+    [header "header"]
+    [main "main"]
+    [navigation "nav"]
+    [paragraph "p"]
+    [section "section"]
+    [span "span"]
+    )
+
+  (template [  ]
+    [(def: 
+       (->  (HTML Any))
+       (..tag  (list)))]
+
+    ["dt" term Content]
+    ["dd" description Element]
+    )
+
+  (def: #export (description-list attributes descriptions)
+    (-> Attributes (List [Content Element]) Element)
+    (case (list\map (function (_ [term description])
+                      ($_ ..and
+                          (..term term)
+                          (..description description)))
+                    descriptions)
+      #.Nil
+      (..empty "dl" attributes)
+      
+      (#.Cons head tail)
+      (..tag "dl" attributes
+             (list\fold (function.flip ..and) head tail))))
+
+  (def: #export p ..paragraph)
+
+  (template [   ]
+    [(def: #export 
+       (-> Attributes  )
+       (..tag ))]
+
+    [button "button" Element Input]
+    [item "li" Element Item]
+    [ordered-list "ol" Item Element]
+    [unordered-list "ul" Item Element]
+    [option "option" Content Option]
+    [option-group "optgroup" Option Option]
+    [data-list "datalist" Option Element]
+    [select "select" Option Input]
+    [address "address" Element Element]
+    [form "form" Input Element]
+    [data "data" Element Element]
+    [object "object" Parameter Element]
+    )
+
+  (template [   ]
+    [(def: #export 
+       (->  )
+       (..tag  (list)))]
+
+    [title "title" Content Meta]
+    [no-script "noscript" Content Meta]
+    [template "template" (HTML Any) (HTML Nothing)]
+    [table-header "th" Element Header]
+    [table-cell "td" Element Cell]
+    [head "head" Meta Head]
+    [body "body" Element Body]
+    )
+
+  (template [   ]
+    [(def: 
+       (->  )
+       (..tag  (list)))]
+
+    [table-row "tr" (HTML Any) Row]
+    [table-head "thead" Row HTML]
+    [table-body "tbody" Row HTML]
+    [table-foot "tfoot" Row HTML]
+    [columns-group "colgroup" Column HTML]
+    )
+
+  (def: #export (table attributes caption columns headers rows footer)
+    (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element)
+    (let [head (..table-head (..table-row headers))
+          content (case (list\map table-row rows)
+                    #.Nil
+                    head
+
+                    (#.Cons first rest)
+                    (..and head
+                           (..table-body
+                            (list\fold (function.flip ..and) first rest))))
+          content (case footer
+                    #.None
+                    content
+                    
+                    (#.Some footer)
+                    (..and content
+                           (..table-foot (..table-row footer))))
+          content (case columns
+                    #.None
+                    content
+                    
+                    (#.Some columns)
+                    (..and (..columns-group columns)
+                           content))
+          content (case caption
+                    #.None
+                    content
+
+                    (#.Some caption)
+                    (..and (:as HTML caption)
+                           content))]
+      (..tag "table" attributes
+             content)))
+
+  (template [ ]
+    [(def: #export 
+       (-> Head Body Document)
+       (let [doc-type ]
+         (function (_ head body)
+           (|> (..tag "html" (list) (..and head body))
+               :representation
+               (format doc-type)
+               :abstraction))))]
+
+    [html-5    ""]
+    [html-4_01 (format "")]
+    [xhtml-1_0 (format "")]
+    [xhtml-1_1 (format "")]
+    )
+  )
diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux
new file mode 100644
index 000000000..142a15610
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/json.lux
@@ -0,0 +1,422 @@
+(.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format."
+                       "For more information, please see: http://www.json.org/")}
+  [library
+   [lux #*
+    ["." meta (#+ monad)]
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     [predicate (#+ Predicate)]
+     ["." monad (#+ do)]]
+    [control
+     pipe
+     ["." try (#+ Try)]
+     ["<>" parser ("#\." monad)
+      ["<.>" text (#+ Parser)]]]
+    [data
+     ["." bit]
+     ["." maybe]
+     ["." product]
+     ["." text ("#\." equivalence monoid)]
+     [collection
+      ["." list ("#\." fold functor)]
+      ["." row (#+ Row row) ("#\." monad)]
+      ["." dictionary (#+ Dictionary)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      ["n" nat]
+      ["f" frac ("#\." decimal)]]]]])
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Null    Any]
+  [Boolean Bit]
+  [Number  Frac]
+  [String  Text]
+  )
+
+(type: #export #rec JSON
+  (#Null    Null)
+  (#Boolean Boolean)
+  (#Number  Number)
+  (#String  String)
+  (#Array   (Row JSON))
+  (#Object  (Dictionary String JSON)))
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Array  (Row JSON)]
+  [Object (Dictionary String JSON)]
+  )
+
+(def: #export null?
+  (Predicate JSON)
+  (|>> (case> #Null true
+              _ false)))
+
+(def: #export object
+  (-> (List [String JSON]) JSON)
+  (|>> (dictionary.from_list text.hash) #..Object))
+
+(syntax: #export (json token)
+  {#.doc (doc "A simple way to produce JSON literals."
+              (json #null)
+              (json #1)
+              (json +123.456)
+              (json "this is a string")
+              (json ["this" "is" "an" "array"])
+              (json {"this" "is"
+                     "an" "object"}))}
+  (let [(^open ".") ..monad
+        wrapper (function (_ x) (` (..json (~ x))))]
+    (case token
+      (^template [  ]
+        [[_ ( value)]
+         (wrap (list (` (: JSON ( (~ ( value)))))))])
+      ([#.Bit  code.bit  #..Boolean]
+       [#.Frac code.frac #..Number]
+       [#.Text code.text #..String])
+
+      [_ (#.Tag ["" "null"])]
+      (wrap (list (` (: JSON #..Null))))
+
+      [_ (#.Tuple members)]
+      (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list\map wrapper members))))))))
+
+      [_ (#.Record pairs)]
+      (do {! ..monad}
+        [pairs' (monad.map !
+                           (function (_ [slot value])
+                             (case slot
+                               [_ (#.Text key_name)]
+                               (wrap (` [(~ (code.text key_name)) (~ (wrapper value))]))
+
+                               _
+                               (meta.fail "Wrong syntax for JSON object.")))
+                           pairs)]
+        (wrap (list (` (: JSON (#..Object ((~! dictionary.from_list)
+                                           (~! text.hash)
+                                           (list (~+ pairs')))))))))
+      
+      _
+      (wrap (list token)))))
+
+(def: #export (fields json)
+  {#.doc "Get all the fields in a JSON object."}
+  (-> JSON (Try (List String)))
+  (case json
+    (#Object obj)
+    (#try.Success (dictionary.keys obj))
+
+    _
+    (#try.Failure ($_ text\compose "Cannot get the fields of a non-object."))))
+
+(def: #export (get key json)
+  {#.doc "A JSON object field getter."}
+  (-> String JSON (Try JSON))
+  (case json
+    (#Object obj)
+    (case (dictionary.get key obj)
+      (#.Some value)
+      (#try.Success value)
+
+      #.None
+      (#try.Failure ($_ text\compose "Missing field '" key "' on object.")))
+
+    _
+    (#try.Failure ($_ text\compose "Cannot get field '" key "' on a non-object."))))
+
+(def: #export (set key value json)
+  {#.doc "A JSON object field setter."}
+  (-> String JSON JSON (Try JSON))
+  (case json
+    (#Object obj)
+    (#try.Success (#Object (dictionary.put key value obj)))
+
+    _
+    (#try.Failure ($_ text\compose "Cannot set field '" key "' on a non-object."))))
+
+(template [   ]
+  [(def: #export ( key json)
+     {#.doc (code.text ($_ text\compose "A JSON object field getter for "  "."))}
+     (-> Text JSON (Try ))
+     (case (get key json)
+       (#try.Success ( value))
+       (#try.Success value)
+
+       (#try.Success _)
+       (#try.Failure ($_ text\compose "Wrong value type at key: " key))
+
+       (#try.Failure error)
+       (#try.Failure error)))]
+
+  [get_boolean #Boolean Boolean "booleans"]
+  [get_number  #Number  Number  "numbers"]
+  [get_string  #String  String  "strings"]
+  [get_array   #Array   Array   "arrays"]
+  [get_object  #Object  Object  "objects"]
+  )
+
+(implementation: #export equivalence
+  (Equivalence JSON)
+  
+  (def: (= x y)
+    (case [x y]
+      [#Null #Null]
+      #1
+
+      (^template [ ]
+        [[( x') ( y')]
+         (\  = x' y')])
+      ([#Boolean bit.equivalence]
+       [#Number  f.equivalence]
+       [#String  text.equivalence])
+
+      [(#Array xs) (#Array ys)]
+      (and (n.= (row.size xs) (row.size ys))
+           (list\fold (function (_ idx prev)
+                        (and prev
+                             (maybe.default #0
+                                            (do maybe.monad
+                                              [x' (row.nth idx xs)
+                                               y' (row.nth idx ys)]
+                                              (wrap (= x' y'))))))
+                      #1
+                      (list.indices (row.size xs))))
+      
+      [(#Object xs) (#Object ys)]
+      (and (n.= (dictionary.size xs) (dictionary.size ys))
+           (list\fold (function (_ [xk xv] prev)
+                        (and prev
+                             (case (dictionary.get xk ys)
+                               #.None   #0
+                               (#.Some yv) (= xv yv))))
+                      #1
+                      (dictionary.entries xs)))
+      
+      _
+      #0)))
+
+############################################################
+############################################################
+############################################################
+
+(def: (format_null _)
+  (-> Null Text)
+  "null")
+
+(def: format_boolean
+  (-> Boolean Text)
+  (|>> (case>
+        #0 "false"
+        #1 "true")))
+
+(def: format_number
+  (-> Number Text)
+  (|>> (case>
+        (^or +0.0 -0.0) "0.0"
+        value (let [raw (\ f.decimal encode value)]
+                (if (f.< +0.0 value)
+                  raw
+                  (|> raw (text.split 1) maybe.assume product.right))))))
+
+(def: escape "\")
+(def: escaped_dq (text\compose ..escape text.double_quote))
+
+(def: format_string
+  (-> String Text)
+  (|>> (text.replace_all text.double_quote ..escaped_dq)
+       (text.enclose [text.double_quote text.double_quote])))
+
+(template [ ]
+  [(def: 
+     Text
+     )]
+
+  ["," separator]
+  [":" entry_separator]
+
+  ["[" open_array]
+  ["]" close_array]
+
+  ["{" open_object]
+  ["}" close_object]
+  )
+
+(def: (format_array format)
+  (-> (-> JSON Text) (-> Array Text))
+  (|>> (row\map format)
+       row.to_list
+       (text.join_with ..separator)
+       (text.enclose [..open_array ..close_array])))
+
+(def: (format_kv format [key value])
+  (-> (-> JSON Text) (-> [String JSON] Text))
+  ($_ text\compose
+      (..format_string key)
+      ..entry_separator
+      (format value)
+      ))
+
+(def: (format_object format)
+  (-> (-> JSON Text) (-> Object Text))
+  (|>> dictionary.entries
+       (list\map (..format_kv format))
+       (text.join_with ..separator)
+       (text.enclose [..open_object ..close_object])))
+
+(def: #export (format json)
+  (-> JSON Text)
+  (case json
+    (^template [ ]
+      [( value)
+       ( value)])
+    ([#Null    ..format_null]
+     [#Boolean ..format_boolean]
+     [#Number  ..format_number]
+     [#String  ..format_string]
+     [#Array   (..format_array format)]
+     [#Object  (..format_object format)])
+    ))
+
+############################################################
+############################################################
+############################################################
+
+(def: parse_space
+  (Parser Text)
+  (.some .space))
+
+(def: parse_separator
+  (Parser [Text Any Text])
+  ($_ <>.and
+      ..parse_space
+      (.this ..separator)
+      ..parse_space))
+
+(def: parse_null
+  (Parser Null)
+  (do <>.monad
+    [_ (.this "null")]
+    (wrap [])))
+
+(template [  ]
+  [(def: 
+     (Parser Boolean)
+     (do <>.monad
+       [_ (.this )]
+       (wrap )))]
+
+  [parse_true  "true"  #1]
+  [parse_false "false" #0]
+  )
+
+(def: parse_boolean
+  (Parser Boolean)
+  ($_ <>.either
+      ..parse_true
+      ..parse_false))
+
+(def: parse_number
+  (Parser Number)
+  (do {! <>.monad}
+    [signed? (<>.parses? (.this "-"))
+     digits (.many .decimal)
+     decimals (<>.default "0"
+                          (do !
+                            [_ (.this ".")]
+                            (.many .decimal)))
+     exp (<>.default ""
+                     (do !
+                       [mark (.one_of "eE")
+                        signed?' (<>.parses? (.this "-"))
+                        offset (.many .decimal)]
+                       (wrap ($_ text\compose mark (if signed?' "-" "") offset))))]
+    (case (f\decode ($_ text\compose (if signed? "-" "") digits "." decimals exp))
+      (#try.Failure message)
+      (<>.fail message)
+      
+      (#try.Success value)
+      (wrap value))))
+
+(def: parse_escaped
+  (Parser Text)
+  ($_ <>.either
+      (<>.after (.this "\t")
+                (<>\wrap text.tab))
+      (<>.after (.this "\b")
+                (<>\wrap text.back_space))
+      (<>.after (.this "\n")
+                (<>\wrap text.new_line))
+      (<>.after (.this "\r")
+                (<>\wrap text.carriage_return))
+      (<>.after (.this "\f")
+                (<>\wrap text.form_feed))
+      (<>.after (.this (text\compose "\" text.double_quote))
+                (<>\wrap text.double_quote))
+      (<>.after (.this "\\")
+                (<>\wrap "\"))))
+
+(def: parse_string
+  (Parser String)
+  (<| (.enclosed [text.double_quote text.double_quote])
+      (loop [_ []])
+      (do {! <>.monad}
+        [chars (.some (.none_of (text\compose "\" text.double_quote)))
+         stop .peek])
+      (if (text\= "\" stop)
+        (do !
+          [escaped parse_escaped
+           next_chars (recur [])]
+          (wrap ($_ text\compose chars escaped next_chars)))
+        (wrap chars))))
+
+(def: (parse_kv parse_json)
+  (-> (Parser JSON) (Parser [String JSON]))
+  (do <>.monad
+    [key ..parse_string
+     _ ..parse_space
+     _ (.this ..entry_separator)
+     _ ..parse_space
+     value parse_json]
+    (wrap [key value])))
+
+(template [     ]
+  [(def: ( parse_json)
+     (-> (Parser JSON) (Parser ))
+     (do <>.monad
+       [_ (.this )
+        _ parse_space
+        elems (<>.separated_by ..parse_separator )
+        _ parse_space
+        _ (.this )]
+       (wrap ( elems))))]
+
+  [parse_array  Array  ..open_array ..close_array parse_json  row.from_list]
+  [parse_object Object ..open_object ..close_object (parse_kv parse_json) (dictionary.from_list text.hash)]
+  )
+
+(def: parse_json
+  (Parser JSON)
+  (<>.rec
+   (function (_ parse_json)
+     ($_ <>.or
+         parse_null
+         parse_boolean
+         parse_number
+         parse_string
+         (parse_array parse_json)
+         (parse_object parse_json)))))
+
+(implementation: #export codec
+  (Codec Text JSON)
+  
+  (def: encode ..format)
+  (def: decode (.run parse_json)))
diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux
new file mode 100644
index 000000000..05a8ed94a
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/markdown.lux
@@ -0,0 +1,181 @@
+(.module:
+  [library
+   [lux (#- and)
+    [data
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." functor)]]]
+    [type
+     abstract]
+    [world
+     [net (#+ URL)]]]])
+
+## https://www.markdownguide.org/basic-syntax/
+
+(def: sanitize
+  (-> Text Text)
+  (|>> (text.replace-all "\" "\\")
+       (text.replace-all "`" "\`")
+       (text.replace-all "*" "\*")
+       (text.replace-all "_" "\_")
+       (text.replace-all "{" "\{")
+       (text.replace-all "}" "\}")
+       (text.replace-all "[" "\[")
+       (text.replace-all "]" "\]")
+       (text.replace-all "(" "\(")
+       (text.replace-all ")" "\)")
+       (text.replace-all "#" "\#")
+       (text.replace-all "+" "\+")
+       (text.replace-all "-" "\-")
+       (text.replace-all "." "\.")
+       (text.replace-all "!" "\!")))
+
+(abstract: #export Span Any)
+(abstract: #export Block Any)
+
+(abstract: #export (Markdown brand)
+  Text
+
+  (def: #export empty
+    Markdown
+    (:abstraction ""))
+
+  (def: #export text
+    (-> Text (Markdown Span))
+    (|>> ..sanitize :abstraction))
+
+  (def: blank-line (format text.new-line text.new-line))
+
+  (template [ ]
+    [(def: #export ( content)
+       (-> Text Markdown)
+       (:abstraction (format  " " (..sanitize content) ..blank-line)))]
+
+    [heading/1 "#"]
+    [heading/2 "##"]
+    [heading/3 "###"]
+    [heading/4 "####"]
+    [heading/5 "#####"]
+    [heading/6 "######"]
+    )
+
+  (def: (block content)
+    (-> Text (Markdown Block))
+    (:abstraction (format content ..blank-line)))
+
+  (def: #export paragraph
+    (-> (Markdown Span) (Markdown Block))
+    (|>> :representation ..block))
+
+  (def: #export break
+    (Markdown Span)
+    (:abstraction (format "  " text.new-line)))
+
+  (template [ ]
+    [(def: #export 
+       (-> (Markdown Span) (Markdown Span))
+       (|>> :representation
+            (text.enclose [ ])
+            :abstraction))]
+
+    [bold "**"]
+    [italic "_"]
+    )
+
+  (def: (prefix with)
+    (-> Text (-> Text Text))
+    (|>> (text.split-all-with text.new-line)
+         (list\map (function (_ line)
+                     (if (text.empty? line)
+                       line
+                       (format with line))))
+         (text.join-with text.new-line)))
+
+  (def: indent
+    (-> Text Text)
+    (..prefix text.tab))
+
+  (def: #export quote
+    (-> (Markdown Block) (Markdown Block))
+    (|>> :representation
+         (..prefix "> ")
+         :abstraction))
+
+  (def: #export numbered-list
+    (-> (List [(Markdown Span) (Maybe (Markdown Block))])
+        (Markdown Block))
+    (|>> list.enumeration
+         (list\map (function (_ [idx [summary detail]])
+                     (format (%.nat (inc idx)) ". " (:representation summary) text.new-line
+                             (case detail
+                               (#.Some detail)
+                               (|> detail :representation ..indent (text.enclose [text.new-line text.new-line]))
+                               
+                               #.None
+                               ""))))
+         (text.join-with text.new-line)
+         ..block))
+
+  (def: #export bullet-list
+    (-> (List [(Markdown Span) (Maybe (Markdown Block))])
+        (Markdown Block))
+    (|>> (list\map (function (_ [summary detail])
+                     (format "*. " (:representation summary) text.new-line
+                             (case detail
+                               (#.Some detail)
+                               (|> detail :representation ..indent (text.enclose [text.new-line text.new-line]))
+                               
+                               #.None
+                               ""))))
+         (text.join-with text.new-line)
+         ..block))
+
+  (def: #export snippet
+    {#.doc "A snippet of code."}
+    (-> Text (Markdown Span))
+    (|>> ..sanitize (text.enclose ["`" "`"]) :abstraction))
+
+  (def: #export code
+    {#.doc "A block of code."}
+    (-> Text (Markdown Block))
+    (let [open (format "```" text.new-line)
+          close (format text.new-line "```")]
+      (|>> (text.enclose [open close]) ..block)))
+
+  (def: #export (image description url)
+    (-> Text URL (Markdown Span))
+    (:abstraction (format "![" (..sanitize description) "](" url ")")))
+
+  (def: #export horizontal-rule
+    (Markdown Block)
+    (..block "___"))
+
+  (def: #export (link description url)
+    (-> (Markdown Span) URL (Markdown Span))
+    (:abstraction (format "[" (:representation description) "](" url ")")))
+
+  (type: #export Email Text)
+
+  (template [ ]
+    [(def: #export 
+       (->  (Markdown Span))
+       (|>> (text.enclose ["<" ">"]) :abstraction))]
+
+    [url URL]
+    [email Email]
+    )
+
+  (template [  ]
+    [(def: #export ( pre post)
+       (-> (Markdown ) (Markdown ) (Markdown ))
+       (:abstraction (format (:representation pre)  (:representation post))))]
+
+    [and Span " "]
+    [then Block ""]
+    )
+
+  (def: #export markdown
+    (-> (Markdown Any) Text)
+    (|>> :representation))
+  )
diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux
new file mode 100644
index 000000000..f95b29334
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/tar.lux
@@ -0,0 +1,871 @@
+(.module:
+  [library
+   [lux (#- Mode Name and)
+    [abstract
+     [monad (#+ do)]]
+    [control
+     [pipe (#+ case>)]
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["" binary (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." binary (#+ Binary)]
+     ["." text (#+ Char)
+      ["%" format (#+ format)]
+      [encoding
+       ["." utf8]]]
+     ["." format #_
+      ["#" binary (#+ Writer) ("#\." monoid)]]
+     [collection
+      ["." list ("#\." fold)]
+      ["." row (#+ Row) ("#\." fold)]]]
+    [math
+     ["." number
+      ["n" nat]
+      ["." i64]]]
+    [time
+     ["." instant (#+ Instant)]
+     ["." duration]]
+    [world
+     ["." file]]
+    [type
+     abstract]]])
+
+(type: Size Nat)
+
+(def: octal_size Size 8)
+
+(def: (octal_padding max_size number)
+  (-> Size Text Text)
+  (let [padding_size (n.- (text.size number)
+                          max_size)
+        padding (|> "0"
+                    (list.repeat padding_size)
+                    (text.join_with ""))]
+    (format padding number)))
+
+(def: blank " ")
+(def: null text.null)
+
+(def: small_size Size 6)
+(def: big_size Size 11)
+
+(template [  
+               
+           ]
+  [(def: #export 
+     Nat
+     (|> ..octal_size
+         (list.repeat )
+         (list\fold n.* 1)
+         inc))
+
+   (exception: #export ( {value Nat})
+     (exception.report
+      ["Value" (%.nat value)]
+      ["Maximum" (%.nat (dec ))]))
+
+   (abstract: #export 
+     Nat
+
+     (def: #export ( value)
+       (-> Nat (Try ))
+       (if (n.<  value)
+         (#try.Success (:abstraction value))
+         (exception.throw  [value])))
+
+     (def: #export 
+       (->  Nat)
+       (|>> :representation))
+
+     (def: 
+       (Writer )
+       (let [suffix 
+             padded_size (n.+ (text.size suffix) )]
+         (|>> :representation
+              (\ n.octal encode)
+              (..octal_padding )
+              (text.suffix suffix)
+              (\ utf8.codec encode)
+              (format.segment padded_size))))
+
+     (def: 
+       (-> Nat )
+       (|>> (n.% )
+            :abstraction))
+     )]
+
+  [not_a_small_number small_limit ..small_size
+   Small small from_small
+   small_writer (format ..blank ..null)
+   coerce_small]
+  [not_a_big_number big_limit ..big_size
+   Big big from_big
+   big_writer ..blank
+   coerce_big]
+  )
+
+(exception: #export (wrong_character {expected Char} {actual Char})
+  (exception.report
+   ["Expected" (%.nat expected)]
+   ["Actual" (%.nat actual)]))
+
+(def: verify_small_suffix
+  (Parser Any)
+  (do <>.monad
+    [pre_end .bits/8
+     end .bits/8
+     _ (let [expected (`` (char (~~ (static ..blank))))]
+         (<>.assert (exception.construct ..wrong_character [expected pre_end])
+                    (n.= expected pre_end)))
+     _ (let [expected (`` (char (~~ (static ..null))))]
+         (<>.assert (exception.construct ..wrong_character [expected end])
+                    (n.= expected end)))]
+    (wrap [])))
+
+(def: small_parser
+  (Parser Small)
+  (do <>.monad
+    [digits (.segment ..small_size)
+     digits (<>.lift (\ utf8.codec decode digits))
+     _ ..verify_small_suffix]
+    (<>.lift
+     (do {! try.monad}
+       [value (\ n.octal decode digits)]
+       (..small value)))))
+
+(def: big_parser
+  (Parser Big)
+  (do <>.monad
+    [digits (.segment ..big_size)
+     digits (<>.lift (\ utf8.codec decode digits))
+     end .bits/8
+     _ (let [expected (`` (char (~~ (static ..blank))))]
+         (<>.assert (exception.construct ..wrong_character [expected end])
+                    (n.= expected end)))]
+    (<>.lift
+     (do {! try.monad}
+       [value (\ n.octal decode digits)]
+       (..big value)))))
+
+(abstract: Checksum
+  Text
+
+  (def: from_checksum
+    (-> Checksum Text)
+    (|>> :representation))
+
+  (def: dummy_checksum
+    Checksum
+    (:abstraction "        "))
+
+  (def: checksum_suffix
+    (format ..blank ..null))
+
+  (def: checksum
+    (-> Binary Nat)
+    (binary.fold n.+ 0))
+
+  (def: checksum_checksum
+    (|> ..dummy_checksum
+        :representation
+        (\ utf8.codec encode)
+        ..checksum))
+
+  (def: checksum_code
+    (-> Binary Checksum)
+    (|>> ..checksum
+         ..coerce_small
+         ..from_small
+         (\ n.octal encode)
+         (..octal_padding ..small_size)
+         (text.suffix ..checksum_suffix)
+         :abstraction))
+
+  (def: checksum_writer
+    (Writer Checksum)
+    (let [padded_size (n.+ (text.size ..checksum_suffix)
+                           ..small_size)]
+      (|>> :representation
+           (\ utf8.codec encode)
+           (format.segment padded_size))))
+
+  (def: checksum_parser
+    (Parser [Nat Checksum])
+    (do <>.monad
+      [ascii (.segment ..small_size)
+       digits (<>.lift (\ utf8.codec decode ascii))
+       _ ..verify_small_suffix
+       value (<>.lift
+              (\ n.octal decode digits))]
+      (wrap [value
+             (:abstraction (format digits ..checksum_suffix))])))
+  )
+
+(def: last_ascii
+  Char
+  (number.hex "007F"))
+
+(def: ascii?
+  (-> Text Bit)
+  (|>> (\ utf8.codec encode)
+       (binary.fold (function (_ char verdict)
+                      (.and verdict
+                            (n.<= ..last_ascii char)))
+                    true)))
+
+(exception: #export (not_ascii {text Text})
+  (exception.report
+   ["Text" (%.text text)]))
+
+(def: #export name_size Size 31)
+(def: #export path_size Size 99)
+
+(def: (un_pad string)
+  (-> Binary (Try Binary))
+  (case (binary.size string)
+    0 (#try.Success string)
+    size (loop [end (dec size)]
+           (case end
+             0 (#try.Success (\ utf8.codec encode ""))
+             _ (do try.monad
+                 [last_char (binary.read/8 end string)]
+                 (`` (case (.nat last_char)
+                       (^ (char (~~ (static ..null))))
+                       (recur (dec end))
+
+                       _
+                       (binary.slice 0 (inc end) string))))))))
+
+(template [        ]
+  [(abstract: #export 
+     
+
+     (exception: #export ( {value Text})
+       (exception.report
+        ["Value" (%.text value)]
+        ["Size" (%.nat (text.size value))]
+        ["Maximum" (%.nat )]))
+
+     (def: #export ( value)
+       (->  (Try ))
+       (if (..ascii? value)
+         (if (|> value (\ utf8.codec encode) binary.size (n.<= ))
+           (#try.Success (:abstraction value))
+           (exception.throw  [value]))
+         (exception.throw ..not_ascii [value])))
+
+     (def: #export 
+       (->  )
+       (|>> :representation))
+
+     (def: 
+       (Writer )
+       (let [suffix ..null
+             padded_size (n.+ (text.size suffix) )]
+         (|>> :representation
+              (text.suffix suffix)
+              (\ utf8.codec encode)
+              (format.segment padded_size))))
+
+     (def: 
+       (Parser )
+       (do <>.monad
+         [string (.segment )
+          end .bits/8
+          #let [expected (`` (char (~~ (static ..null))))]
+          _ (<>.assert (exception.construct ..wrong_character [expected end])
+                       (n.= expected end))]
+         (<>.lift
+          (do {! try.monad}
+            [ascii (..un_pad string)
+             text (\ utf8.codec decode ascii)]
+            ( text)))))
+
+     (def: #export 
+       
+       (try.assume ( "")))
+     )]
+
+  [Name Text      ..name_size name_is_too_long name from_name name_writer name_parser anonymous]
+  [Path file.Path ..path_size path_is_too_long path from_path path_writer path_parser no_path]
+  )
+
+(def: magic_size Size 7)
+
+(abstract: Magic
+  Text
+
+  (def: ustar (:abstraction "ustar  "))
+
+  (def: from_magic
+    (-> Magic Text)
+    (|>> :representation))
+
+  (def: magic_writer
+    (Writer Magic)
+    (let [padded_size (n.+ (text.size ..null)
+                           ..magic_size)]
+      (|>> :representation
+           (\ utf8.codec encode)
+           (format.segment padded_size))))
+
+  (def: magic_parser
+    (Parser Magic)
+    (do <>.monad
+      [string (.segment ..magic_size)
+       end .bits/8
+       #let [expected (`` (char (~~ (static ..null))))]
+       _ (<>.assert (exception.construct ..wrong_character [expected end])
+                    (n.= expected end))]
+      (<>.lift
+       (\ try.monad map (|>> :abstraction)
+          (\ utf8.codec decode string)))))
+  )
+
+(def: block_size Size 512)
+
+(def: owner_id_size ..small_size)
+
+(def: blank_size Size (text.size ..blank))
+(def: null_size Size (text.size ..null))
+(def: mode_size Size ..small_size)
+(def: content_size Size ..big_size)
+(def: modification_time_size Size ..big_size)
+(def: checksum_size Size ..small_size)
+(def: link_flag_size Size 1)
+(def: device_size Size ..small_size)
+
+(def: small_number
+  (-> Size Size)
+  (|>> ($_ n.+ ..blank_size ..null_size)))
+
+(def: big_number
+  (-> Size Size)
+  (|>> ($_ n.+ ..blank_size)))
+
+(def: string
+  (-> Size Size)
+  (|>> ($_ n.+ ..null_size)))
+
+(def: header_size
+  ($_ n.+
+      ## name
+      (..string ..path_size)
+      ## mode
+      (..small_number ..mode_size)
+      ## uid
+      (..small_number ..owner_id_size)
+      ## gid
+      (..small_number ..owner_id_size)
+      ## size
+      (..big_number ..content_size)
+      ## mtime
+      (..big_number ..modification_time_size)
+      ## chksum
+      (..small_number ..checksum_size)
+      ## linkflag
+      ..link_flag_size
+      ## linkname
+      (..string ..path_size)
+      ## magic
+      (..string ..magic_size)
+      ## uname
+      (..string ..name_size)
+      ## gname
+      (..string ..name_size)
+      ## devmajor
+      (..small_number ..device_size)
+      ## devminor
+      (..small_number ..device_size)))
+
+(abstract: Link_Flag
+  Char
+
+  (def: link_flag
+    (-> Link_Flag Char)
+    (|>> :representation))
+
+  (def: link_flag_writer
+    (Writer Link_Flag)
+    (|>> :representation
+         format.bits/8))
+
+  (with_expansions [ (as_is [0 old_normal]
+                                     [(char "0") normal]
+                                     [(char "1") link]
+                                     [(char "2") symbolic_link]
+                                     [(char "3") character]
+                                     [(char "4") block]
+                                     [(char "5") directory]
+                                     [(char "6") fifo]
+                                     [(char "7") contiguous])]
+    (template [ ]
+      [(def: 
+         Link_Flag
+         (:abstraction ))]
+
+      
+      )
+
+    (exception: #export (invalid_link_flag {value Nat})
+      (exception.report
+       ["Value" (%.nat value)]))
+
+    (def: link_flag_parser
+      (Parser Link_Flag)
+      (do <>.monad
+        [linkflag .bits/8]
+        (case (.nat linkflag)
+          (^template [ ]
+            [(^ )
+             (wrap )])
+          ()
+
+          _
+          (<>.lift
+           (exception.throw ..invalid_link_flag [(.nat linkflag)]))))))
+  )
+
+(abstract: #export Mode
+  Nat
+
+  (def: #export mode
+    (-> Mode Nat)
+    (|>> :representation))
+
+  (def: #export (and left right)
+    (-> Mode Mode Mode)
+    (:abstraction
+     (i64.or (:representation left)
+             (:representation right))))
+
+  (def: mode_writer
+    (Writer Mode)
+    (|>> :representation
+         ..small
+         try.assume
+         ..small_writer))
+
+  (exception: #export (invalid_mode {value Nat})
+    (exception.report
+     ["Value" (%.nat value)]))
+
+  (with_expansions [ (as_is ["0000" none]
+                                     
+                                     ["0001" execute_by_other]
+                                     ["0002" write_by_other]
+                                     ["0004" read_by_other]
+
+                                     ["0010" execute_by_group]
+                                     ["0020" write_by_group]
+                                     ["0040" read_by_group]
+
+                                     ["0100" execute_by_owner]
+                                     ["0200" write_by_owner]
+                                     ["0400" read_by_owner]
+
+                                     ["1000" save_text]
+                                     ["2000" set_group_id_on_execution]
+                                     ["4000" set_user_id_on_execution])]
+    (template [ ]
+      [(def: #export 
+         Mode
+         (:abstraction (number.oct )))]
+
+      
+      )
+
+    (def: maximum_mode
+      Mode
+      ($_ and
+          ..none
+          
+          ..execute_by_other
+          ..write_by_other
+          ..read_by_other
+
+          ..execute_by_group
+          ..write_by_group
+          ..read_by_group
+
+          ..execute_by_owner
+          ..write_by_owner
+          ..read_by_owner
+
+          ..save_text
+          ..set_group_id_on_execution
+          ..set_user_id_on_execution
+          ))
+
+    (def: mode_parser
+      (Parser Mode)
+      (do {! <>.monad}
+        [value (\ ! map ..from_small ..small_parser)]
+        (if (n.<= (:representation ..maximum_mode)
+                  value)
+          (wrap (:abstraction value))
+          (<>.lift
+           (exception.throw ..invalid_mode [value]))))))
+  )
+
+(def: maximum_content_size
+  Nat
+  (|> ..octal_size
+      (list.repeat ..content_size)
+      (list\fold n.* 1)))
+
+(abstract: #export Content
+  [Big Binary]
+
+  (def: #export (content content)
+    (-> Binary (Try Content))
+    (do try.monad
+      [size (..big (binary.size content))]
+      (wrap (:abstraction [size content]))))
+
+  (def: from_content
+    (-> Content [Big Binary])
+    (|>> :representation))
+
+  (def: #export data
+    (-> Content Binary)
+    (|>> :representation product.right))
+  )
+
+(type: #export ID
+  Small)
+
+(def: #export no_id
+  ID
+  (..coerce_small 0))
+
+(type: #export Owner
+  {#name Name
+   #id ID})
+
+(type: #export Ownership
+  {#user Owner
+   #group Owner})
+
+(type: #export File
+  [Path Instant Mode Ownership Content])
+
+(type: #export Normal File)
+(type: #export Symbolic_Link Path)
+(type: #export Directory Path)
+(type: #export Contiguous File)
+
+(type: #export Entry
+  (#Normal ..Normal)
+  (#Symbolic_Link ..Symbolic_Link)
+  (#Directory ..Directory)
+  (#Contiguous ..Contiguous))
+
+(type: Device
+  Small)
+
+(def: no_device
+  Device
+  (try.assume (..small 0)))
+
+(type: #export Tar
+  (Row Entry))
+
+(def: (blocks size)
+  (-> Big Nat)
+  (n.+ (n./ ..block_size
+            (..from_big size))
+       (case (n.% ..block_size (..from_big size))
+         0 0
+         _ 1)))
+
+(def: rounded_content_size
+  (-> Big Nat)
+  (|>> ..blocks
+       (n.* ..block_size)))
+
+(type: Header
+  {#path Path
+   #mode Mode
+   #user_id ID
+   #group_id ID
+   #size Big
+   #modification_time Big
+   #checksum Checksum
+   #link_flag Link_Flag
+   #link_name Path
+   #magic Magic
+   #user_name Name
+   #group_name Name
+   #major_device Device
+   #minor_device Device})
+
+(def: header_writer'
+  (Writer Header)
+  ($_ format.and
+      ..path_writer
+      ..mode_writer
+      ..small_writer
+      ..small_writer
+      ..big_writer
+      ..big_writer
+      ..checksum_writer
+      ..link_flag_writer
+      ..path_writer
+      ..magic_writer
+      ..name_writer
+      ..name_writer
+      ..small_writer
+      ..small_writer
+      ))
+
+(def: (header_writer header)
+  (Writer Header)
+  (let [checksum (|> header
+                     (set@ #checksum ..dummy_checksum)
+                     (format.run ..header_writer')
+                     ..checksum_code)]
+    (|> header
+        (set@ #checksum checksum)
+        (format.run ..header_writer')
+        (format.segment ..block_size))))
+
+(def: modification_time
+  (-> Instant Big)
+  (|>> instant.relative
+       (duration.query duration.second)
+       .nat
+       ..coerce_big))
+
+(def: (file_writer link_flag)
+  (-> Link_Flag (Writer File))
+  (function (_ [path modification_time mode ownership content])
+    (let [[size content] (..from_content content)
+          writer ($_ format.and
+                     ..header_writer
+                     (format.segment (..rounded_content_size size)))]
+      (writer [{#path path
+                #mode mode
+                #user_id (get@ [#user #id] ownership)
+                #group_id (get@ [#group #id] ownership)
+                #size size
+                #modification_time (..modification_time modification_time)
+                #checksum ..dummy_checksum
+                #link_flag link_flag
+                #link_name ..no_path
+                #magic ..ustar
+                #user_name (get@ [#user #name] ownership)
+                #group_name (get@ [#group #name] ownership)
+                #major_device ..no_device
+                #minor_device ..no_device}
+               content]))))
+
+(def: normal_file_writer
+  (Writer File)
+  (..file_writer ..normal))
+
+(def: contiguous_file_writer
+  (Writer File)
+  (..file_writer ..contiguous))
+
+(def: (symbolic_link_writer path)
+  (Writer Path)
+  (..header_writer
+   {#path ..no_path
+    #mode ..none
+    #user_id ..no_id
+    #group_id ..no_id
+    #size (..coerce_big 0)
+    #modification_time (..coerce_big 0)
+    #checksum ..dummy_checksum
+    #link_flag ..symbolic_link
+    #link_name path
+    #magic ..ustar
+    #user_name ..anonymous
+    #group_name ..anonymous
+    #major_device ..no_device
+    #minor_device ..no_device}))
+
+(def: (directory_writer path)
+  (Writer Path)
+  (..header_writer
+   {#path path
+    #mode ..none
+    #user_id ..no_id
+    #group_id ..no_id
+    #size (..coerce_big 0)
+    #modification_time (..coerce_big 0)
+    #checksum ..dummy_checksum
+    #link_flag ..directory
+    #link_name ..no_path
+    #magic ..ustar
+    #user_name ..anonymous
+    #group_name ..anonymous
+    #major_device ..no_device
+    #minor_device ..no_device}))
+
+(def: entry_writer
+  (Writer Entry)
+  (|>> (case> (#Normal value) (..normal_file_writer value)
+              (#Symbolic_Link value) (..symbolic_link_writer value)
+              (#Directory value) (..directory_writer value)
+              (#Contiguous value) (..contiguous_file_writer value))))
+
+(def: end_of_archive_size Size (n.* 2 ..block_size))
+
+(def: #export writer
+  (Writer Tar)
+  (let [end_of_archive (binary.create ..end_of_archive_size)]
+    (function (_ tar)
+      (format\compose (row\fold (function (_ next total)
+                                  (format\compose total (..entry_writer next)))
+                                format\identity
+                                tar)
+                      (format.segment ..end_of_archive_size end_of_archive)))))
+
+(exception: #export (wrong_checksum {expected Nat} {actual Nat})
+  (exception.report
+   ["Expected" (%.nat expected)]
+   ["Actual" (%.nat actual)]))
+
+(def: header_padding_size
+  (n.- header_size block_size))
+
+## When the checksum gets originally calculated, the assumption is that all the characters in the checksum field
+## of the header will be spaces.
+## This means that just calculating the checksum of the 512 bytes of the header, when reading them, would yield
+## an incorrect result, as the contents of the checksum field would be an actual checksum, instead of just spaces.
+## To correct for this, it is necessary to calculate the checksum of just the checksum field, subtract that, and then
+## add-in the checksum of the spaces.
+(def: (expected_checksum checksum header)
+  (-> Checksum Binary Nat)
+  (let [|checksum| (|> checksum
+                       ..from_checksum
+                       (\ utf8.codec encode)
+                       ..checksum)]
+    (|> (..checksum header)
+        (n.- |checksum|)
+        (n.+ ..checksum_checksum))))
+
+(def: header_parser
+  (Parser Header)
+  (do <>.monad
+    [binary_header (<>.speculative (.segment block_size))
+     path ..path_parser
+     mode ..mode_parser
+     user_id ..small_parser
+     group_id ..small_parser
+     size ..big_parser
+     modification_time ..big_parser
+     [actual checksum_code] ..checksum_parser
+     _ (let [expected (expected_checksum checksum_code binary_header)]
+         (<>.lift
+          (exception.assert ..wrong_checksum [expected actual]
+                            (n.= expected actual))))
+     link_flag ..link_flag_parser
+     link_name ..path_parser
+     magic ..magic_parser
+     user_name ..name_parser
+     group_name ..name_parser
+     major_device ..small_parser
+     minor_device ..small_parser
+     _ (.segment ..header_padding_size)]
+    (wrap {#path path
+           #mode mode
+           #user_id user_id
+           #group_id group_id
+           #size size
+           #modification_time modification_time
+           #checksum checksum_code
+           #link_flag link_flag
+           #link_name link_name
+           #magic magic
+           #user_name user_name
+           #group_name group_name
+           #major_device major_device
+           #minor_device minor_device})))
+
+(exception: #export (wrong_link_flag {expected Link_Flag} {actual Link_Flag})
+  (exception.report
+   ["Expected" (%.nat (..link_flag expected))]
+   ["Actual" (%.nat (..link_flag actual))]))
+
+(def: (file_parser expected)
+  (-> Link_Flag (Parser File))
+  (do <>.monad
+    [header ..header_parser
+     _ (<>.assert (exception.construct ..wrong_link_flag [expected (get@ #link_flag header)])
+                  (is? expected (get@ #link_flag header)))
+     #let [size (get@ #size header)
+           rounded_size (..rounded_content_size size)]
+     content (.segment (..from_big size))
+     content (<>.lift (..content content))
+     _ (.segment (n.- (..from_big size) rounded_size))]
+    (wrap [(get@ #path header)
+           (|> header
+               (get@ #modification_time)
+               ..from_big
+               .int
+               duration.from_millis
+               (duration.up (|> duration.second duration.to_millis .nat))
+               instant.absolute)
+           (get@ #mode header)
+           {#user {#name (get@ #user_name header)
+                   #id (get@ #user_id header)}
+            #group {#name (get@ #group_name header)
+                    #id (get@ #group_id header)}}
+           content])))
+
+(def: (file_name_parser expected extractor)
+  (-> Link_Flag (-> Header Path) (Parser Path))
+  (do <>.monad
+    [header ..header_parser
+     _ (<>.lift
+        (exception.assert ..wrong_link_flag [expected (get@ #link_flag header)]
+                          (n.= (..link_flag expected)
+                               (..link_flag (get@ #link_flag header)))))]
+    (wrap (extractor header))))
+
+(def: entry_parser
+  (Parser Entry)
+  ($_ <>.either
+      (\ <>.monad map (|>> #..Normal)
+         (<>.either (..file_parser ..normal)
+                    (..file_parser ..old_normal)))
+      (\ <>.monad map (|>> #..Symbolic_Link)
+         (..file_name_parser ..symbolic_link (get@ #link_name)))
+      (\ <>.monad map (|>> #..Directory)
+         (..file_name_parser ..directory (get@ #path)))
+      (\ <>.monad map (|>> #..Contiguous)
+         (..file_parser ..contiguous))))
+
+## It's safe to implement the parser this way because the range of values for Nat is 2^64
+## Whereas the maximum possible value for the checksum of a 512 block is (256 × 512) = 131,072
+(def: end_of_archive_block_parser
+  (Parser Any)
+  (do <>.monad
+    [block (.segment ..block_size)]
+    (let [actual (..checksum block)]
+      (<>.lift
+       (exception.assert ..wrong_checksum [0 actual]
+                         (n.= 0 actual))))))
+
+(exception: #export invalid_end_of_archive)
+
+(def: end_of_archive_parser
+  (Parser Any)
+  (do <>.monad
+    [_ (<>.at_most 2 end_of_archive_block_parser)
+     done? .end?]
+    (<>.lift
+     (exception.assert ..invalid_end_of_archive []
+                       done?))))
+
+(def: #export parser
+  (Parser Tar)
+  (|> (<>.some entry_parser)
+      (\ <>.monad map row.from_list)
+      (<>.before ..end_of_archive_parser)))
diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux
new file mode 100644
index 000000000..56d394490
--- /dev/null
+++ b/stdlib/source/library/lux/data/format/xml.lux
@@ -0,0 +1,299 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [monad (#+ do)]
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]]
+    [control
+     [try (#+ Try)]
+     ["<>" parser ("#\." monad)
+      ["<.>" text (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." name ("#\." equivalence codec)]
+     ["." text ("#\." equivalence monoid)]
+     [collection
+      ["." list ("#\." functor)]
+      ["." dictionary (#+ Dictionary)]]]
+    [math
+     [number
+      ["n" nat]
+      ["." int]]]]])
+
+(type: #export Tag
+  Name)
+
+(type: #export Attribute
+  Name)
+
+(type: #export Attrs
+  (Dictionary Attribute Text))
+
+(def: #export attributes
+  Attrs
+  (dictionary.new name.hash))
+
+(type: #export #rec XML
+  (#Text Text)
+  (#Node Tag Attrs (List XML)))
+
+(def: namespace_separator
+  ":")
+
+(def: xml_standard_escape_char^
+  (Parser Text)
+  ($_ <>.either
+      (<>.after (.this "<") (<>\wrap "<"))
+      (<>.after (.this ">") (<>\wrap ">"))
+      (<>.after (.this "&") (<>\wrap "&"))
+      (<>.after (.this "'") (<>\wrap "'"))
+      (<>.after (.this """) (<>\wrap text.double_quote))
+      ))
+
+(def: xml_unicode_escape_char^
+  (Parser Text)
+  (|> (do <>.monad
+        [hex? (<>.maybe (.this "x"))
+         code (case hex?
+                #.None
+                (<>.codec int.decimal (.many .decimal))
+
+                (#.Some _)
+                (<>.codec int.decimal (.many .hexadecimal)))]
+        (wrap (|> code .nat text.from_code)))
+      (<>.before (.this ";"))
+      (<>.after (.this "&#"))))
+
+(def: xml_escape_char^
+  (Parser Text)
+  (<>.either xml_standard_escape_char^
+             xml_unicode_escape_char^))
+
+(def: xml_char^
+  (Parser Text)
+  (<>.either (.none_of ($_ text\compose "<>&" text.double_quote))
+             xml_escape_char^))
+
+(def: xml_identifier
+  (Parser Text)
+  (do <>.monad
+    [head (<>.either (.one_of "_")
+                     .alpha)
+     tail (.some (<>.either (.one_of "_.-")
+                                  .alpha_num))]
+    (wrap ($_ text\compose head tail))))
+
+(def: namespaced_symbol^
+  (Parser Name)
+  (do <>.monad
+    [first_part xml_identifier
+     ?second_part (<| <>.maybe (<>.after (.this ..namespace_separator)) xml_identifier)]
+    (case ?second_part
+      #.None
+      (wrap ["" first_part])
+
+      (#.Some second_part)
+      (wrap [first_part second_part]))))
+
+(def: tag^ namespaced_symbol^)
+(def: attr_name^ namespaced_symbol^)
+
+(def: spaced^
+  (All [a] (-> (Parser a) (Parser a)))
+  (let [white_space^ (<>.some .space)]
+    (|>> (<>.before white_space^)
+         (<>.after white_space^))))
+
+(def: attr_value^
+  (Parser Text)
+  (let [value^ (.some xml_char^)]
+    (<>.either (.enclosed [text.double_quote text.double_quote] value^)
+               (.enclosed ["'" "'"] value^))))
+
+(def: attrs^
+  (Parser Attrs)
+  (<| (\ <>.monad map (dictionary.from_list name.hash))
+      <>.some
+      (<>.and (..spaced^ attr_name^))
+      (<>.after (.this "="))
+      (..spaced^ attr_value^)))
+
+(def: (close_tag^ expected)
+  (-> Tag (Parser []))
+  (do <>.monad
+    [actual (|> tag^
+                ..spaced^
+                (<>.after (.this "/"))
+                (.enclosed ["<" ">"]))]
+    (<>.assert ($_ text\compose "Close tag does not match open tag." text.new_line
+                   "Expected: " (name\encode expected) text.new_line
+                   "  Actual: " (name\encode actual) text.new_line)
+               (name\= expected actual))))
+
+(def: comment^
+  (Parser Text)
+  (|> (.not (.this "--"))
+      .some
+      (.enclosed [""])
+      ..spaced^))
+
+(def: xml_header^
+  (Parser Attrs)
+  (|> (..spaced^ attrs^)
+      (<>.before (.this "?>"))
+      (<>.after (.this ".this "]]>")]
+    (|> (.some (.not end))
+        (<>.after end)
+        (<>.after (.this " (..spaced^ (.many xml_char^))
+      (<>.either cdata^)
+      (<>\map (|>> #Text))))
+
+(def: null^
+  (Parser Any)
+  (.this (text.from_code 0)))
+
+(def: xml^
+  (Parser XML)
+  (|> (<>.rec
+       (function (_ node^)
+         (|> (do <>.monad
+               [_ (.this "<")
+                tag (..spaced^ tag^)
+                attrs (..spaced^ attrs^)
+                #let [no_children^ ($_ <>.either
+                                       (do <>.monad
+                                         [_ (.this "/>")]
+                                         (wrap (#Node tag attrs (list))))
+                                       (do <>.monad
+                                         [_ (.this ">")
+                                          _ (<>.some (<>.either .space
+                                                                ..comment^))
+                                          _ (..close_tag^ tag)]
+                                         (wrap (#Node tag attrs (list)))))
+                      with_children^ (do <>.monad
+                                       [_ (.this ">")
+                                        children (<>.many node^)
+                                        _ (..close_tag^ tag)]
+                                       (wrap (#Node tag attrs children)))]]
+               ($_ <>.either
+                   no_children^
+                   with_children^))
+             ..spaced^
+             (<>.before (<>.some ..comment^))
+             (<>.after (<>.some ..comment^))
+             (<>.either ..text^))))
+      (<>.before (<>.some ..null^))
+      (<>.after (<>.maybe ..xml_header^))))
+
+(def: read
+  (-> Text (Try XML))
+  (.run xml^))
+
+(def: (sanitize_value input)
+  (-> Text Text)
+  (|> input
+      (text.replace_all "&" "&")
+      (text.replace_all "<" "<")
+      (text.replace_all ">" ">")
+      (text.replace_all "'" "'")
+      (text.replace_all text.double_quote """)))
+
+(def: #export (tag [namespace name])
+  (-> Tag Text)
+  (case namespace
+    "" name
+    _ ($_ text\compose namespace ..namespace_separator name)))
+
+(def: #export attribute
+  (-> Attribute Text)
+  ..tag)
+
+(def: (write_attrs attrs)
+  (-> Attrs Text)
+  (|> attrs
+      dictionary.entries
+      (list\map (function (_ [key value])
+                  ($_ text\compose (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote)))
+      (text.join_with " ")))
+
+(def: xml_header
+  Text
+  (let [quote (: (-> Text Text)
+                 (function (_ value)
+                   ($_ text\compose text.double_quote value text.double_quote)))]
+    ($_ text\compose
+        "")))
+
+(def: (write input)
+  (-> XML Text)
+  ($_ text\compose
+      ..xml_header text.new_line
+      (loop [prefix ""
+             input input]
+        (case input
+          (#Text value)
+          (sanitize_value value)
+
+          (^ (#Node xml_tag xml_attrs (list (#Text value))))
+          (let [tag (..tag xml_tag)
+                attrs (if (dictionary.empty? xml_attrs)
+                        ""
+                        ($_ text\compose " " (..write_attrs xml_attrs)))]
+            ($_ text\compose
+                prefix "<" tag attrs ">"
+                (sanitize_value value)
+                ""))
+          
+          (#Node xml_tag xml_attrs xml_children)
+          (let [tag (..tag xml_tag)
+                attrs (if (dictionary.empty? xml_attrs)
+                        ""
+                        ($_ text\compose " " (..write_attrs xml_attrs)))]
+            (if (list.empty? xml_children)
+              ($_ text\compose prefix "<" tag attrs "/>")
+              ($_ text\compose prefix "<" tag attrs ">"
+                  (|> xml_children
+                      (list\map (|>> (recur (text\compose prefix text.tab)) (text\compose text.new_line)))
+                      (text.join_with ""))
+                  text.new_line prefix "")))))
+      ))
+
+(implementation: #export codec
+  (Codec Text XML)
+  
+  (def: encode ..write)
+  (def: decode ..read))
+
+(implementation: #export equivalence
+  (Equivalence XML)
+  
+  (def: (= reference sample)
+    (case [reference sample]
+      [(#Text reference/value) (#Text sample/value)]
+      (text\= reference/value sample/value)
+
+      [(#Node reference/tag reference/attrs reference/children)
+       (#Node sample/tag sample/attrs sample/children)]
+      (and (name\= reference/tag sample/tag)
+           (\ (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs)
+           (n.= (list.size reference/children)
+                (list.size sample/children))
+           (|> (list.zip/2 reference/children sample/children)
+               (list.every? (product.uncurry =))))
+
+      _
+      false)))
diff --git a/stdlib/source/library/lux/data/identity.lux b/stdlib/source/library/lux/data/identity.lux
new file mode 100644
index 000000000..c0a39ab5e
--- /dev/null
+++ b/stdlib/source/library/lux/data/identity.lux
@@ -0,0 +1,38 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [functor (#+ Functor)]
+     [apply (#+ Apply)]
+     [monad (#+ Monad)]
+     [comonad (#+ CoMonad)]]
+    [control
+     ["." function]]]])
+
+(type: #export (Identity a)
+  a)
+
+(implementation: #export functor
+  (Functor Identity)
+
+  (def: map function.identity))
+
+(implementation: #export apply
+  (Apply Identity)
+
+  (def: &functor ..functor)
+  (def: (apply ff fa) (ff fa)))
+
+(implementation: #export monad
+  (Monad Identity)
+  
+  (def: &functor ..functor)
+  (def: wrap function.identity)
+  (def: join function.identity))
+
+(implementation: #export comonad
+  (CoMonad Identity)
+  
+  (def: &functor ..functor)
+  (def: unwrap function.identity)
+  (def: split function.identity))
diff --git a/stdlib/source/library/lux/data/lazy.lux b/stdlib/source/library/lux/data/lazy.lux
new file mode 100644
index 000000000..c9a6ae18c
--- /dev/null
+++ b/stdlib/source/library/lux/data/lazy.lux
@@ -0,0 +1,68 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [functor (#+ Functor)]
+     [apply (#+ Apply)]
+     [monad (#+ Monad do)]
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["." io]
+     [parser
+      ["s" code]]
+     [concurrency
+      ["." atom]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]]
+    [type
+     abstract]]])
+
+(abstract: #export (Lazy a)
+  (-> [] a)
+
+  (def: (freeze' generator)
+    (All [a] (-> (-> [] a) (Lazy a)))
+    (let [cache (atom.atom #.None)]
+      (:abstraction (function (_ _)
+                      (case (io.run (atom.read cache))
+                        (#.Some value)
+                        value
+
+                        _
+                        (let [value (generator [])]
+                          (exec (io.run (atom.compare_and_swap _ (#.Some value) cache))
+                            value)))))))
+
+  (def: #export (thaw l_value)
+    (All [a] (-> (Lazy a) a))
+    ((:representation l_value) [])))
+
+(syntax: #export (freeze expr)
+  (with_gensyms [g!_]
+    (wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr))))))))
+
+(implementation: #export (equivalence (^open "_\."))
+  (All [a] (-> (Equivalence a) (Equivalence (Lazy a))))
+  
+  (def: (= left right)
+    (_\= (..thaw left) (..thaw right))))
+
+(implementation: #export functor
+  (Functor Lazy)
+  
+  (def: (map f fa)
+    (freeze (f (thaw fa)))))
+
+(implementation: #export apply
+  (Apply Lazy)
+  
+  (def: &functor ..functor)
+  (def: (apply ff fa)
+    (freeze ((thaw ff) (thaw fa)))))
+
+(implementation: #export monad
+  (Monad Lazy)
+  
+  (def: &functor ..functor)
+  (def: wrap (|>> freeze))
+  (def: join thaw))
diff --git a/stdlib/source/library/lux/data/maybe.lux b/stdlib/source/library/lux/data/maybe.lux
new file mode 100644
index 000000000..d7f010f13
--- /dev/null
+++ b/stdlib/source/library/lux/data/maybe.lux
@@ -0,0 +1,151 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]
+     [apply (#+ Apply)]
+     ["." functor (#+ Functor)]
+     ["." monad (#+ Monad do)]]
+    [meta
+     ["." location]]]])
+
+## (type: (Maybe a)
+##   #.None
+##   (#.Some a))
+
+(implementation: #export monoid
+  (All [a] (Monoid (Maybe a)))
+  
+  (def: identity #.None)
+  
+  (def: (compose mx my)
+    (case mx
+      #.None
+      my
+      
+      (#.Some x)
+      (#.Some x))))
+
+(implementation: #export functor
+  (Functor Maybe)
+  
+  (def: (map f ma)
+    (case ma
+      #.None     #.None
+      (#.Some a) (#.Some (f a)))))
+
+(implementation: #export apply
+  (Apply Maybe)
+  
+  (def: &functor ..functor)
+
+  (def: (apply ff fa)
+    (case [ff fa]
+      [(#.Some f) (#.Some a)]
+      (#.Some (f a))
+
+      _
+      #.None)))
+
+(implementation: #export monad
+  (Monad Maybe)
+  
+  (def: &functor ..functor)
+
+  (def: (wrap x)
+    (#.Some x))
+
+  (def: (join mma)
+    (case mma
+      #.None
+      #.None
+      
+      (#.Some mx)
+      mx)))
+
+(implementation: #export (equivalence super)
+  (All [a] (-> (Equivalence a) (Equivalence (Maybe a))))
+  
+  (def: (= mx my)
+    (case [mx my]
+      [#.None #.None]
+      #1
+
+      [(#.Some x) (#.Some y)]
+      (\ super = x y)
+      
+      _
+      #0)))
+
+(implementation: #export (hash super)
+  (All [a] (-> (Hash a) (Hash (Maybe a))))
+
+  (def: &equivalence
+    (..equivalence (\ super &equivalence)))
+  
+  (def: (hash value)
+    (case value
+      #.None
+      0
+
+      (#.Some value)
+      (\ super hash value))))
+
+(implementation: #export (with monad)
+  (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
+
+  (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))
+
+  (def: wrap (|>> (\ ..monad wrap) (\ monad wrap)))
+  
+  (def: (join MmMma)
+    (do monad
+      [mMma MmMma]
+      (case mMma
+        #.None
+        (wrap #.None)
+
+        (#.Some Mma)
+        Mma))))
+
+(def: #export (lift monad)
+  (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
+  (\ monad map (\ ..monad wrap)))
+
+(macro: #export (default tokens state)
+  {#.doc (doc "Allows you to provide a default value that will be used"
+              "if a (Maybe x) value turns out to be #.None."
+              "Note: the expression for the default value will not be computed if the base computation succeeds."
+              (default +20 (#.Some +10))
+              "=>"
+              +10
+              (default +20 #.None)
+              "=>"
+              +20)}
+  (case tokens
+    (^ (list else maybe))
+    (let [g!temp (: Code [location.dummy (#.Identifier ["" ""])])]
+      (#.Right [state (list (` (case (~ maybe)
+                                 (#.Some (~ g!temp))
+                                 (~ g!temp)
+
+                                 #.None
+                                 (~ else))))]))
+
+    _
+    (#.Left "Wrong syntax for default")))
+
+(def: #export assume
+  (All [a] (-> (Maybe a) a))
+  (|>> (..default (undefined))))
+
+(def: #export (to-list value)
+  (All [a] (-> (Maybe a) (List a)))
+  (case value
+    #.None
+    #.Nil
+
+    (#.Some value)
+    (#.Cons value #.Nil)))
diff --git a/stdlib/source/library/lux/data/name.lux b/stdlib/source/library/lux/data/name.lux
new file mode 100644
index 000000000..6a89a1aa6
--- /dev/null
+++ b/stdlib/source/library/lux/data/name.lux
@@ -0,0 +1,64 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]
+     [order (#+ Order)]
+     [codec (#+ Codec)]]
+    [data
+     ["." text ("#\." equivalence monoid)]
+     ["." product]]]])
+
+## (type: Name
+##   [Text Text])
+
+(template [ ]
+  [(def: #export ( [module short])
+     (-> Name Text)
+     )]
+
+  [module module]
+  [short  short]
+  )
+
+(def: #export hash
+  (Hash Name)
+  (product.hash text.hash text.hash))
+
+(def: #export equivalence
+  (Equivalence Name)
+  (\ ..hash &equivalence))
+
+(implementation: #export order
+  (Order Name)
+  
+  (def: &equivalence ..equivalence)
+  (def: (< [moduleP shortP] [moduleS shortS])
+    (if (text\= moduleP moduleS)
+      (\ text.order < shortP shortS)
+      (\ text.order < moduleP moduleS))))
+
+(def: separator
+  ".")
+
+(implementation: #export codec
+  (Codec Text Name)
+  
+  (def: (encode [module short])
+    (case module
+      "" short
+      _ ($_ text\compose module ..separator short)))
+  
+  (def: (decode input)
+    (if (text\= "" input)
+      (#.Left (text\compose "Invalid format for Name: " input))
+      (case (text.split_all_with ..separator input)
+        (^ (list short))
+        (#.Right ["" short])
+
+        (^ (list module short))
+        (#.Right [module short])
+
+        _
+        (#.Left (text\compose "Invalid format for Name: " input))))))
diff --git a/stdlib/source/library/lux/data/product.lux b/stdlib/source/library/lux/data/product.lux
new file mode 100644
index 000000000..6cf05ac83
--- /dev/null
+++ b/stdlib/source/library/lux/data/product.lux
@@ -0,0 +1,69 @@
+(.module:
+  {#.doc "Functionality for working with tuples (particularly 2-tuples)."}
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]]])
+
+(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)))
+  (function (_ x y)
+    (f [x y])))
+
+(def: #export (uncurry f)
+  (All [a b c]
+    (-> (-> a b c)
+        (-> (& a b) c)))
+  (function (_ 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]))
+
+(def: #export (apply f g)
+  (All [a b c d]
+    (-> (-> a c) (-> b d)
+        (-> (& a b) (& c d))))
+  (function (_ [x y])
+    [(f x) (g y)]))
+
+(def: #export (fork f g)
+  (All [a l r]
+    (-> (-> a l) (-> a r)
+        (-> a (& l r))))
+  (function (_ x)
+    [(f x) (g x)]))
+
+(implementation: #export (equivalence left right)
+  (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence [l r])))
+
+  (def: (= [rl rr] [sl sr])
+    (and (\ left = rl sl)
+         (\ right = rr sr))))
+
+(def: #export (hash left right)
+  (All [l r] (-> (Hash l) (Hash r) (Hash (& l r))))
+  (implementation
+   (def: &equivalence
+     (..equivalence (\ left &equivalence)
+                    (\ right &equivalence)))
+   (def: (hash [leftV rightV])
+     ("lux i64 +"
+      (\ left hash leftV)
+      (\ right hash rightV)))))
diff --git a/stdlib/source/library/lux/data/store.lux b/stdlib/source/library/lux/data/store.lux
new file mode 100644
index 000000000..3a6d73386
--- /dev/null
+++ b/stdlib/source/library/lux/data/store.lux
@@ -0,0 +1,50 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [functor (#+ Functor)]
+     comonad]
+    [type
+     implicit]]])
+
+(type: #export (Store s a)
+  {#cursor s
+   #peek (-> s a)})
+
+(def: (extend f wa)
+  (All [s a b] (-> (-> (Store s a) b) (Store s a) (Store s b)))
+  {#cursor (get@ #cursor wa)
+   #peek (function (_ s) (f (set@ #cursor s wa)))})
+
+(implementation: #export functor
+  (All [s] (Functor (Store s)))
+  
+  (def: (map f fa)
+    (extend (function (_ store)
+              (f (\ store peek (\ store cursor))))
+            fa)))
+
+(implementation: #export comonad
+  (All [s] (CoMonad (Store s)))
+  
+  (def: &functor ..functor)
+
+  (def: (unwrap wa) (\\ peek (\\ cursor)))
+
+  (def: split (extend id)))
+
+(def: #export (peeks trans store)
+  (All [s a] (-> (-> s s) (Store s a) a))
+  (|> (\\ cursor) trans (\\ peek)))
+
+(def: #export (seek cursor store)
+  (All [s a] (-> s (Store s a) (Store s a)))
+  (\ (\\ split store) peek cursor))
+
+(def: #export (seeks change store)
+  (All [s a] (-> (-> s s) (Store s a) (Store s a)))
+  (|> store (\\ split) (peeks change)))
+
+(def: #export (experiment Functor change store)
+  (All [f s a] (-> (Functor f) (-> s (f s)) (Store s a) (f a)))
+  (\ Functor map (\\ peek) (change (\\ cursor))))
diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux
new file mode 100644
index 000000000..7a439fc54
--- /dev/null
+++ b/stdlib/source/library/lux/data/sum.lux
@@ -0,0 +1,90 @@
+(.module:
+  {#.doc "Functionality for working with variants (particularly 2-variants)."}
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]]])
+
+(template [  ]
+  [(def: #export ( value)
+     (All [a b] (->  (| a b)))
+     (0  value))]
+
+  [left  a #0]
+  [right b #1])
+
+(def: #export (either fl fr)
+  (All [a b c]
+    (-> (-> a c) (-> b c)
+        (-> (| a b) c)))
+  (function (_ input)
+    (case input
+      (0 #0 l) (fl l)
+      (0 #1 r) (fr r))))
+
+(def: #export (apply fl fr)
+  (All [l l' r r']
+    (-> (-> l l') (-> r r')
+        (-> (| l r) (| l' r'))))
+  (function (_ input)
+    (case input
+      (0 #0 l) (0 #0 (fl l))
+      (0 #1 r) (0 #1 (fr r)))))
+
+(template [  ]
+  [(def: #export ( es)
+     (All [a b] (-> (List (| a b)) (List )))
+     (case es
+       #.Nil
+       #.Nil
+       
+       (#.Cons (0  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 #0 x')  [(#.Cons x' lefts) rights]
+        (0 #1 x') [lefts (#.Cons x' rights)]))))
+
+(def: #export (equivalence left right)
+  (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence (| l r))))
+  (implementation
+   (def: (= reference sample)
+     (case [reference sample]
+       [(#.Left reference) (#.Left sample)]
+       (\ left = reference sample)
+
+       [(#.Right reference) (#.Right sample)]
+       (\ right = reference sample)
+
+       _
+       false))))
+
+(def: #export (hash left right)
+  (All [l r] (-> (Hash l) (Hash r) (Hash (| l r))))
+  (implementation
+   (def: &equivalence
+     (..equivalence (\ left &equivalence)
+                    (\ right &equivalence)))
+   (def: (hash value)
+     (case value
+       (#.Left value)
+       (\ left hash value)
+
+       (#.Right value)
+       (\ right hash value)))))
diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux
new file mode 100644
index 000000000..6acc3233c
--- /dev/null
+++ b/stdlib/source/library/lux/data/text.lux
@@ -0,0 +1,380 @@
+(.module:
+  [library
+   [lux #*
+    ["@" target]
+    [abstract
+     [hash (#+ Hash)]
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]
+     [monad (#+ Monad do)]
+     [codec (#+ Codec)]]
+    [data
+     ["." maybe]
+     [collection
+      ["." list ("#\." fold)]]]
+    [math
+     [number
+      ["n" nat]
+      ["." i64]]]]])
+
+(type: #export Char
+  Nat)
+
+## TODO: Instead of ints, chars should be produced fron nats.
+## (The JVM specifies chars as 16-bit unsigned integers)
+(def: #export from_code
+  (-> Char Text)
+  (|>> .int "lux i64 char"))
+
+(template [  ]
+  [(def: #export  (from_code ))
+   (def: #export  )]
+
+  [00 \0  null]
+  [07 \a  alarm]
+  [08 \b  back_space]
+  [09 \t  tab]
+  [10 \n  new_line]
+  [11 \v  vertical_tab]
+  [12 \f  form_feed]
+  [13 \r  carriage_return]
+  [34 \'' double_quote]
+  )
+
+(def: #export line_feed ..new_line)
+
+(def: #export size
+  (-> Text Nat)
+  (|>> "lux text size"))
+
+(def: #export (nth idx input)
+  (-> Nat Text (Maybe Char))
+  (if (n.< ("lux text size" input) idx)
+    (#.Some ("lux text char" idx input))
+    #.None))
+
+(def: #export (index_of' pattern from input)
+  (-> Text Nat Text (Maybe Nat))
+  ("lux text index" from pattern input))
+
+(def: #export (index_of pattern input)
+  (-> Text Text (Maybe Nat))
+  ("lux text index" 0 pattern input))
+
+(def: (last_index_of'' part since text)
+  (-> Text Nat Text (Maybe Nat))
+  (case ("lux text index" (inc since) part text)
+    #.None
+    (#.Some since)
+
+    (#.Some since')
+    (last_index_of'' part since' text)))
+
+(def: #export (last_index_of' part from text)
+  (-> Text Nat Text (Maybe Nat))
+  (case ("lux text index" from part text)
+    (#.Some since)
+    (last_index_of'' part since text)
+
+    #.None
+    #.None))
+
+(def: #export (last_index_of part text)
+  (-> Text Text (Maybe Nat))
+  (case ("lux text index" 0 part text)
+    (#.Some since)
+    (last_index_of'' part since text)
+
+    #.None
+    #.None))
+
+(def: #export (starts_with? prefix x)
+  (-> Text Text Bit)
+  (case (index_of prefix x)
+    (#.Some 0)
+    true
+
+    _
+    false))
+
+(def: #export (ends_with? postfix x)
+  (-> Text Text Bit)
+  (case (last_index_of postfix x)
+    (#.Some n)
+    (n.= (size x)
+         (n.+ (size postfix) n))
+
+    _
+    false))
+
+(def: #export (encloses? boundary value)
+  (-> Text Text Bit)
+  (and (starts_with? boundary value)
+       (ends_with? boundary value)))
+
+(def: #export (contains? sub text)
+  (-> Text Text Bit)
+  (case ("lux text index" 0 sub text)
+    (#.Some _)
+    true
+
+    _
+    false))
+
+(def: #export (prefix param subject)
+  (-> Text Text Text)
+  ("lux text concat" param subject))
+
+(def: #export (suffix param subject)
+  (-> Text Text Text)
+  ("lux text concat" subject param))
+
+(def: #export (enclose [left right] content)
+  {#.doc "Surrounds the given content text with left and right side additions."}
+  (-> [Text Text] Text Text)
+  ($_ "lux text concat" left content right))
+
+(def: #export (enclose' boundary content)
+  {#.doc "Surrounds the given content text with the same boundary text."}
+  (-> Text Text Text)
+  (enclose [boundary boundary] content))
+
+(def: #export format
+  (-> Text Text)
+  (..enclose' ..double_quote))
+
+(def: #export (clip offset characters input)
+  (-> Nat Nat Text (Maybe Text))
+  (if (|> characters (n.+ offset) (n.<= ("lux text size" input)))
+    (#.Some ("lux text clip" offset characters input))
+    #.None))
+
+(def: #export (clip' offset input)
+  (-> Nat Text (Maybe Text))
+  (let [size ("lux text size" input)]
+    (if (n.<= size offset)
+      (#.Some ("lux text clip" offset (n.- offset size) input))
+      #.None)))
+
+(def: #export (split at x)
+  (-> Nat Text (Maybe [Text Text]))
+  (case [(..clip 0 at x) (..clip' at x)]
+    [(#.Some pre) (#.Some post)]
+    (#.Some [pre post])
+
+    _
+    #.None))
+
+(def: #export (split_with token sample)
+  (-> Text Text (Maybe [Text Text]))
+  (do maybe.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))
+  (loop [input sample
+         output (: (List Text) (list))]
+    (case (..split_with token input)
+      (#.Some [pre post])
+      (|> output
+          (#.Cons pre)
+          (recur post))
+
+      #.None
+      (|> output
+          (#.Cons input)
+          list.reverse))))
+
+(def: #export (replace_once pattern replacement template)
+  (-> Text Text Text Text)
+  (<| (maybe.default template)
+      (do maybe.monad
+        [[pre post] (..split_with pattern template)]
+        (wrap ($_ "lux text concat" pre replacement post)))))
+
+(def: #export (replace_all pattern replacement template)
+  (-> Text Text Text Text)
+  (for {@.old
+        (:as Text
+             ("jvm invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"
+              (:as (primitive "java.lang.String") template)
+              (:as (primitive "java.lang.CharSequence") pattern)
+              (:as (primitive "java.lang.CharSequence") replacement)))
+        @.jvm
+        (:as Text
+             ("jvm member invoke virtual" [] "java.lang.String" "replace" []
+              (:as (primitive "java.lang.String") template)
+              ["Ljava/lang/CharSequence;" (:as (primitive "java.lang.CharSequence") pattern)]
+              ["Ljava/lang/CharSequence;" (:as (primitive "java.lang.CharSequence") replacement)]))
+        ## TODO: Comment/turn-off when generating a JS compiler using a JVM-based compiler because Nashorn's implementation of "replaceAll" is incorrect. 
+        @.js
+        (:as Text
+             ("js object do" "replaceAll" template [pattern replacement]))
+        @.python
+        (:as Text
+             ("python object do" "replace" template pattern replacement))
+        ## TODO @.lua
+        @.ruby
+        (:as Text
+             ("ruby object do" "gsub" template pattern replacement))
+        @.php
+        (:as Text
+             ("php apply" (:assume ("php constant" "str_replace"))
+              pattern replacement template))
+        ## TODO @.scheme
+        ## TODO @.common_lisp
+        ## TODO @.r
+        }
+       ## Inefficient default
+       (loop [left ""
+              right template]
+         (case (..split_with pattern right)
+           (#.Some [pre post])
+           (recur ($_ "lux text concat" left pre replacement) post)
+
+           #.None
+           ("lux text concat" left right)))))
+
+(implementation: #export equivalence
+  (Equivalence Text)
+  
+  (def: (= reference sample)
+    ("lux text =" reference sample)))
+
+(implementation: #export order
+  (Order Text)
+  
+  (def: &equivalence ..equivalence)
+
+  (def: (< reference sample)
+    ("lux text <" reference sample)))
+
+(implementation: #export monoid
+  (Monoid Text)
+  
+  (def: identity "")
+  
+  (def: (compose left right)
+    ("lux text concat" left right)))
+
+(implementation: #export hash
+  (Hash Text)
+  
+  (def: &equivalence ..equivalence)
+  
+  (def: (hash input)
+    (for {@.old
+          (|> input
+              (: (primitive "java.lang.String"))
+              "jvm invokevirtual:java.lang.String:hashCode:"
+              "jvm convert int-to-long"
+              (:as Nat))
+
+          @.jvm
+          (|> input
+              (:as (primitive "java.lang.String"))
+              ("jvm member invoke virtual" [] "java.lang.String" "hashCode" [])
+              "jvm conversion int-to-long"
+              "jvm object cast"
+              (: (primitive "java.lang.Long"))
+              (:as Nat))}
+         ## Platform-independent default.
+         (let [length ("lux text size" input)]
+           (loop [idx 0
+                  hash 0]
+             (if (n.< length idx)
+               (recur (inc idx)
+                      (|> hash
+                          (i64.left_shift 5)
+                          (n.- hash)
+                          (n.+ ("lux text char" idx input))))
+               hash))))))
+
+(def: #export concat
+  (-> (List Text) Text)
+  (let [(^open ".") ..monoid]
+    (|>> list.reverse (list\fold compose identity))))
+
+(def: #export (join_with sep texts)
+  (-> Text (List Text) Text)
+  (|> texts (list.interpose sep) concat))
+
+(def: #export (empty? text)
+  (-> Text Bit)
+  (case text
+    "" true
+    _  false))
+
+(def: #export space
+  Text
+  " ")
+
+(def: #export (space? char)
+  {#.doc "Checks whether the character is white-space."}
+  (-> Char Bit)
+  (with_expansions [ (template []
+                                [(^ (char (~~ (static ))))]
+
+                                [..tab]
+                                [..vertical_tab]
+                                [..space]
+                                [..new_line]
+                                [..carriage_return]
+                                [..form_feed]
+                                )]
+    (`` (case char
+          (^or )
+          true
+
+          _
+          false))))
+
+(def: #export (lower_case value)
+  (-> Text Text)
+  (for {@.old
+        (:as Text
+             ("jvm invokevirtual:java.lang.String:toLowerCase:"
+              (:as (primitive "java.lang.String") value)))
+        @.jvm
+        (:as Text
+             ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" []
+              (:as (primitive "java.lang.String") value)))
+        @.js
+        (:as Text
+             ("js object do" "toLowerCase" value []))
+        @.python
+        (:as Text
+             ("python object do" "lower" value))
+        @.lua
+        (:as Text
+             ("lua apply" ("lua constant" "string.lower") value))
+        @.ruby
+        (:as Text
+             ("ruby object do" "downcase" value))}))
+
+(def: #export (upper_case value)
+  (-> Text Text)
+  (for {@.old
+        (:as Text
+             ("jvm invokevirtual:java.lang.String:toUpperCase:"
+              (:as (primitive "java.lang.String") value)))
+        @.jvm
+        (:as Text
+             ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" []
+              (:as (primitive "java.lang.String") value)))
+        @.js
+        (:as Text
+             ("js object do" "toUpperCase" value []))
+        @.python
+        (:as Text
+             ("python object do" "upper" value))
+        @.lua
+        (:as Text
+             ("lua apply" ("lua constant" "string.upper") value))
+        @.ruby
+        (:as Text
+             ("ruby object do" "upcase" value))}))
diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux
new file mode 100644
index 000000000..5766d25ef
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/buffer.lux
@@ -0,0 +1,115 @@
+(.module:
+  [library
+   [lux #*
+    [ffi (#+ import:)]
+    ["@" target]
+    [control
+     ["." function]]
+    [data
+     ["." product]
+     [text
+      ["%" format (#+ format)]]
+     [collection
+      ["." array]
+      ["." row (#+ Row) ("#\." fold)]]]
+    [math
+     [number
+      ["n" nat]]]
+    [type
+     abstract]]]
+  ["." //])
+
+(with_expansions [ (as_is (import: java/lang/CharSequence)
+
+                               (import: java/lang/Appendable
+                                 ["#::."
+                                  (append [java/lang/CharSequence] java/lang/Appendable)])
+
+                               (import: java/lang/String
+                                 ["#::."
+                                  (new [int])
+                                  (toString [] java/lang/String)])
+
+                               (import: java/lang/StringBuilder
+                                 ["#::."
+                                  (new [int])
+                                  (toString [] java/lang/String)]))]
+  (`` (for {@.old (as_is )
+            @.jvm (as_is )
+            @.lua (as_is (import: (table/concat [(array.Array Text) Text] Text))
+                         ##https://www.lua.org/manual/5.3/manual.html#pdf-table.concat
+                         (import: (table/insert [(array.Array Text) Text] #? Nothing))
+                         ## https://www.lua.org/manual/5.3/manual.html#pdf-table.insert
+                         )}
+           (as_is))))
+
+(`` (abstract: #export Buffer
+      (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]
+            @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)]
+            @.lua [Nat (-> (array.Array Text) (array.Array Text))]}
+           ## default
+           (Row Text))
+
+      {#.doc "Immutable text buffer for efficient text concatenation."}
+
+      (def: #export empty
+        Buffer
+        (:abstraction (with_expansions [ [0 function.identity]]
+                        (for {@.old 
+                              @.jvm 
+                              @.lua [0 function.identity]}
+                             ## default
+                             row.empty))))
+
+      (def: #export (append chunk buffer)
+        (-> Text Buffer Buffer)
+        (with_expansions [ (let [[capacity transform] (:representation buffer)
+                                      append! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder)
+                                                 (function (_ chunk builder)
+                                                   (exec
+                                                     (java/lang/Appendable::append (:as java/lang/CharSequence chunk)
+                                                                                   builder)
+                                                     builder)))]
+                                  (:abstraction [(n.+ (//.size chunk) capacity)
+                                                 (|>> transform (append! chunk))]))]
+          (for {@.old 
+                @.jvm 
+                @.lua (let [[capacity transform] (:representation buffer)
+                            append! (: (-> Text (array.Array Text) (array.Array Text))
+                                       (function (_ chunk array)
+                                         (exec
+                                           (table/insert [array chunk])
+                                           array)))]
+                        (:abstraction [(n.+ (//.size chunk) capacity)
+                                       (|>> transform (append! chunk))]))}
+               ## default
+               (|> buffer :representation (row.add chunk) :abstraction))))
+
+      (def: #export size
+        (-> Buffer Nat)
+        (with_expansions [ (|>> :representation product.left)]
+          (for {@.old 
+                @.jvm 
+                @.lua }
+               ## default
+               (|>> :representation
+                    (row\fold (function (_ chunk total)
+                                (n.+ (//.size chunk) total))
+                              0)))))
+
+      (def: #export (text buffer)
+        (-> Buffer Text)
+        (with_expansions [ (let [[capacity transform] (:representation buffer)]
+                                  (|> (java/lang/StringBuilder::new (.int capacity))
+                                      transform
+                                      java/lang/StringBuilder::toString))]
+          (for {@.old 
+                @.jvm 
+                @.lua (let [[capacity transform] (:representation buffer)]
+                        (table/concat [(transform (array.new 0)) ""]))}
+               ## default
+               (row\fold (function (_ chunk total)
+                           (format total chunk))
+                         ""
+                         (:representation buffer)))))
+      ))
diff --git a/stdlib/source/library/lux/data/text/encoding.lux b/stdlib/source/library/lux/data/text/encoding.lux
new file mode 100644
index 000000000..3ecb5b4e0
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/encoding.lux
@@ -0,0 +1,163 @@
+(.module:
+  [library
+   [lux #*
+    [type
+     abstract]]])
+
+## https://docs.oracle.com/javase/8/docs/technotes/guides/intl/encoding.doc.html
+
+(abstract: #export Encoding
+  Text
+
+  (template [ ]
+    [(def: #export  Encoding (:abstraction ))]
+
+    [ascii "ASCII"]
+
+    [ibm_37 "IBM037"]
+    [ibm_273 "IBM273"]
+    [ibm_277 "IBM277"]
+    [ibm_278 "IBM278"]
+    [ibm_280 "IBM280"]
+    [ibm_284 "IBM284"]
+    [ibm_285 "IBM285"]
+    [ibm_290 "IBM290"]
+    [ibm_297 "IBM297"]
+    [ibm_300 "IBM300"]
+    [ibm_420 "IBM420"]
+    [ibm_424 "IBM424"]
+    [ibm_437 "IBM437"]
+    [ibm_500 "IBM500"]
+    [ibm_737 "IBM737"]
+    [ibm_775 "IBM775"]
+    [ibm_833 "IBM833"]
+    [ibm_834 "IBM834"]
+    [ibm_838 "IBM-Thai"]
+    [ibm_850 "IBM850"]
+    [ibm_852 "IBM852"]
+    [ibm_855 "IBM855"]
+    [ibm_856 "IBM856"]
+    [ibm_857 "IBM857"]
+    [ibm_858 "IBM00858"]
+    [ibm_860 "IBM860"]
+    [ibm_861 "IBM861"]
+    [ibm_862 "IBM862"]
+    [ibm_863 "IBM863"]
+    [ibm_864 "IBM864"]
+    [ibm_865 "IBM865"]
+    [ibm_866 "IBM866"]
+    [ibm_868 "IBM868"]
+    [ibm_869 "IBM869"]
+    [ibm_870 "IBM870"]
+    [ibm_871 "IBM871"]
+    [ibm_874 "IBM874"]
+    [ibm_875 "IBM875"]
+    [ibm_918 "IBM918"]
+    [ibm_921 "IBM921"]
+    [ibm_922 "IBM922"]
+    [ibm_930 "IBM930"]
+    [ibm_933 "IBM933"]
+    [ibm_935 "IBM935"]
+    [ibm_937 "IBM937"]
+    [ibm_939 "IBM939"]
+    [ibm_942 "IBM942"]
+    [ibm_942c "IBM942C"]
+    [ibm_943 "IBM943"]
+    [ibm_943c "IBM943C"]
+    [ibm_948 "IBM948"]
+    [ibm_949 "IBM949"]
+    [ibm_949c "IBM949C"]
+    [ibm_950 "IBM950"]
+    [ibm_964 "IBM964"]
+    [ibm_970 "IBM970"]
+    [ibm_1006 "IBM1006"]
+    [ibm_1025 "IBM1025"]
+    [ibm_1026 "IBM1026"]
+    [ibm_1046 "IBM1046"]
+    [ibm_1047 "IBM1047"]
+    [ibm_1097 "IBM1097"]
+    [ibm_1098 "IBM1098"]
+    [ibm_1112 "IBM1112"]
+    [ibm_1122 "IBM1122"]
+    [ibm_1123 "IBM1123"]
+    [ibm_1124 "IBM1124"]
+    [ibm_1140 "IBM01140"]
+    [ibm_1141 "IBM01141"]
+    [ibm_1142 "IBM01142"]
+    [ibm_1143 "IBM01143"]
+    [ibm_1144 "IBM01144"]
+    [ibm_1145 "IBM01145"]
+    [ibm_1146 "IBM01146"]
+    [ibm_1147 "IBM01147"]
+    [ibm_1148 "IBM01148"]
+    [ibm_1149 "IBM01149"]
+    [ibm_1166 "IBM1166"]
+    [ibm_1364 "IBM1364"]
+    [ibm_1381 "IBM1381"]
+    [ibm_1383 "IBM1383"]
+    [ibm_33722 "IBM33722"]
+    
+    [iso_2022_cn "ISO-2022-CN"]
+    [iso2022_cn_cns "ISO2022-CN-CNS"]
+    [iso2022_cn_gb "ISO2022-CN-GB"]
+    [iso_2022_jp "ISO-2022-JP"]
+    [iso_2022_jp_2 "ISO-2022-JP-2"]
+    [iso_2022_kr "ISO-2022-KR"]
+    [iso_8859_1 "ISO-8859-1"]
+    [iso_8859_2 "ISO-8859-2"]
+    [iso_8859_3 "ISO-8859-3"]
+    [iso_8859_4 "ISO-8859-4"]
+    [iso_8859_5 "ISO-8859-5"]
+    [iso_8859_6 "ISO-8859-6"]
+    [iso_8859_7 "ISO-8859-7"]
+    [iso_8859_8 "ISO-8859-8"]
+    [iso_8859_9 "ISO-8859-9"]
+    [iso_8859_11 "iso-8859-11"]
+    [iso_8859_13 "ISO-8859-13"]
+    [iso_8859_15 "ISO-8859-15"]
+
+    [mac_arabic "MacArabic"]
+    [mac_central_europe "MacCentralEurope"]
+    [mac_croatian "MacCroatian"]
+    [mac_cyrillic "MacCyrillic"]
+    [mac_dingbat "MacDingbat"]
+    [mac_greek "MacGreek"]
+    [mac_hebrew "MacHebrew"]
+    [mac_iceland "MacIceland"]
+    [mac_roman "MacRoman"]
+    [mac_romania "MacRomania"]
+    [mac_symbol "MacSymbol"]
+    [mac_thai "MacThai"]
+    [mac_turkish "MacTurkish"]
+    [mac_ukraine "MacUkraine"]
+    
+    [utf_8 "UTF-8"]
+    [utf_16 "UTF-16"]
+    [utf_32 "UTF-32"]
+
+    [windows_31j "windows-31j"]
+    [windows_874 "windows-874"]
+    [windows_949 "windows-949"]
+    [windows_950 "windows-950"]
+    [windows_1250 "windows-1250"]
+    [windows_1252 "windows-1252"]
+    [windows_1251 "windows-1251"]
+    [windows_1253 "windows-1253"]
+    [windows_1254 "windows-1254"]
+    [windows_1255 "windows-1255"]
+    [windows_1256 "windows-1256"]
+    [windows_1257 "windows-1257"]
+    [windows_1258 "windows-1258"]
+    [windows_iso2022jp "windows-iso2022jp"]
+    [windows_50220 "windows-50220"]
+    [windows_50221 "windows-50221"]
+    
+    [cesu_8 "CESU-8"]
+    [koi8_r "KOI8-R"]
+    [koi8_u "KOI8-U"]
+    )
+
+  (def: #export name
+    (-> Encoding Text)
+    (|>> :representation))
+  )
diff --git a/stdlib/source/library/lux/data/text/encoding/utf8.lux b/stdlib/source/library/lux/data/text/encoding/utf8.lux
new file mode 100644
index 000000000..b24c88837
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/encoding/utf8.lux
@@ -0,0 +1,164 @@
+(.module:
+  [library
+   [lux #*
+    ["@" target]
+    ["." ffi]
+    [abstract
+     [codec (#+ Codec)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." binary (#+ Binary)]]]]
+  ["." //])
+
+(with_expansions [ (as_is (ffi.import: java/lang/String
+                                 ["#::."
+                                  (new [[byte] java/lang/String])
+                                  (getBytes [java/lang/String] [byte])]))]
+  (for {@.old (as_is )
+        @.jvm (as_is )
+
+        @.js
+        (as_is (ffi.import: Uint8Array)
+
+               ## On Node
+               (ffi.import: Buffer
+                 ["#::."
+                  (#static from #as from|encode [ffi.String ffi.String] Buffer)
+                  (#static from #as from|decode [Uint8Array] Buffer)
+                  (toString [ffi.String] ffi.String)])
+
+               ## On the browser
+               (ffi.import: TextEncoder
+                 ["#::."
+                  (new [ffi.String])
+                  (encode [ffi.String] Uint8Array)])
+               
+               (ffi.import: TextDecoder
+                 ["#::."
+                  (new [ffi.String])
+                  (decode [Uint8Array] ffi.String)]))
+
+        @.ruby
+        (as_is (ffi.import: String #as RubyString
+                 ["#::."
+                  (encode [Text] RubyString)
+                  (force_encoding [Text] Text)
+                  (bytes [] Binary)])
+
+               (ffi.import: Array #as RubyArray
+                 ["#::."
+                  (pack [Text] RubyString)]))
+
+        @.php
+        (as_is (ffi.import: Almost_Binary)
+               (ffi.import: (unpack [ffi.String ffi.String] Almost_Binary))
+               (ffi.import: (array_values [Almost_Binary] Binary))
+               (def: php_byte_array_format "C*"))
+
+        @.scheme
+        ## https://srfi.schemers.org/srfi-140/srfi-140.html
+        (as_is (ffi.import: (string->utf8 [Text] Binary))
+               (ffi.import: (utf8->string [Binary] Text)))}
+       (as_is)))
+
+(def: (encode value)
+  (-> Text Binary)
+  (for {@.old
+        (java/lang/String::getBytes (//.name //.utf_8)
+                                    ## TODO: Remove coercion below.
+                                    ## The coercion below may seem
+                                    ## gratuitous, but removing it
+                                    ## causes a grave compilation problem.
+                                    (:as java/lang/String value))
+
+        @.jvm
+        (java/lang/String::getBytes (//.name //.utf_8) value)
+
+        @.js
+        (cond ffi.on_nashorn?
+              (:as Binary ("js object do" "getBytes" value ["utf8"]))
+              
+              ffi.on_node_js?
+              (|> (Buffer::from|encode [value "utf8"])
+                  ## This coercion is valid as per NodeJS's documentation:
+                  ## https://nodejs.org/api/buffer.html#buffer_buffers_and_typedarrays
+                  (:as Uint8Array))
+              
+              ## On the browser
+              (|> (TextEncoder::new [(//.name //.utf_8)])
+                  (TextEncoder::encode [value]))
+              )
+
+        @.python
+        (:as Binary ("python apply" (:assume ("python constant" "bytearray")) value "utf-8"))
+
+        @.lua
+        ("lua utf8 encode" value)
+
+        @.ruby
+        (|> value
+            (:as RubyString)
+            (RubyString::encode ["UTF-8"])
+            (RubyString::bytes []))
+
+        @.php
+        (|> (..unpack [..php_byte_array_format value])
+            ..array_values
+            ("php object new" "ArrayObject")
+            (:as Binary))
+
+        @.scheme
+        (..string->utf8 value)}))
+
+(def: (decode value)
+  (-> Binary (Try Text))
+  (with_expansions [ (#try.Success (java/lang/String::new value (//.name //.utf_8)))]
+    (for {@.old 
+          @.jvm 
+
+          @.js
+          (cond ffi.on_nashorn?
+                (|> ("js object new" ("js constant" "java.lang.String") [value "utf8"])
+                    (:as Text)
+                    #try.Success)
+
+                ffi.on_node_js?
+                (|> (Buffer::from|decode [value])
+                    (Buffer::toString ["utf8"])
+                    #try.Success)
+                
+                ## On the browser
+                (|> (TextDecoder::new [(//.name //.utf_8)])
+                    (TextDecoder::decode [value])
+                    #try.Success))
+
+          @.python
+          (try (:as Text ("python object do" "decode" (:assume value) "utf-8")))
+
+          @.lua
+          (#try.Success ("lua utf8 decode" value))
+
+          @.ruby
+          (|> value
+              (:as RubyArray)
+              (RubyArray::pack ["C*"])
+              (:as RubyString)
+              (RubyString::force_encoding ["UTF-8"])
+              #try.Success)
+
+          @.php
+          (|> value
+              ("php pack" ..php_byte_array_format)
+              #try.Success)
+
+          @.scheme
+          (|> value
+              ..utf8->string
+              #try.Success)})))
+
+(implementation: #export codec
+  (Codec Binary Text)
+  
+  (def: encode ..encode)
+  (def: decode ..decode))
diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux
new file mode 100644
index 000000000..2e9883c78
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/escape.lux
@@ -0,0 +1,244 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["<.>" code]]]
+    [data
+     ["." maybe]]
+    [math
+     [number (#+ hex)
+      ["n" nat]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]]]
+  ["." // (#+ Char)
+   ["%" format (#+ format)]])
+
+(def: sigil "\")
+
+(template [ ]
+  [(def: 
+     (|>  (//.nth 0) maybe.assume))]
+
+  [sigil_char ..sigil]
+  [\u_sigil "u"]
+  )
+
+(template [  ]
+  [(def: 
+     (|>  (//.nth 0) maybe.assume))
+   
+   (def: 
+     (format ..sigil ))]
+
+  ["0" \0_sigil escaped_\0]
+  ["a" \a_sigil escaped_\a]
+  ["b" \b_sigil escaped_\b]
+  ["t" \t_sigil escaped_\t]
+  ["n" \n_sigil escaped_\n]
+  ["v" \v_sigil escaped_\v]
+  ["f" \f_sigil escaped_\f]
+  ["r" \r_sigil escaped_\r]
+  [//.\'' \''_sigil escaped_\'']
+  [..sigil \\_sigil escaped_\\]
+  )
+
+(template [ ]
+  [(def: 
+     (|>  (//.nth 0) maybe.assume))]
+
+  [\0 //.\0]
+  [\a //.\a]
+  [\b //.\b]
+  [\t //.\t]
+  [\n //.\n]
+  [\v //.\v]
+  [\f //.\f]
+  [\r //.\r]
+  [\'' //.\'']
+  [\\ ..sigil]
+  )
+
+(def: ascii_bottom (hex "20"))
+(def: ascii_top (hex "7E"))
+
+(def: #export (escapable? char)
+  (-> Char Bit)
+  (case char
+    (^template []
+      [(^ (static ))
+       true])
+    ([..\0] [..\a] [..\b] [..\t]
+     [..\n] [..\v] [..\f] [..\r]
+     [..\''] [..\\])
+
+    _
+    (or (n.< ..ascii_bottom char)
+        (n.> ..ascii_top char))))
+
+(def: (ascii_escape replacement pre_offset pre_limit previous current)
+  (-> Text Nat Nat Text Text [Text Text Nat])
+  (let [post_offset (inc pre_offset)
+        post_limit (n.- post_offset pre_limit)]
+    [(format previous
+             ("lux text clip" 0 pre_offset current)
+             replacement)
+     ("lux text clip" post_offset post_limit current)
+     post_limit]))
+
+(def: (unicode_escape char pre_offset pre_limit previous current)
+  (-> Char Nat Nat Text Text [Text Text Nat])
+  (let [code (\ n.hex encode char)
+        replacement (format ..sigil "u"
+                            (case ("lux text size" code)
+                              1 (format "000" code)
+                              2 (format "00" code)
+                              3 (format "0" code)
+                              _ code))
+        post_offset (inc pre_offset)
+        post_limit (n.- post_offset pre_limit)]
+    [(format previous
+             ("lux text clip" 0 pre_offset current)
+             replacement)
+     ("lux text clip" post_offset post_limit current)
+     post_limit]))
+
+(def: #export (escape text)
+  (-> Text Text)
+  (loop [offset 0
+         previous ""
+         current text
+         limit ("lux text size" text)]
+    (if (n.< limit offset)
+      (case ("lux text char" offset current)
+        (^template [ ]
+          [(^ (static ))
+           (let [[previous' current' limit'] (ascii_escape  offset limit previous current)]
+             (recur 0 previous' current' limit'))])
+        ([..\0 ..escaped_\0]
+         [..\a ..escaped_\a]
+         [..\b ..escaped_\b]
+         [..\t ..escaped_\t]
+         [..\n ..escaped_\n]
+         [..\v ..escaped_\v]
+         [..\f ..escaped_\f]
+         [..\r ..escaped_\r]
+         [..\'' ..escaped_\'']
+         [..\\ ..escaped_\\])
+
+        char
+        (if (or (n.< ..ascii_bottom char)
+                (n.> ..ascii_top char))
+          (let [[previous' current' limit'] (unicode_escape char offset limit previous current)]
+            (recur 0 previous' current' limit'))
+          (recur (inc offset) previous current limit)))
+      (format previous current))))
+
+(exception: #export (dangling_escape {text Text})
+  (exception.report
+   ["In" (%.text text)]
+   ["At" (%.nat (dec (//.size text)))]))
+
+(exception: #export (invalid_escape {text Text} {offset Nat} {sigil Char})
+  (exception.report
+   ["In" (%.text text)]
+   ["At" (%.nat offset)]
+   ["Name" (%.text (//.from_code sigil))]))
+
+(exception: #export (invalid_unicode_escape {text Text} {offset Nat})
+  (exception.report
+   ["In" (%.text text)]
+   ["At" (%.nat offset)]))
+
+(def: code_size
+  4)
+
+(def: ascii_escape_offset
+  2)
+
+(def: unicode_escape_offset
+  (n.+ ..ascii_escape_offset ..code_size))
+
+(def: (ascii_un_escape replacement offset previous current limit)
+  (-> Text Nat Text Text Nat [Text Text Nat])
+  (let [limit' (|> limit (n.- offset) (n.- ..ascii_escape_offset))]
+    [(format previous
+             ("lux text clip" 0 offset current)
+             replacement)
+     ("lux text clip" (n.+ ..ascii_escape_offset offset) limit' current)
+     limit']))
+
+(def: (unicode_un_escape offset previous current limit)
+  (-> Nat Text Text Nat (Try [Text Text Nat]))
+  (case (|> current
+            ("lux text clip" (n.+ ..ascii_escape_offset offset) ..code_size)
+            (\ n.hex decode))
+    (#try.Success char)
+    (let [limit' (|> limit (n.- offset) (n.- ..unicode_escape_offset))]
+      (#try.Success [(format previous
+                             ("lux text clip" 0 offset current)
+                             (//.from_code char))
+                     ("lux text clip" (n.+ ..unicode_escape_offset offset) limit' current)
+                     limit']))
+    
+    (#try.Failure error)
+    (exception.throw ..invalid_unicode_escape [current offset])))
+
+(def: #export (un_escape text)
+  (-> Text (Try Text))
+  (loop [offset 0
+         previous ""
+         current text
+         limit ("lux text size" text)]
+    (if (n.< limit offset)
+      (case ("lux text char" offset current)
+        (^ (static ..sigil_char))
+        (let [@sigil (inc offset)]
+          (if (n.< limit @sigil)
+            (case ("lux text char" @sigil current)
+              (^template [ ]
+                [(^ (static ))
+                 (let [[previous' current' limit'] (..ascii_un_escape  offset previous current limit)]
+                   (recur 0 previous' current' limit'))])
+              ([..\0_sigil //.\0]
+               [..\a_sigil //.\a]
+               [..\b_sigil //.\b]
+               [..\t_sigil //.\t]
+               [..\n_sigil //.\n]
+               [..\v_sigil //.\v]
+               [..\f_sigil //.\f]
+               [..\r_sigil //.\r]
+               [..\''_sigil //.\'']
+               [..\\_sigil ..sigil])
+
+              (^ (static ..\u_sigil))
+              (let [@unicode (n.+ code_size @sigil)]
+                (if (n.< limit @unicode)
+                  (do try.monad
+                    [[previous' current' limit'] (..unicode_un_escape offset previous current limit)]
+                    (recur 0 previous' current' limit'))
+                  (exception.throw ..invalid_unicode_escape [text offset])))
+
+              invalid_sigil
+              (exception.throw ..invalid_escape [text offset invalid_sigil]))
+            (exception.throw ..dangling_escape [text])))
+
+        _
+        (recur (inc offset) previous current limit))
+      (#try.Success (case previous
+                      "" current
+                      _ (format previous current))))))
+
+(syntax: #export (escaped {literal .text})
+  (case (..un_escape literal)
+    (#try.Success un_escaped)
+    (wrap (list (code.text un_escaped)))
+    
+    (#try.Failure error)
+    (meta.fail error)))
diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux
new file mode 100644
index 000000000..a80503d36
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/format.lux
@@ -0,0 +1,135 @@
+(.module:
+  [library
+   [lux (#- list nat int rev type)
+    [abstract
+     [monad (#+ do)]
+     [functor
+      ["." contravariant]]]
+    [control
+     ["<>" parser
+      ["" code (#+ Parser)]]]
+    [data
+     ["." bit]
+     ["." name]
+     ["." text]
+     [format
+      ["." xml]
+      ["." json]]
+     [collection
+      ["." list ("#\." monad)]]]
+    ["." time
+     ["." instant]
+     ["." duration]
+     ["." date]
+     ["." day]
+     ["." month]]
+    [math
+     ["." modular]
+     [number
+      ["." nat]
+      ["." int]
+      ["." rev]
+      ["." frac]
+      ["." ratio]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]
+    [meta
+     ["." location]]
+    ["." type]]])
+
+(type: #export (Format a)
+  {#.doc "A way to produce readable text from values."}
+  (-> a Text))
+
+(implementation: #export functor
+  (contravariant.Functor Format)
+  
+  (def: (map f fb)
+    (|>> f fb)))
+
+(syntax: #export (format {fragments (<>.many .any)})
+  {#.doc (doc "Text interpolation."
+              (format "Static part " (text static) " does not match URI: " uri))}
+  (wrap (.list (` ($_ "lux text concat" (~+ fragments))))))
+
+(template [  ]
+  [(def: #export 
+     (Format )
+     )]
+
+  [bit      Bit               (\ bit.codec encode)]
+  [nat      Nat               (\ nat.decimal encode)]
+  [int      Int               (\ int.decimal encode)]
+  [rev      Rev               (\ rev.decimal encode)]
+  [frac     Frac              (\ frac.decimal encode)]
+  [text     Text              text.format]
+  
+  [ratio    ratio.Ratio       (\ ratio.codec encode)]
+  [name     Name              (\ name.codec encode)]
+  [location Location          location.format]
+  [code     Code              code.format]
+  [type     Type              type.format]
+  
+  [instant  instant.Instant   (\ instant.codec encode)]
+  [duration duration.Duration (\ duration.codec encode)]
+  [date     date.Date         (\ date.codec encode)]
+  [time     time.Time         (\ time.codec encode)]
+  [day      day.Day           (\ day.codec encode)]
+  [month    month.Month       (\ month.codec encode)]
+  
+  [xml      xml.XML           (\ xml.codec encode)]
+  [json     json.JSON         (\ json.codec encode)]
+  )
+
+(template [ ,]
+  [(`` (template [ ]
+         [(def: #export 
+            (Format )
+            (\  encode))]
+
+         (~~ (template.splice ,))))]
+
+  [Nat
+   [[nat/2 nat.binary]
+    [nat/8 nat.octal]
+    [nat/10 nat.decimal]
+    [nat/16 nat.hex]]]
+  [Int
+   [[int/2 int.binary]
+    [int/8 int.octal]
+    [int/10 int.decimal]
+    [int/16 int.hex]]]
+  [Rev
+   [[rev/2 rev.binary]
+    [rev/8 rev.octal]
+    [rev/10 rev.decimal]
+    [rev/16 rev.hex]]]
+  [Frac
+   [[frac/2 frac.binary]
+    [frac/8 frac.octal]
+    [frac/10 frac.decimal]
+    [frac/16 frac.hex]]]
+  )
+
+(def: #export (mod modular)
+  (All [m] (Format (modular.Mod m)))
+  (let [codec (modular.codec (modular.modulus modular))]
+    (\ codec encode modular)))
+
+(def: #export (list formatter)
+  (All [a] (-> (Format a) (Format (List a))))
+  (|>> (list\map (|>> formatter (format " ")))
+       (text.join_with "")
+       (text.enclose ["(list" ")"])))
+
+(def: #export (maybe format)
+  (All [a] (-> (Format a) (Format (Maybe a))))
+  (function (_ value)
+    (case value
+      #.None
+      "#.None"
+
+      (#.Some value)
+      (..format "(#.Some " (format value) ")"))))
diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux
new file mode 100644
index 000000000..38f4155ab
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/regex.lux
@@ -0,0 +1,495 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     monad]
+    [control
+     ["." try]
+     ["<>" parser ("#\." monad)
+      ["" text (#+ Parser)]
+      ["" code]]]
+    [data
+     ["." product]
+     ["." maybe]
+     [collection
+      ["." list ("#\." fold monad)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number (#+ hex)
+      ["n" nat ("#\." decimal)]]]]]
+  ["." //
+   ["%" format (#+ format)]])
+
+(def: regex_char^
+  (Parser Text)
+  (.none_of "\.|&()[]{}"))
+
+(def: escaped_char^
+  (Parser Text)
+  (do <>.monad
+    [? (<>.parses? (.this "\"))]
+    (if ?
+      .any
+      regex_char^)))
+
+(def: (refine^ refinement^ base^)
+  (All [a] (-> (Parser a) (Parser Text) (Parser Text)))
+  (do <>.monad
+    [output base^
+     _ (.local output refinement^)]
+    (wrap output)))
+
+(def: word^
+  (Parser Text)
+  (<>.either .alpha_num
+             (.one_of "_")))
+
+(def: (copy reference)
+  (-> Text (Parser Text))
+  (<>.after (.this reference) (<>\wrap reference)))
+
+(def: (join_text^ part^)
+  (-> (Parser (List Text)) (Parser Text))
+  (do <>.monad
+    [parts part^]
+    (wrap (//.join_with "" parts))))
+
+(def: name_char^
+  (Parser Text)
+  (.none_of (format "[]{}()s#.<>" //.double_quote)))
+
+(def: name_part^
+  (Parser Text)
+  (do <>.monad
+    [head (refine^ (.not .decimal)
+                   name_char^)
+     tail (.some name_char^)]
+    (wrap (format head tail))))
+
+(def: (name^ current_module)
+  (-> Text (Parser Name))
+  ($_ <>.either
+      (<>.and (<>\wrap current_module) (<>.after (.this "..") name_part^))
+      (<>.and name_part^ (<>.after (.this ".") name_part^))
+      (<>.and (<>\wrap .prelude_module) (<>.after (.this ".") name_part^))
+      (<>.and (<>\wrap "") name_part^)))
+
+(def: (re_var^ current_module)
+  (-> Text (Parser Code))
+  (do <>.monad
+    [name (.enclosed ["\@<" ">"] (name^ current_module))]
+    (wrap (` (: (Parser Text) (~ (code.identifier name)))))))
+
+(def: re_range^
+  (Parser Code)
+  (do {! <>.monad}
+    [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))
+     _ (.this "-")
+     to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))]
+    (wrap (` (.range (~ (code.nat from)) (~ (code.nat to)))))))
+
+(def: re_char^
+  (Parser Code)
+  (do <>.monad
+    [char escaped_char^]
+    (wrap (` ((~! ..copy) (~ (code.text char)))))))
+
+(def: re_options^
+  (Parser Code)
+  (do <>.monad
+    [options (.many escaped_char^)]
+    (wrap (` (.one_of (~ (code.text options)))))))
+
+(def: re_user_class^'
+  (Parser Code)
+  (do <>.monad
+    [negate? (<>.maybe (.this "^"))
+     parts (<>.many ($_ <>.either
+                        re_range^
+                        re_options^))]
+    (wrap (case negate?
+            (#.Some _) (` (.not ($_ <>.either (~+ parts))))
+            #.None     (` ($_ <>.either (~+ parts)))))))
+
+(def: re_user_class^
+  (Parser Code)
+  (do <>.monad
+    [_ (wrap [])
+     init re_user_class^'
+     rest (<>.some (<>.after (.this "&&") (.enclosed ["[" "]"] re_user_class^')))]
+    (wrap (list\fold (function (_ refinement base)
+                       (` ((~! refine^) (~ refinement) (~ base))))
+                     init
+                     rest))))
+
+(def: blank^
+  (Parser Text)
+  (.one_of (format " " //.tab)))
+
+(def: ascii^
+  (Parser Text)
+  (.range (hex "0") (hex "7F")))
+
+(def: control^
+  (Parser Text)
+  (<>.either (.range (hex "0") (hex "1F"))
+             (.one_of (//.from_code (hex "7F")))))
+
+(def: punct^
+  (Parser Text)
+  (.one_of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~"
+                      //.double_quote)))
+
+(def: graph^
+  (Parser Text)
+  (<>.either punct^ .alpha_num))
+
+(def: print^
+  (Parser Text)
+  (<>.either graph^
+             (.one_of (//.from_code (hex "20")))))
+
+(def: re_system_class^
+  (Parser Code)
+  (do <>.monad
+    []
+    ($_ <>.either
+        (<>.after (.this ".") (wrap (` .any)))
+        (<>.after (.this "\d") (wrap (` .decimal)))
+        (<>.after (.this "\D") (wrap (` (.not .decimal))))
+        (<>.after (.this "\s") (wrap (` .space)))
+        (<>.after (.this "\S") (wrap (` (.not .space))))
+        (<>.after (.this "\w") (wrap (` (~! word^))))
+        (<>.after (.this "\W") (wrap (` (.not (~! word^)))))
+
+        (<>.after (.this "\p{Lower}") (wrap (` .lower)))
+        (<>.after (.this "\p{Upper}") (wrap (` .upper)))
+        (<>.after (.this "\p{Alpha}") (wrap (` .alpha)))
+        (<>.after (.this "\p{Digit}") (wrap (` .decimal)))
+        (<>.after (.this "\p{Alnum}") (wrap (` .alpha_num)))
+        (<>.after (.this "\p{Space}") (wrap (` .space)))
+        (<>.after (.this "\p{HexDigit}") (wrap (` .hexadecimal)))
+        (<>.after (.this "\p{OctDigit}") (wrap (` .octal)))
+        (<>.after (.this "\p{Blank}") (wrap (` (~! blank^))))
+        (<>.after (.this "\p{ASCII}") (wrap (` (~! ascii^))))
+        (<>.after (.this "\p{Contrl}") (wrap (` (~! control^))))
+        (<>.after (.this "\p{Punct}") (wrap (` (~! punct^))))
+        (<>.after (.this "\p{Graph}") (wrap (` (~! graph^))))
+        (<>.after (.this "\p{Print}") (wrap (` (~! print^))))
+        )))
+
+(def: re_class^
+  (Parser Code)
+  (<>.either re_system_class^
+             (.enclosed ["[" "]"] re_user_class^)))
+
+(def: number^
+  (Parser Nat)
+  (|> (.many .decimal)
+      (<>.codec n.decimal)))
+
+(def: re_back_reference^
+  (Parser Code)
+  (<>.either (do <>.monad
+               [_ (.this "\")
+                id number^]
+               (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)]))))))
+             (do <>.monad
+               [_ (.this "\k<")
+                captured_name name_part^
+                _ (.this ">")]
+               (wrap (` ((~! ..copy) (~ (code.identifier ["" captured_name]))))))))
+
+(def: (re_simple^ current_module)
+  (-> Text (Parser Code))
+  ($_ <>.either
+      re_class^
+      (re_var^ current_module)
+      re_back_reference^
+      re_char^
+      ))
+
+(def: (re_simple_quantified^ current_module)
+  (-> Text (Parser Code))
+  (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 (Parser Code))
+  (do {! <>.monad}
+    [base (re_simple^ current_module)]
+    (.enclosed ["{" "}"]
+                  ($_ <>.either
+                      (do !
+                        [[from to] (<>.and number^ (<>.after (.this ",") number^))]
+                        (wrap (` ((~! join_text^) (<>.between (~ (code.nat from))
+                                                              (~ (code.nat to))
+                                                              (~ base))))))
+                      (do !
+                        [limit (<>.after (.this ",") number^)]
+                        (wrap (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base))))))
+                      (do !
+                        [limit (<>.before (.this ",") number^)]
+                        (wrap (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base))))))
+                      (do !
+                        [limit number^]
+                        (wrap (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base))))))))))
+
+(def: (re_quantified^ current_module)
+  (-> Text (Parser Code))
+  (<>.either (re_simple_quantified^ current_module)
+             (re_counted_quantified^ current_module)))
+
+(def: (re_complex^ current_module)
+  (-> Text (Parser Code))
+  ($_ <>.either
+      (re_quantified^ current_module)
+      (re_simple^ current_module)))
+
+(type: Re_Group
+  #Non_Capturing
+  (#Capturing [(Maybe Text) Nat]))
+
+(def: (re_sequential^ capturing? re_scoped^ current_module)
+  (-> Bit
+      (-> Text (Parser [Re_Group Code]))
+      Text
+      (Parser [Nat Code]))
+  (do <>.monad
+    [parts (<>.many (<>.or (re_complex^ current_module)
+                           (re_scoped^ current_module)))
+     #let [g!total (code.identifier ["" "0total"])
+           g!temp (code.identifier ["" "0temp"])
+           [_ names steps] (list\fold (: (-> (Either Code [Re_Group Code])
+                                             [Nat (List Code) (List (List Code))]
+                                             [Nat (List Code) (List (List Code))])
+                                         (function (_ part [idx names steps])
+                                           (case part
+                                             (^or (#.Left complex) (#.Right [#Non_Capturing complex]))
+                                             [idx
+                                              names
+                                              (list& (list g!temp complex
+                                                           (' #let) (` [(~ g!total) (\ (~! //.monoid) (~' compose) (~ g!total) (~ g!temp))]))
+                                                     steps)]
+                                             
+                                             (#.Right [(#Capturing [?name num_captures]) scoped])
+                                             (let [[idx! name!] (case ?name
+                                                                  (#.Some _name)
+                                                                  [idx (code.identifier ["" _name])]
+
+                                                                  #.None
+                                                                  [(inc idx) (code.identifier ["" (n\encode idx)])])
+                                                   access (if (n.> 0 num_captures)
+                                                            (` ((~! product.left) (~ name!)))
+                                                            name!)]
+                                               [idx!
+                                                (list& name! names)
+                                                (list& (list name! scoped
+                                                             (' #let) (` [(~ g!total) (\ (~! //.monoid) (~' compose) (~ g!total) (~ access))]))
+                                                       steps)])
+                                             )))
+                                      [0
+                                       (: (List Code) (list))
+                                       (: (List (List Code)) (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: (unflatten^ lexer)
+  (-> (Parser Text) (Parser [Text Any]))
+  (<>.and lexer (\ <>.monad wrap [])))
+
+(def: (|||^ left right)
+  (All [l r] (-> (Parser [Text l]) (Parser [Text r]) (Parser [Text (| l r)])))
+  (function (_ input)
+    (case (left input)
+      (#try.Success [input' [lt lv]])
+      (#try.Success [input' [lt (0 #0 lv)]])
+
+      (#try.Failure _)
+      (case (right input)
+        (#try.Success [input' [rt rv]])
+        (#try.Success [input' [rt (0 #1 rv)]])
+
+        (#try.Failure error)
+        (#try.Failure error)))))
+
+(def: (|||_^ left right)
+  (All [l r] (-> (Parser [Text l]) (Parser [Text r]) (Parser Text)))
+  (function (_ input)
+    (case (left input)
+      (#try.Success [input' [lt lv]])
+      (#try.Success [input' lt])
+
+      (#try.Failure _)
+      (case (right input)
+        (#try.Success [input' [rt rv]])
+        (#try.Success [input' rt])
+
+        (#try.Failure error)
+        (#try.Failure error)))))
+
+(def: (prep_alternative [num_captures alt])
+  (-> [Nat Code] Code)
+  (if (n.> 0 num_captures)
+    alt
+    (` ((~! unflatten^) (~ alt)))))
+
+(def: (re_alternative^ capturing? re_scoped^ current_module)
+  (-> Bit
+      (-> Text (Parser [Re_Group Code]))
+      Text
+      (Parser [Nat Code]))
+  (do <>.monad
+    [#let [sub^ (re_sequential^ capturing? re_scoped^ current_module)]
+     head sub^
+     tail (<>.some (<>.after (.this "|") sub^))]
+    (if (list.empty? tail)
+      (wrap head)
+      (wrap [(list\fold n.max (product.left head) (list\map product.left tail))
+             (` ($_ ((~ (if capturing?
+                          (` (~! |||^))
+                          (` (~! |||_^)))))
+                    (~ (prep_alternative head))
+                    (~+ (list\map prep_alternative tail))))]))))
+
+(def: (re_scoped^ current_module)
+  (-> Text (Parser [Re_Group Code]))
+  ($_ <>.either
+      (do <>.monad
+        [_ (.this "(?:")
+         [_ scoped] (re_alternative^ #0 re_scoped^ current_module)
+         _ (.this ")")]
+        (wrap [#Non_Capturing scoped]))
+      (do <>.monad
+        [complex (re_complex^ current_module)]
+        (wrap [#Non_Capturing complex]))
+      (do <>.monad
+        [_ (.this "(?<")
+         captured_name name_part^
+         _ (.this ">")
+         [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module)
+         _ (.this ")")]
+        (wrap [(#Capturing [(#.Some captured_name) num_captures]) pattern]))
+      (do <>.monad
+        [_ (.this "(")
+         [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module)
+         _ (.this ")")]
+        (wrap [(#Capturing [#.None num_captures]) pattern]))))
+
+(def: (regex^ current_module)
+  (-> Text (Parser Code))
+  (\ <>.monad map product.right (re_alternative^ #1 re_scoped^ current_module)))
+
+(syntax: #export (regex {pattern .text})
+  {#.doc (doc "Create lexers using regular-expression syntax."
+              "For example:"
+              
+              "Literals"
+              (regex "a")
+              
+              "Wildcards"
+              (regex ".")
+              
+              "Escaping"
+              (regex "\.")
+              
+              "Character classes"
+              (regex "\d")
+              (regex "\p{Lower}")
+              (regex "[abc]")
+              (regex "[a-z]")
+              (regex "[a-zA-Z]")
+              (regex "[a-z&&[def]]")
+              
+              "Negation"
+              (regex "[^abc]")
+              (regex "[^a-z]")
+              (regex "[^a-zA-Z]")
+              (regex "[a-z&&[^bc]]")
+              (regex "[a-z&&[^m-p]]")
+              
+              "Combinations"
+              (regex "aa")
+              (regex "a?")
+              (regex "a*")
+              (regex "a+")
+              
+              "Specific amounts"
+              (regex "a{2}")
+              
+              "At least"
+              (regex "a{1,}")
+              
+              "At most"
+              (regex "a{,1}")
+              
+              "Between"
+              (regex "a{1,2}")
+              
+              "Groups"
+              (regex "a(.)c")
+              (regex "a(b+)c")
+              (regex "(\d{3})-(\d{3})-(\d{4})")
+              (regex "(\d{3})-(?:\d{3})-(\d{4})")
+              (regex "(?\d{3})-\k-(\d{4})")
+              (regex "(?\d{3})-\k-(\d{4})-\0")
+              (regex "(\d{3})-((\d{3})-(\d{4}))")
+              
+              "Alternation"
+              (regex "a|b")
+              (regex "a(.)(.)|b(.)(.)")
+              )}
+  (do meta.monad
+    [current_module meta.current_module_name]
+    (case (.run (regex^ current_module)
+                   pattern)
+      (#try.Failure error)
+      (meta.fail (format "Error while parsing regular-expression:" //.new_line
+                         error))
+
+      (#try.Success regex)
+      (wrap (list regex))
+      )))
+
+(syntax: #export (^regex {[pattern bindings] (.form (<>.and .text (<>.maybe .any)))}
+                         body
+                         {branches (<>.many .any)})
+  {#.doc (doc "Allows you to test text against regular expressions."
+              (case some_text
+                (^regex "(\d{3})-(\d{3})-(\d{4})"
+                        [_ country_code area_code place_code])
+                do_some_thing_when_number
+
+                (^regex "\w+")
+                do_some_thing_when_word
+
+                _
+                do_something_else))}
+  (with_gensyms [g!temp]
+    (wrap (list& (` (^multi (~ g!temp)
+                            [((~! .run) (..regex (~ (code.text pattern))) (~ g!temp))
+                             (#try.Success (~ (maybe.default g!temp bindings)))]))
+                 body
+                 branches))))
diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux
new file mode 100644
index 000000000..24ddb34e2
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/unicode/block.lux
@@ -0,0 +1,205 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]
+     [monoid (#+ Monoid)]
+     ["." interval (#+ Interval)]]
+    [math
+     [number (#+ hex)
+      ["n" nat ("#\." interval)]
+      ["." i64]]]
+    [type
+     abstract]]]
+  [/// (#+ Char)])
+
+(abstract: #export Block
+  (Interval Char)
+
+  (implementation: #export monoid
+    (Monoid Block)
+    
+    (def: identity
+      (:abstraction (interval.between n.enum n\top n\bottom)))
+    (def: (compose left right)
+      (let [left (:representation left)
+            right (:representation right)]
+        (:abstraction
+         (interval.between n.enum
+                           (n.min (\ left bottom)
+                                  (\ right bottom))
+                           (n.max (\ left top)
+                                  (\ right top)))))))
+
+  (def: #export (block start end)
+    (-> Char Char Block)
+    (:abstraction (interval.between n.enum (n.min start end) (n.max start end))))
+
+  (template [ ]
+    [(def: #export 
+       (-> Block Char)
+       (|>> :representation (get@ )))]
+
+    [start #interval.bottom]
+    [end   #interval.top]
+    )
+
+  (def: #export (size block)
+    (-> Block Nat)
+    (let [start (get@ #interval.bottom (:representation block))
+          end (get@ #interval.top (:representation block))]
+      (|> end (n.- start) inc)))
+
+  (def: #export (within? block char)
+    (All [a] (-> Block Char Bit))
+    (interval.within? (:representation block) char))
+  )
+
+(implementation: #export equivalence
+  (Equivalence Block)
+
+  (def: (= reference subject)
+    (and (n.= (..start reference) (..start subject))
+         (n.= (..end reference) (..end subject)))))
+
+(implementation: #export hash
+  (Hash Block)
+
+  (def: &equivalence ..equivalence)
+  (def: (hash value)
+    (i64.or (i64.left_shift 32 (..start value))
+            (..end value))))
+
+(template [  ]
+  [(def: #export  Block (..block (hex ) (hex )))]
+
+  ## Normal blocks
+  [basic_latin                             "0000"  "007F"]
+  [latin_1_supplement                      "00A0"  "00FF"]
+  [latin_extended_a                        "0100"  "017F"]
+  [latin_extended_b                        "0180"  "024F"]
+  [ipa_extensions                          "0250"  "02AF"]
+  [spacing_modifier_letters                "02B0"  "02FF"]
+  [combining_diacritical_marks             "0300"  "036F"]
+  [greek_and_coptic                        "0370"  "03FF"]
+  [cyrillic                                "0400"  "04FF"]
+  [cyrillic_supplementary                  "0500"  "052F"]
+  [armenian                                "0530"  "058F"]
+  [hebrew                                  "0590"  "05FF"]
+  [arabic                                  "0600"  "06FF"]
+  [syriac                                  "0700"  "074F"]
+  [thaana                                  "0780"  "07BF"]
+  [devanagari                              "0900"  "097F"]
+  [bengali                                 "0980"  "09FF"]
+  [gurmukhi                                "0A00"  "0A7F"]
+  [gujarati                                "0A80"  "0AFF"]
+  [oriya                                   "0B00"  "0B7F"]
+  [tamil                                   "0B80"  "0BFF"]
+  [telugu                                  "0C00"  "0C7F"]
+  [kannada                                 "0C80"  "0CFF"]
+  [malayalam                               "0D00"  "0D7F"]
+  [sinhala                                 "0D80"  "0DFF"]
+  [thai                                    "0E00"  "0E7F"]
+  [lao                                     "0E80"  "0EFF"]
+  [tibetan                                 "0F00"  "0FFF"]
+  [myanmar                                 "1000"  "109F"]
+  [georgian                                "10A0"  "10FF"]
+  [hangul_jamo                             "1100"  "11FF"]
+  [ethiopic                                "1200"  "137F"]
+  [cherokee                                "13A0"  "13FF"]
+  [unified_canadian_aboriginal_syllabics   "1400"  "167F"]
+  [ogham                                   "1680"  "169F"]
+  [runic                                   "16A0"  "16FF"]
+  [tagalog                                 "1700"  "171F"]
+  [hanunoo                                 "1720"  "173F"]
+  [buhid                                   "1740"  "175F"]
+  [tagbanwa                                "1760"  "177F"]
+  [khmer                                   "1780"  "17FF"]
+  [mongolian                               "1800"  "18AF"]
+  [limbu                                   "1900"  "194F"]
+  [tai_le                                  "1950"  "197F"]
+  [khmer_symbols                           "19E0"  "19FF"]
+  [phonetic_extensions                     "1D00"  "1D7F"]
+  [latin_extended_additional               "1E00"  "1EFF"]
+  [greek_extended                          "1F00"  "1FFF"]
+  [general_punctuation                     "2000"  "206F"]
+  [superscripts_and_subscripts             "2070"  "209F"]
+  [currency_symbols                        "20A0"  "20CF"]
+  [combining_diacritical_marks_for_symbols "20D0"  "20FF"]
+  [letterlike_symbols                      "2100"  "214F"]
+  [number_forms                            "2150"  "218F"]
+  [arrows                                  "2190"  "21FF"]
+  [mathematical_operators                  "2200"  "22FF"]
+  [miscellaneous_technical                 "2300"  "23FF"]
+  [control_pictures                        "2400"  "243F"]
+  [optical_character_recognition           "2440"  "245F"]
+  [enclosed_alphanumerics                  "2460"  "24FF"]
+  [box_drawing                             "2500"  "257F"]
+  [block_elements                          "2580"  "259F"]
+  [geometric_shapes                        "25A0"  "25FF"]
+  [miscellaneous_symbols                   "2600"  "26FF"]
+  [dingbats                                "2700"  "27BF"]
+  [miscellaneous_mathematical_symbols_a    "27C0"  "27EF"]
+  [supplemental_arrows_a                   "27F0"  "27FF"]
+  [braille_patterns                        "2800"  "28FF"]
+  [supplemental_arrows_b                   "2900"  "297F"]
+  [miscellaneous_mathematical_symbols_b    "2980"  "29FF"]
+  [supplemental_mathematical_operators     "2A00"  "2AFF"]
+  [miscellaneous_symbols_and_arrows        "2B00"  "2BFF"]
+  [cjk_radicals_supplement                 "2E80"  "2EFF"]
+  [kangxi_radicals                         "2F00"  "2FDF"]
+  [ideographic_description_characters      "2FF0"  "2FFF"]
+  [cjk_symbols_and_punctuation             "3000"  "303F"]
+  [hiragana                                "3040"  "309F"]
+  [katakana                                "30A0"  "30FF"]
+  [bopomofo                                "3100"  "312F"]
+  [hangul_compatibility_jamo               "3130"  "318F"]
+  [kanbun                                  "3190"  "319F"]
+  [bopomofo_extended                       "31A0"  "31BF"]
+  [katakana_phonetic_extensions            "31F0"  "31FF"]
+  [enclosed_cjk_letters_and_months         "3200"  "32FF"]
+  [cjk_compatibility                       "3300"  "33FF"]
+  [cjk_unified_ideographs_extension_a      "3400"  "4DBF"]
+  [yijing_hexagram_symbols                 "4DC0"  "4DFF"]
+  [cjk_unified_ideographs                  "4E00"  "9FFF"]
+  [yi_syllables                            "A000"  "A48F"]
+  [yi_radicals                             "A490"  "A4CF"]
+  [hangul_syllables                        "AC00"  "D7AF"]
+  [high_surrogates                         "D800"  "DB7F"]
+  [high_private_use_surrogates             "DB80"  "DBFF"]
+  [low_surrogates                          "DC00"  "DFFF"]
+  [private_use_area                        "E000"  "F8FF"]
+  [cjk_compatibility_ideographs            "F900"  "FAFF"]
+  [alphabetic_presentation_forms           "FB00"  "FB4F"]
+  [arabic_presentation_forms_a             "FB50"  "FDFF"]
+  [variation_selectors                     "FE00"  "FE0F"]
+  [combining_half_marks                    "FE20"  "FE2F"]
+  [cjk_compatibility_forms                 "FE30"  "FE4F"]
+  [small_form_variants                     "FE50"  "FE6F"]
+  [arabic_presentation_forms_b             "FE70"  "FEFF"]
+  [halfwidth_and_fullwidth_forms           "FF00"  "FFEF"]
+  [specials                                "FFF0"  "FFFF"]
+  ## [linear_b_syllabary                      "10000" "1007F"]
+  ## [linear_b_ideograms                      "10080" "100FF"]
+  ## [aegean_numbers                          "10100" "1013F"]
+  ## [old_italic                              "10300" "1032F"]
+  ## [gothic                                  "10330" "1034F"]
+  ## [ugaritic                                "10380" "1039F"]
+  ## [deseret                                 "10400" "1044F"]
+  ## [shavian                                 "10450" "1047F"]
+  ## [osmanya                                 "10480" "104AF"]
+  ## [cypriot_syllabary                       "10800" "1083F"]
+  ## [byzantine_musical_symbols               "1D000" "1D0FF"]
+  ## [musical_symbols                         "1D100" "1D1FF"]
+  ## [tai_xuan_jing_symbols                   "1D300" "1D35F"]
+  ## [mathematical_alphanumeric_symbols       "1D400" "1D7FF"]
+  ## [cjk_unified_ideographs_extension_b      "20000" "2A6DF"]
+  ## [cjk_compatibility_ideographs_supplement "2F800" "2FA1F"]
+  ## [tags                                    "E0000" "E007F"]
+
+  ## Specialized blocks
+  [basic_latin/decimal                     "0030"  "0039"]
+  [basic_latin/upper                       "0041"  "005A"]
+  [basic_latin/lower                       "0061"  "007A"]
+  )
diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux
new file mode 100644
index 000000000..2c48aed41
--- /dev/null
+++ b/stdlib/source/library/lux/data/text/unicode/set.lux
@@ -0,0 +1,240 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     [collection
+      ["." list ("#\." fold functor)]
+      ["." set ("#\." equivalence)]
+      ["." tree #_
+       ["#" finger (#+ Tree)]]]]
+    [type (#+ :by_example)
+     abstract]]]
+  ["." / #_
+   ["/#" // #_
+    [// (#+ Char)]
+    ["#." block (#+ Block)]]])
+
+(def: builder
+  (tree.builder //block.monoid))
+
+(def: :@:
+  (:by_example [@]
+               (tree.Builder @ Block)
+               ..builder
+               
+               @))
+
+(abstract: #export Set
+  (Tree :@: Block [])
+
+  (def: #export (compose left right)
+    (-> Set Set Set)
+    (:abstraction
+     (\ builder branch
+        (:representation left)
+        (:representation right))))
+
+  (def: (singleton block)
+    (-> Block Set)
+    (:abstraction
+     (\ builder leaf block [])))
+
+  (def: #export (set [head tail])
+    (-> [Block (List Block)] Set)
+    (list\fold (: (-> Block Set Set)
+                  (function (_ block set)
+                    (..compose (..singleton block) set)))
+               (..singleton head)
+               tail))
+
+  (def: character/0
+    Set
+    (..set [//block.basic_latin
+            (list //block.latin_1_supplement
+                  //block.latin_extended_a
+                  //block.latin_extended_b
+                  //block.ipa_extensions
+                  //block.spacing_modifier_letters
+                  //block.combining_diacritical_marks
+                  //block.greek_and_coptic
+                  //block.cyrillic
+                  //block.cyrillic_supplementary
+                  //block.armenian
+                  //block.hebrew
+                  //block.arabic
+                  //block.syriac
+                  //block.thaana
+                  //block.devanagari
+                  //block.bengali
+                  //block.gurmukhi
+                  //block.gujarati
+                  //block.oriya
+                  //block.tamil
+                  //block.telugu
+                  //block.kannada
+                  //block.malayalam
+                  //block.sinhala
+                  //block.thai
+                  //block.lao
+                  //block.tibetan
+                  //block.myanmar
+                  //block.georgian)]))
+
+  (def: character/1
+    Set
+    (..set [//block.hangul_jamo
+            (list //block.ethiopic
+                  //block.cherokee
+                  //block.unified_canadian_aboriginal_syllabics
+                  //block.ogham
+                  //block.runic
+                  //block.tagalog
+                  //block.hanunoo
+                  //block.buhid
+                  //block.tagbanwa
+                  //block.khmer
+                  //block.mongolian
+                  //block.limbu
+                  //block.tai_le
+                  //block.khmer_symbols
+                  //block.phonetic_extensions
+                  //block.latin_extended_additional
+                  //block.greek_extended
+                  //block.general_punctuation
+                  //block.superscripts_and_subscripts
+                  //block.currency_symbols
+                  //block.combining_diacritical_marks_for_symbols
+                  //block.letterlike_symbols
+                  //block.number_forms
+                  //block.arrows
+                  //block.mathematical_operators
+                  //block.miscellaneous_technical
+                  //block.control_pictures
+                  //block.optical_character_recognition
+                  //block.enclosed_alphanumerics
+                  //block.box_drawing)]))
+
+  (def: character/2
+    Set
+    (..set [//block.block_elements
+            (list //block.geometric_shapes
+                  //block.miscellaneous_symbols
+                  //block.dingbats
+                  //block.miscellaneous_mathematical_symbols_a
+                  //block.supplemental_arrows_a
+                  //block.braille_patterns
+                  //block.supplemental_arrows_b
+                  //block.miscellaneous_mathematical_symbols_b
+                  //block.supplemental_mathematical_operators
+                  //block.miscellaneous_symbols_and_arrows
+                  //block.cjk_radicals_supplement
+                  //block.kangxi_radicals
+                  //block.ideographic_description_characters
+                  //block.cjk_symbols_and_punctuation
+                  //block.hiragana
+                  //block.katakana
+                  //block.bopomofo
+                  //block.hangul_compatibility_jamo
+                  //block.kanbun
+                  //block.bopomofo_extended
+                  //block.katakana_phonetic_extensions
+                  //block.enclosed_cjk_letters_and_months
+                  //block.cjk_compatibility
+                  //block.cjk_unified_ideographs_extension_a
+                  //block.yijing_hexagram_symbols
+                  //block.cjk_unified_ideographs
+                  //block.yi_syllables
+                  //block.yi_radicals
+                  //block.hangul_syllables
+                  )]))
+
+  (def: #export character
+    Set
+    ($_ ..compose
+        ..character/0
+        ..character/1
+        ..character/2
+        ))
+
+  (def: #export non_character
+    Set
+    (..set [//block.high_surrogates
+            (list  //block.high_private_use_surrogates
+                   //block.low_surrogates
+                   //block.private_use_area
+                   //block.cjk_compatibility_ideographs
+                   //block.alphabetic_presentation_forms
+                   //block.arabic_presentation_forms_a
+                   //block.variation_selectors
+                   //block.combining_half_marks
+                   //block.cjk_compatibility_forms
+                   //block.small_form_variants
+                   //block.arabic_presentation_forms_b
+                   //block.halfwidth_and_fullwidth_forms
+                   //block.specials
+                   ## //block.linear_b_syllabary
+                   ## //block.linear_b_ideograms
+                   ## //block.aegean_numbers
+                   ## //block.old_italic
+                   ## //block.gothic
+                   ## //block.ugaritic
+                   ## //block.deseret
+                   ## //block.shavian
+                   ## //block.osmanya
+                   ## //block.cypriot_syllabary
+                   ## //block.byzantine_musical_symbols
+                   ## //block.musical_symbols
+                   ## //block.tai_xuan_jing_symbols
+                   ## //block.mathematical_alphanumeric_symbols
+                   ## //block.cjk_unified_ideographs_extension_b
+                   ## //block.cjk_compatibility_ideographs_supplement
+                   ## //block.tags
+                   )]))
+
+  (def: #export full
+    Set
+    ($_ ..compose
+        ..character
+        ..non_character
+        ))
+
+  (def: #export (range set)
+    (-> Set [Char Char])
+    (let [tag (tree.tag (:representation set))]
+      [(//block.start tag)
+       (//block.end tag)]))
+
+  (def: #export (member? set character)
+    (-> Set Char Bit)
+    (loop [tree (:representation set)]
+      (if (//block.within? (tree.tag tree) character)
+        (case (tree.root tree)
+          (0 #0 _)
+          true
+          
+          (0 #1 left right)
+          (or (recur left)
+              (recur right)))
+        false)))
+
+  (implementation: #export equivalence
+    (Equivalence Set)
+
+    (def: (= reference subject)
+      (set\= (set.from_list //block.hash (tree.tags (:representation reference)))
+             (set.from_list //block.hash (tree.tags (:representation subject))))))
+  )
+
+(template [ ]
+  [(def: #export 
+     (..set ))]
+
+  [ascii           [//block.basic_latin (list)]]
+  [ascii/alpha     [//block.basic_latin/upper (list //block.basic_latin/lower)]]
+  [ascii/alpha_num [//block.basic_latin/upper (list //block.basic_latin/lower //block.basic_latin/decimal)]]
+  [ascii/numeric   [//block.basic_latin/decimal (list)]]
+  [ascii/upper     [//block.basic_latin/upper (list)]]
+  [ascii/lower     [//block.basic_latin/lower (list)]]
+  )
diff --git a/stdlib/source/library/lux/data/trace.lux b/stdlib/source/library/lux/data/trace.lux
new file mode 100644
index 000000000..0edcff430
--- /dev/null
+++ b/stdlib/source/library/lux/data/trace.lux
@@ -0,0 +1,36 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." monoid (#+ Monoid)]
+     [functor (#+ Functor)]
+     comonad]
+    function]])
+
+(type: #export (Trace t a)
+  {#monoid (Monoid t)
+   #trace (-> t a)})
+
+(implementation: #export functor (All [t] (Functor (Trace t)))
+  (def: (map f fa)
+    (update@ #trace (compose f) fa)))
+
+(implementation: #export comonad (All [t] (CoMonad (Trace t)))
+  (def: &functor ..functor)
+
+  (def: (unwrap wa)
+    ((get@ #trace wa)
+     (get@ [#monoid #monoid.identity] wa)))
+
+  (def: (split wa)
+    (let [monoid (get@ #monoid wa)]
+      {#monoid monoid
+       #trace (function (_ t1)
+                {#monoid monoid
+                 #trace (function (_ t2)
+                          ((get@ #trace wa)
+                           (\ monoid compose t1 t2)))})})))
+
+(def: #export (run context tracer)
+  (All [t a] (-> t (Trace t a) a))
+  (\ tracer trace context))
diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux
new file mode 100644
index 000000000..b73b92035
--- /dev/null
+++ b/stdlib/source/library/lux/debug.lux
@@ -0,0 +1,598 @@
+(.module:
+  [library
+   [lux (#- type)
+    ["@" target]
+    ["." type]
+    ["." ffi (#+ import:)]
+    ["." meta]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     [pipe (#+ new>)]
+     ["." function]
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["<.>" type (#+ Parser)]
+      ["<.>" code]]]
+    [data
+     ["." text
+      ["%" format (#+ Format)]]
+     [format
+      [xml (#+ XML)]
+      ["." json]]
+     [collection
+      ["." array]
+      ["." list ("#\." functor)]
+      ["." dictionary]]]
+    [macro
+     ["." template]
+     ["." syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      [ratio (#+ Ratio)]
+      ["n" nat]
+      ["i" int]]]
+    [time (#+ Time)
+     [instant (#+ Instant)]
+     [duration (#+ Duration)]
+     [date (#+ Date)]
+     [month (#+ Month)]
+     [day (#+ Day)]]]])
+
+(with_expansions [ (as_is (import: java/lang/String)
+
+                               (import: (java/lang/Class a)
+                                 ["#::."
+                                  (getCanonicalName [] java/lang/String)])
+
+                               (import: java/lang/Object
+                                 ["#::."
+                                  (new [])
+                                  (toString [] java/lang/String)
+                                  (getClass [] (java/lang/Class java/lang/Object))])
+
+                               (import: java/lang/Integer
+                                 ["#::."
+                                  (longValue [] long)])
+
+                               (import: java/lang/Long
+                                 ["#::."
+                                  (intValue [] int)])
+
+                               (import: java/lang/Number
+                                 ["#::."
+                                  (intValue [] int)
+                                  (longValue [] long)
+                                  (doubleValue [] double)]))]
+  (for {@.old (as_is )
+        @.jvm (as_is )
+
+        @.js
+        (as_is (import: JSON
+                 ["#::."
+                  (#static stringify [.Any] ffi.String)])
+               (import: Array
+                 ["#::."
+                  (#static isArray [.Any] ffi.Boolean)]))
+
+        @.python
+        (as_is (type: PyType
+                 (primitive "python_type"))
+               
+               (import: (type [.Any] PyType))
+               (import: (str [.Any] ffi.String)))
+
+        @.lua
+        (as_is (import: (type [.Any] ffi.String))
+               (import: (tostring [.Any] ffi.String))
+
+               (import: math
+                 ["#::."
+                  (#static type [.Any] #? ffi.String)]))
+
+        @.ruby
+        (as_is (import: Class)
+
+               (import: Object
+                 ["#::."
+                  (class [] Class)
+                  (to_s [] ffi.String)]))
+
+        @.php
+        (as_is (import: (gettype [.Any] ffi.String))
+               (import: (strval [.Any] ffi.String)))
+
+        @.scheme
+        (as_is (import: (boolean? [.Any] Bit))
+               (import: (integer? [.Any] Bit))
+               (import: (real? [.Any] Bit))
+               (import: (string? [.Any] Bit))
+               (import: (vector? [.Any] Bit))
+               (import: (pair? [.Any] Bit))
+               (import: (car [.Any] .Any))
+               (import: (cdr [.Any] .Any))
+               (import: (format [Text .Any] Text)))
+        }))
+
+(def: Inspector
+  (.type (Format Any)))
+
+(for {@.lua (def: (tuple_array tuple)
+              (-> (array.Array Any) (array.Array Any))
+              (array.from_list
+               (loop [idx 0]
+                 (let [member ("lua array read" idx tuple)]
+                   (if ("lua object nil?" member)
+                     #.Nil
+                     (#.Cons member (recur (inc idx))))))))}
+     (as_is))
+
+(def: (inspect_tuple inspect)
+  (-> Inspector Inspector)
+  (with_expansions [ (for {@.lua (~~ (as_is ..tuple_array))}
+                                    (~~ (as_is)))]
+    (`` (|>> (:as (array.Array Any))
+             
+             array.to_list
+             (list\map inspect)
+             (text.join_with " ")
+             (text.enclose ["[" "]"])))))
+
+(def: #export (inspect value)
+  Inspector
+  (with_expansions [ (let [object (:as java/lang/Object value)]
+                            (`` (<| (~~ (template [ ]
+                                          [(case (ffi.check  object)
+                                             (#.Some value)
+                                             (`` (|> value (~~ (template.splice ))))
+                                             #.None)]
+
+                                          [java/lang/Boolean [(:as .Bit) %.bit]]
+                                          [java/lang/Long [(:as .Int) %.int]]
+                                          [java/lang/Number [java/lang/Number::doubleValue %.frac]]
+                                          [java/lang/String [(:as .Text) %.text]]
+                                          ))
+                                    (case (ffi.check [java/lang/Object] object)
+                                      (#.Some value)
+                                      (let [value (:as (array.Array java/lang/Object) value)]
+                                        (case (array.read 0 value)
+                                          (^multi (#.Some tag)
+                                                  [(ffi.check java/lang/Integer tag)
+                                                   (#.Some tag)]
+                                                  [[(array.read 1 value)
+                                                    (array.read 2 value)]
+                                                   [last?
+                                                    (#.Some choice)]])
+                                          (let [last? (case last?
+                                                        (#.Some _) #1
+                                                        #.None #0)]
+                                            (|> (%.format (%.nat (.nat (java/lang/Integer::longValue tag)))
+                                                          " " (%.bit last?)
+                                                          " " (inspect choice))
+                                                (text.enclose ["(" ")"])))
+
+                                          _
+                                          (inspect_tuple inspect value)))
+                                      #.None)
+                                    (java/lang/Object::toString object))))]
+    (for {@.old 
+          @.jvm 
+
+          @.js
+          (case (ffi.type_of value)
+            (^template [ ]
+              [
+               (`` (|> value (~~ (template.splice ))))])
+            (["boolean" [(:as .Bit) %.bit]]
+             ["number" [(:as .Frac) %.frac]]
+             ["string" [(:as .Text) %.text]]
+             ["undefined" [JSON::stringify]])
+            
+            "object"
+            (let [variant_tag ("js object get" "_lux_tag" value)
+                  variant_flag ("js object get" "_lux_flag" value)
+                  variant_value ("js object get" "_lux_value" value)]
+              (cond (not (or ("js object undefined?" variant_tag)
+                             ("js object undefined?" variant_flag)
+                             ("js object undefined?" variant_value)))
+                    (|> (%.format (JSON::stringify variant_tag)
+                                  " " (%.bit (not ("js object null?" variant_flag)))
+                                  " " (inspect variant_value))
+                        (text.enclose ["(" ")"]))
+
+                    (not (or ("js object undefined?" ("js object get" "_lux_low" value))
+                             ("js object undefined?" ("js object get" "_lux_high" value))))
+                    (|> value (:as .Int) %.int)
+
+                    (Array::isArray value)
+                    (inspect_tuple inspect value)
+                    
+                    ## else
+                    (JSON::stringify value)))
+
+            _
+            (JSON::stringify value))
+
+          @.python
+          (case (..str (..type value))
+            (^template [  ]
+              [(^or  )
+               (`` (|> value (~~ (template.splice ))))])
+            (["" "" [(:as .Bit) %.bit]]
+             ["" "" [(:as .Int) %.int]]
+             ["" "" [(:as .Frac) %.frac]]
+             ["" "" [(:as .Text) %.text]]
+             ["" "" [(:as .Text) %.text]])
+
+            (^or "" "")
+            (inspect_tuple inspect value)
+
+            (^or "" "")
+            (let [variant (:as (array.Array Any) value)]
+              (case (array.size variant)
+                3 (let [variant_tag ("python array read" 0 variant)
+                        variant_flag ("python array read" 1 variant)
+                        variant_value ("python array read" 2 variant)]
+                    (if (or ("python object none?" variant_tag)
+                            ("python object none?" variant_value))
+                      (..str value)
+                      (|> (%.format (|> variant_tag (:as .Nat) %.nat)
+                                    " " (|> variant_flag "python object none?" not %.bit)
+                                    " " (inspect variant_value))
+                          (text.enclose ["(" ")"]))))
+                _ (..str value)))
+
+            _
+            (..str value))
+
+          @.lua
+          (case (..type value)
+            (^template [ ]
+              [
+               (`` (|> value (~~ (template.splice ))))])
+            (["boolean" [(:as .Bit) %.bit]]
+             ["string" [(:as .Text) %.text]]
+             ["nil" [(new> "nil" [])]])
+
+            "number"
+            (case (math::type [value])
+              (#.Some "integer") (|> value (:as .Int) %.int)
+              (#.Some "float") (|> value (:as .Frac) %.frac)
+              
+              _
+              (..tostring value))
+            
+            "table"
+            (let [variant_tag ("lua object get" "_lux_tag" value)
+                  variant_flag ("lua object get" "_lux_flag" value)
+                  variant_value ("lua object get" "_lux_value" value)]
+              (if (or ("lua object nil?" variant_tag)
+                      ("lua object nil?" variant_value))
+                (inspect_tuple inspect value)
+                (|> (%.format (|> variant_tag (:as .Nat) %.nat)
+                              " " (%.bit (not ("lua object nil?" variant_flag)))
+                              " " (inspect variant_value))
+                    (text.enclose ["(" ")"]))))
+
+            _
+            (..tostring value))
+
+          @.ruby
+          (template.let [(class_of )
+                         [(|> 
+                              (:as ..Object)
+                              (Object::class []))]
+
+                         (to_s )
+                         [(|> 
+                              (:as ..Object)
+                              (Object::to_s []))]]
+            (let [value_class (class_of value)]
+              (`` (cond (~~ (template [  ]
+                              [(is? (class_of ) value_class)
+                               (|> value (:as ) )]
+
+                              [#0 Bit %.bit]
+                              [#1 Bit %.bit]
+                              [+1 Int %.int]
+                              [+1.0 Frac %.frac]
+                              ["" Text %.text]
+                              [("ruby object nil") Any (new> "nil" [])]
+                              ))
+
+                        (is? (class_of #.None) value_class)
+                        (let [variant_tag ("ruby object get" "_lux_tag" value)
+                              variant_flag ("ruby object get" "_lux_flag" value)
+                              variant_value ("ruby object get" "_lux_value" value)]
+                          (if (or ("ruby object nil?" variant_tag)
+                                  ("ruby object nil?" variant_value))
+                            (inspect_tuple inspect value)
+                            (|> (%.format (|> variant_tag (:as .Nat) %.nat)
+                                          " " (%.bit (not ("ruby object nil?" variant_flag)))
+                                          " " (inspect variant_value))
+                                (text.enclose ["(" ")"]))))
+
+                        (is? (class_of [[] []]) value_class)
+                        (inspect_tuple inspect value)
+
+                        ## else
+                        (to_s value)))))
+
+          @.php
+          (case (..gettype value)
+            (^template [ ]
+              [
+               (`` (|> value (~~ (template.splice ))))])
+            (["boolean" [(:as .Bit) %.bit]]
+             ["integer" [(:as .Int) %.int]]
+             ["double" [(:as .Frac) %.frac]]
+             ["string" [(:as .Text) %.text]]
+             ["NULL" [(new> "null" [])]]
+             ["array" [(inspect_tuple inspect)]])
+
+            "object"
+            (let [variant_tag ("php object get" "_lux_tag" value)
+                  variant_flag ("php object get" "_lux_flag" value)
+                  variant_value ("php object get" "_lux_value" value)]
+              (if (or ("php object null?" variant_tag)
+                      ("php object null?" variant_value))
+                (..strval value)
+                (|> (%.format (|> variant_tag (:as .Nat) %.nat)
+                              " " (%.bit (not ("php object null?" variant_flag)))
+                              " " (inspect variant_value))
+                    (text.enclose ["(" ")"]))))
+
+            _
+            (..strval value))
+
+          @.scheme
+          (`` (cond (~~ (template [ ]
+                          [( value)
+                           (`` (|> value (~~ (template.splice ))))]
+
+                          [..boolean? [(:as .Bit) %.bit]]
+                          [..integer? [(:as .Int) %.int]]
+                          [..real? [(:as .Frac) %.frac]]
+                          [..string? [(:as .Text) %.text]]
+                          ["scheme object nil?" [(new> "()" [])]]
+                          [..vector? [(inspect_tuple inspect)]]))
+
+                    (..pair? value)
+                    (let [variant_tag (..car value)
+                          variant_rest (..cdr value)]
+                      (if (and (..integer? variant_tag)
+                               (i.> +0 (:as Int variant_tag))
+                               (..pair? variant_rest))
+                        (let [variant_flag (..car variant_rest)
+                              variant_value (..cdr variant_rest)]
+                          (|> (%.format (|> variant_tag (:as .Nat) %.nat)
+                                        " " (%.bit (not ("scheme object nil?" variant_flag)))
+                                        " " (inspect variant_value))
+                              (text.enclose ["(" ")"])))
+                        (..format ["~s" value])))
+
+                    ## else
+                    (..format ["~s" value])
+                    ))
+          })))
+
+(exception: #export (cannot_represent_value {type Type})
+  (exception.report
+   ["Type" (%.type type)]))
+
+(type: Representation
+  (-> Any Text))
+
+(def: primitive_representation
+  (Parser Representation)
+  (`` ($_ <>.either
+          (do <>.monad
+            [_ (.exactly Any)]
+            (wrap (function.constant "[]")))
+          
+          (~~ (template [ ]
+                [(do <>.monad
+                   [_ (.sub )]
+                   (wrap (|>> (:as ) )))]
+
+                [Bit %.bit]
+                [Nat %.nat]
+                [Int %.int]
+                [Rev %.rev]
+                [Frac %.frac]
+                [Text %.text]))
+          )))
+
+(def: (special_representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (`` ($_ <>.either
+          (~~ (template [ ]
+                [(do <>.monad
+                   [_ (.sub )]
+                   (wrap (|>> (:as ) )))]
+
+                [Ratio %.ratio]
+                [Name %.name]
+                [Location %.location]
+                [Type %.type]
+                [Code %.code]
+                
+                [Instant %.instant]
+                [Duration %.duration]
+                [Date %.date]
+                [Time %.time]
+                [Month %.month]
+                [Day %.day]
+                
+                [json.JSON %.json]
+                [XML %.xml]))
+
+          (do <>.monad
+            [[_ elemT] (.apply (<>.and (.exactly List) .any))
+             elemR (.local (list elemT) representation)]
+            (wrap (|>> (:as (List Any)) (%.list elemR))))
+
+          (do <>.monad
+            [[_ elemT] (.apply (<>.and (.exactly Maybe) .any))
+             elemR (.local (list elemT) representation)]
+            (wrap (|>> (:as (Maybe Any))
+                       (%.maybe elemR)))))))
+
+(def: (variant_representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (do <>.monad
+    [membersR+ (.variant (<>.many representation))]
+    (wrap (function (_ variantV)
+            (let [[lefts right? sub_repr] (loop [lefts 0
+                                                 representations membersR+
+                                                 variantV variantV]
+                                            (case representations
+                                              (#.Cons leftR (#.Cons rightR extraR+))
+                                              (case (:as (| Any Any) variantV)
+                                                (#.Left left)
+                                                [lefts #0 (leftR left)]
+
+                                                (#.Right right)
+                                                (case extraR+
+                                                  #.Nil
+                                                  [lefts #1 (rightR right)]
+
+                                                  _
+                                                  (recur (inc lefts) (#.Cons rightR extraR+) right)))
+
+                                              _
+                                              (undefined)))]
+              (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")"))))))
+
+(def: (tuple_representation representation)
+  (-> (Parser Representation) (Parser Representation))
+  (do <>.monad
+    [membersR+ (.tuple (<>.many representation))]
+    (wrap (function (_ tupleV)
+            (let [tuple_body (loop [representations membersR+
+                                    tupleV tupleV]
+                               (case representations
+                                 #.Nil
+                                 ""
+                                 
+                                 (#.Cons lastR #.Nil)
+                                 (lastR tupleV)
+                                 
+                                 (#.Cons headR tailR)
+                                 (let [[leftV rightV] (:as [Any Any] tupleV)]
+                                   (%.format (headR leftV) " " (recur tailR rightV)))))]
+              (%.format "[" tuple_body "]"))))))
+
+(def: representation
+  (Parser Representation)
+  (<>.rec
+   (function (_ representation)
+     ($_ <>.either
+         ..primitive_representation
+         (..special_representation representation)
+         (..variant_representation representation)
+         (..tuple_representation representation)
+
+         (do <>.monad
+           [[funcT inputsT+] (.apply (<>.and .any (<>.many .any)))]
+           (case (type.apply inputsT+ funcT)
+             (#.Some outputT)
+             (.local (list outputT) representation)
+
+             #.None
+             (<>.fail "")))
+
+         (do <>.monad
+           [[name anonymous] .named]
+           (.local (list anonymous) representation))
+
+         (<>.fail "")
+         ))))
+
+(def: #export (represent type value)
+  (-> Type Any (Try Text))
+  (case (.run ..representation type)
+    (#try.Success representation)
+    (#try.Success (representation value))
+
+    (#try.Failure _)
+    (exception.throw ..cannot_represent_value type)))
+
+(syntax: #export (private {definition .identifier})
+  (let [[module _] definition]
+    (wrap (list (` ("lux in-module"
+                    (~ (code.text module))
+                    (~ (code.identifier definition))))))))
+
+(def: #export (log! message)
+  {#.doc "Logs message to standard output."}
+  (-> Text Any)
+  ("lux io log" message))
+
+(exception: #export (type_hole {location Location} {type Type})
+  (exception.report
+   ["Location" (%.location location)]
+   ["Type" (%.type type)]))
+
+(syntax: #export (:hole)
+  (do meta.monad
+    [location meta.location
+     expectedT meta.expected_type]
+    (function.constant (exception.throw ..type_hole [location expectedT]))))
+
+(type: Target
+  [Text (Maybe Code)])
+
+(def: target
+  (.Parser Target)
+  (<>.either (<>.and .local_identifier
+                     (\ <>.monad wrap #.None))
+             (.record (<>.and .local_identifier
+                                    (\ <>.monad map (|>> #.Some) .any)))))
+
+(exception: #export (unknown_local_binding {name Text})
+  (exception.report
+   ["Name" (%.text name)]))
+
+(syntax: #export (here {targets (: (.Parser (List Target))
+                                   (|> ..target
+                                       <>.some
+                                       (<>.default (list))))})
+  (do {! meta.monad}
+    [location meta.location
+     locals meta.locals
+     #let [environment (|> locals
+                           list.concat
+                           ## The list is reversed to make sure that, when building the dictionary,
+                           ## later bindings overshadow earlier ones if they have the same name.
+                           list.reverse
+                           (dictionary.from_list text.hash))]
+     targets (: (Meta (List Target))
+                (case targets
+                  #.Nil
+                  (|> environment
+                      dictionary.keys
+                      (list\map (function (_ local) [local #.None]))
+                      wrap)
+
+                  _
+                  (monad.map ! (function (_ [name format])
+                                 (if (dictionary.key? environment name)
+                                   (wrap [name format])
+                                   (function.constant (exception.throw ..unknown_local_binding [name]))))
+                             targets)))]
+    (wrap (list (` (..log! ("lux text concat"
+                            (~ (code.text (%.format (%.location location) text.new_line)))
+                            ((~! exception.report)
+                             (~+ (list\map (function (_ [name format])
+                                             (let [format (case format
+                                                            #.None
+                                                            (` (~! ..inspect))
+                                                            
+                                                            (#.Some format)
+                                                            format)]
+                                               (` [(~ (code.text name))
+                                                   ((~ format) (~ (code.local_identifier name)))])))
+                                           targets))))))))))
diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux
new file mode 100644
index 000000000..5cad0158c
--- /dev/null
+++ b/stdlib/source/library/lux/extension.lux
@@ -0,0 +1,89 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." monad]]
+    [control
+     ["<>" parser ("#\." monad)
+      ["" code (#+ Parser)]
+      ["" analysis]
+      ["" synthesis]]]
+    [data
+     ["." product]
+     [collection
+      ["." list ("#\." functor)]]]
+    [macro (#+ with_gensyms)
+     ["." code]
+     [syntax (#+ syntax:)]]
+    [tool
+     [compiler
+      ["." phase]]]]])
+
+(type: Input
+  {#variable Text
+   #parser Code})
+
+(def: (simple default)
+  (-> Code (Parser Input))
+  ($_ <>.and
+      .local_identifier
+      (<>\wrap default)))
+
+(def: complex
+  (Parser Input)
+  (.record ($_ <>.and
+                  .local_identifier
+                  .any)))
+
+(def: (input default)
+  (-> Code (Parser Input))
+  (<>.either (..simple default)
+             ..complex))
+
+(type: Declaration
+  {#name Code
+   #label Text
+   #phase Text
+   #archive Text
+   #inputs (List Input)})
+
+(def: (declaration default)
+  (-> Code (Parser Declaration))
+  (.form ($_ <>.and
+                .any
+                .local_identifier
+                .local_identifier
+                .local_identifier
+                (<>.some (..input default)))))
+
+(template [     ]
+  [(syntax: #export (
+                     {[name extension phase archive inputs] (..declaration (` ))}
+                     body)
+     (let [g!parser (case (list\map product.right inputs)
+                      #.Nil
+                      (` )
+                      
+                      parsers
+                      (` (.$_  (~+ parsers))))
+           g!name (code.local_identifier extension)
+           g!phase (code.local_identifier phase)
+           g!archive (code.local_identifier archive)]
+       (with_gensyms [g!handler g!inputs g!error]
+         (wrap (list (` ( (~ name)
+                                     (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs))
+                                       (.case ((~! ) (~ g!parser) (~ g!inputs))
+                                         (#.Right [(~+ (list\map (|>> product.left
+                                                                      code.local_identifier)
+                                                                 inputs))])
+                                         (~ body)
+
+                                         (#.Left (~ g!error))
+                                         ((~! phase.fail) (~ g!error)))
+                                       ))))))))]
+
+  [.any .end! .and .run "lux def analysis" analysis:]
+  [.any .end! .and .run "lux def synthesis" synthesis:]
+  [.any .end! .and .run "lux def generation" generation:]
+  [.any .end! .and .run "lux def directive" directive:]
+  )
diff --git a/stdlib/source/library/lux/ffi.js.lux b/stdlib/source/library/lux/ffi.js.lux
new file mode 100644
index 000000000..aae11fc1d
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.js.lux
@@ -0,0 +1,364 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand)
+  Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract: 
+       Any
+       
+       (type: #export 
+         (Object ))))]
+
+  [Function]
+  [Symbol]
+  [Null]
+  [Undefined]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Number  Frac]
+  [String  Text]
+  )
+
+(type: Nullable
+  [Bit Code])
+
+(def: nullable
+  (Parser Nullable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Constructor
+  (List Nullable))
+
+(def: constructor
+  (Parser Constructor)
+  (.form (<>.after (.this! (' new))
+                         (.tuple (<>.some ..nullable)))))
+
+(type: Field
+  [Bit Text Nullable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   ..nullable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Text)
+   #inputs (List Nullable)
+   #io? Bit
+   #try? Bit
+   #output Nullable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+  (#Static Static_Method)
+  (#Virtual Virtual_Method))
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe (<>.after (.this! (' #as)) .local_identifier))
+      (.tuple (<>.some ..nullable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..nullable))
+
+(def: static_method
+  (<>.after ..static! ..common_method))
+
+(def: method
+  (Parser Method)
+  (.form (<>.or ..static_method
+                      ..common_method)))
+
+(type: Member
+  (#Constructor Constructor)
+  (#Field Field)
+  (#Method Method))
+
+(def: member
+  (Parser Member)
+  ($_ <>.or
+      ..constructor
+      ..field
+      ..method
+      ))
+
+(def: input_variables
+  (-> (List Nullable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [nullable? type]])
+                   [nullable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nullable_type [nullable? type])
+  (-> Nullable Code)
+  (if nullable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_null g!temp [nullable? input])
+  (-> Code [Bit Code] Code)
+  (if nullable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.None
+         ("js object null")))
+    input))
+
+(def: (without_null g!temp [nullable? outputT] output)
+  (-> Code Nullable Code Code)
+  (if nullable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("js object null?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("js object null?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "Null is an invalid value."))))))
+
+(type: Import
+  (#Class [Text Text (List Member)])
+  (#Function Static_Method))
+
+(def: import
+  (Parser Import)
+  (<>.or (<>.and .local_identifier
+                 (<>.default ["" (list)]
+                             (.tuple (<>.and .text
+                                                   (<>.some member)))))
+         (.form ..common_method)))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (.try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Text (List Nullable) Bit Bit Nullable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map nullable_type inputsT))]
+             (~ (|> (nullable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_null g!temp outputT)
+                 (` ("js apply"
+                     ("js constant" (~ (code.text source)))
+                     (~+ (list\map (with_null g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Class [class format members])
+      (with_gensyms [g!object]
+        (let [qualify (: (-> Text Code)
+                         (function (_ member_name)
+                           (|> format
+                               (text.replace_all "#" class)
+                               (text.replace_all "." member_name)
+                               code.local_identifier)))
+              g!type (code.local_identifier class)
+              real_class (text.replace_all "/" "." class)]
+          (wrap (list& (` (type: (~ g!type)
+                            (..Object (primitive (~ (code.text real_class))))))
+                       (list\map (function (_ member)
+                                   (case member
+                                     (#Constructor inputsT)
+                                     (let [g!inputs (input_variables inputsT)]
+                                       (` (def: ((~ (qualify "new"))
+                                                 [(~+ (list\map product.right g!inputs))])
+                                            (-> [(~+ (list\map nullable_type inputsT))]
+                                                (~ g!type))
+                                            (:assume
+                                             ("js object new"
+                                              ("js constant" (~ (code.text real_class)))
+                                              [(~+ (list\map (with_null g!temp) g!inputs))])))))
+                                     
+                                     (#Field [static? field fieldT])
+                                     (if static?
+                                       (` ((~! syntax:) ((~ (qualify field)))
+                                           (\ (~! meta.monad) (~' wrap)
+                                              (list (` (.:as (~ (nullable_type fieldT))
+                                                             ("js constant" (~ (code.text (%.format real_class "." field))))))))))
+                                       (` (def: ((~ (qualify field))
+                                                 (~ g!object))
+                                            (-> (~ g!type)
+                                                (~ (nullable_type fieldT)))
+                                            (:assume
+                                             (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object)))))))))
+                                     
+                                     (#Method method)
+                                     (case method
+                                       (#Static [method alias inputsT io? try? outputT])
+                                       (..make_function (qualify (maybe.default method alias))
+                                                        g!temp
+                                                        (%.format real_class "." method)
+                                                        inputsT
+                                                        io?
+                                                        try?
+                                                        outputT)
+                                       
+                                       (#Virtual [method alias inputsT io? try? outputT])
+                                       (let [g!inputs (input_variables inputsT)]
+                                         (` (def: ((~ (qualify (maybe.default method alias)))
+                                                   [(~+ (list\map product.right g!inputs))]
+                                                   (~ g!object))
+                                              (-> [(~+ (list\map nullable_type inputsT))]
+                                                  (~ g!type)
+                                                  (~ (|> (nullable_type outputT)
+                                                         (try_type try?)
+                                                         (io_type io?))))
+                                              (:assume
+                                               (~ (<| (with_io io?)
+                                                      (with_try try?)
+                                                      (without_null g!temp outputT)
+                                                      (` ("js object do"
+                                                          (~ (code.text method))
+                                                          (~ g!object)
+                                                          [(~+ (list\map (with_null g!temp) g!inputs))])))))))))))
+                                 members)))))
+      
+      (#Function [name alias inputsT io? try? outputT])
+      (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                   g!temp
+                                   name
+                                   inputsT
+                                   io?
+                                   try?
+                                   outputT)))
+      )))
+
+(template: #export (type_of object)
+  ("js type-of" object))
+
+(syntax: #export (constant type
+                           {[head tail] (.tuple (<>.and .local_identifier (<>.some .local_identifier)))})
+  (with_gensyms [g!_]
+    (let [constant (` ("js constant" (~ (code.text head))))]
+      (case tail
+        #.Nil
+        (wrap (list (` (: (.Maybe (~ type))
+                          (case (..type_of (~ constant))
+                            "undefined"
+                            #.None
+
+                            (~ g!_)
+                            (#.Some (:as (~ type) (~ constant))))))))
+        
+        (#.Cons [next tail])
+        (let [separator "."]
+          (wrap (list (` (: (.Maybe (~ type))
+                            (case (..type_of (~ constant))
+                              "undefined"
+                              #.None
+
+                              (~ g!_)
+                              (..constant (~ type) [(~ (code.local_identifier (%.format head "." next)))
+                                                    (~+ (list\map code.local_identifier tail))])))))))))))
+
+(template: (!defined? )
+  (.case (..constant Any )
+    #.None
+    .false
+
+    (#.Some _)
+    .true))
+
+(template [ ]
+  [(def: #export 
+     Bit
+     (!defined? ))]
+
+  [on_browser? [window]]
+  [on_nashorn? [java lang Object]]
+  )
+
+(def: #export on_node_js?
+  Bit
+  (case (..constant (Object Any) [process])
+    (#.Some process)
+    (case (:as Text
+               ("js apply" ("js constant" "Object.prototype.toString.call") process))
+      "[object process]"
+      true
+
+      _
+      false)
+
+    #.None
+    false))
+
+(template: #export (closure  )
+  (.:as ..Function
+        (`` ("js function"
+             (~~ (template.count ))
+             (.function (_ [])
+               )))))
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
new file mode 100644
index 000000000..881c3f79d
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -0,0 +1,2048 @@
+(.module:
+  [library
+   ["." lux (#- Type type int char interface:)
+    ["#_." type ("#\." equivalence)]
+    [abstract
+     ["." monad (#+ Monad do)]
+     ["." enum]]
+    [control
+     ["." function]
+     ["." io]
+     ["." try (#+ Try)]
+     ["." exception (#+ Exception exception:)]
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." maybe]
+     ["." product]
+     ["." text ("#\." equivalence)
+      ["%" format (#+ format)]]
+     [collection
+      ["." array]
+      ["." list ("#\." monad fold monoid)]
+      ["." dictionary (#+ Dictionary)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]
+    ["." meta
+     ["." annotation]]
+    [target
+     [jvm
+      [encoding
+       ["." name (#+ External)]]
+      ["." type (#+ Type Argument Typed)
+       ["." category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
+       ["." box]
+       ["." descriptor]
+       ["." signature]
+       ["." reflection]
+       ["." parser]]]]]])
+
+(def: internal
+  (-> External Text)
+  (|>> name.internal
+       name.read))
+
+(def: signature
+  (All [category]
+    (-> (Type category) Text))
+  (|>> type.signature signature.signature))
+
+(def: reflection
+  (All [category]
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> type.reflection reflection.reflection))
+
+(template [ ]
+  [(def: #export 
+     .Type
+     (#.Primitive  #.Nil))]
+
+  [Boolean   box.boolean]
+  [Byte      box.byte]
+  [Short     box.short]
+  [Integer   box.int]
+  [Long      box.long]
+  [Float     box.float]
+  [Double    box.double]
+  [Character box.char]
+  )
+
+(template [ ]
+  [(def: #export 
+     .Type
+     (#.Primitive (reflection.reflection ) #.Nil))]
+
+  ## Primitives
+  [boolean   reflection.boolean]
+  [byte      reflection.byte]
+  [short     reflection.short]
+  [int       reflection.int]
+  [long      reflection.long]
+  [float     reflection.float]
+  [double    reflection.double]
+  [char      reflection.char]
+  )
+
+(def: (get_static_field class field)
+  (-> Text Text Code)
+  (` ("jvm member get static"
+      (~ (code.text class))
+      (~ (code.text field)))))
+
+(def: (get_virtual_field class field object)
+  (-> Text Text Code Code)
+  (` ("jvm member get virtual"
+      (~ (code.text class))
+      (~ (code.text field))
+      (~ object))))
+
+(def: boxes
+  (Dictionary (Type Value) Text)
+  (|> (list [type.boolean box.boolean]
+            [type.byte    box.byte]
+            [type.short   box.short]
+            [type.int     box.int]
+            [type.long    box.long]
+            [type.float   box.float]
+            [type.double  box.double]
+            [type.char    box.char])
+      (dictionary.from_list type.hash)))
+
+(template [ 
 ]
+  [(def: ( unboxed boxed raw)
+     (-> (Type Value) Text Code Code)
+     (let [unboxed (..reflection unboxed)]
+       (` (|> (~ raw)
+              (: (primitive (~ (code.text 
))))
+              "jvm object cast"
+              (: (primitive (~ (code.text ))))))))]
+
+  [unbox boxed unboxed]
+  [box unboxed boxed]
+  )
+
+(template [   ]
+  [(template: #export ( value)
+     {#.doc (doc "Type converter."
+                 (: 
+                    ( (:  foo))))}
+     (|> value
+         (: )
+         "jvm object cast"
+         
+         "jvm object cast"
+         (: )))]
+
+  [byte_to_long    "jvm conversion byte-to-long"    ..Byte      ..Long]
+
+  [short_to_long   "jvm conversion short-to-long"   ..Short     ..Long]
+  
+  [double_to_int   "jvm conversion double-to-int"   ..Double    ..Integer]
+  [double_to_long  "jvm conversion double-to-long"  ..Double    ..Long]
+  [double_to_float "jvm conversion double-to-float" ..Double    ..Float]
+
+  [float_to_int    "jvm conversion float-to-int"    ..Float     ..Integer]
+  [float_to_long   "jvm conversion float-to-long"   ..Float     ..Long]
+  [float_to_double "jvm conversion float-to-double" ..Float     ..Double]
+  
+  [int_to_byte     "jvm conversion int-to-byte"     ..Integer   ..Byte]
+  [int_to_short    "jvm conversion int-to-short"    ..Integer   ..Short]
+  [int_to_long     "jvm conversion int-to-long"     ..Integer   ..Long]
+  [int_to_float    "jvm conversion int-to-float"    ..Integer   ..Float]
+  [int_to_double   "jvm conversion int-to-double"   ..Integer   ..Double]
+  [int_to_char     "jvm conversion int-to-char"     ..Integer   ..Character]
+
+  [long_to_byte    "jvm conversion long-to-byte"    ..Long      ..Byte]
+  [long_to_short   "jvm conversion long-to-short"   ..Long      ..Short]
+  [long_to_int     "jvm conversion long-to-int"     ..Long      ..Integer]
+  [long_to_float   "jvm conversion long-to-float"   ..Long      ..Float]
+  [long_to_double  "jvm conversion long-to-double"  ..Long      ..Double]
+
+  [char_to_byte    "jvm conversion char-to-byte"    ..Character ..Byte]
+  [char_to_short   "jvm conversion char-to-short"   ..Character ..Short]
+  [char_to_int     "jvm conversion char-to-int"     ..Character ..Integer]
+  [char_to_long    "jvm conversion char-to-long"    ..Character ..Long]
+  )
+
+(template [   <0> <1>]
+  [(template: #export ( value)
+     {#.doc (doc "Type converter."
+                 (: 
+                    ( (:  foo))))}
+     (|> value <0> <1>))]
+
+  [long_to_char ..Long ..Character ..long_to_int ..int_to_char]
+  [byte_to_int ..Byte ..Integer ..byte_to_long ..long_to_int]
+  [short_to_int ..Short ..Integer ..short_to_long ..long_to_int]
+  [byte_to_char ..Byte ..Character ..byte_to_int ..int_to_char]
+  [short_to_char ..Short ..Character ..short_to_int ..int_to_char]
+  )
+
+(def: constructor_method_name
+  "")
+
+(type: Primitive_Mode
+  #ManualPrM
+  #AutoPrM)
+
+(type: Privacy
+  #PublicP
+  #PrivateP
+  #ProtectedP
+  #DefaultP)
+
+(type: StateModifier
+  #VolatileSM
+  #FinalSM
+  #DefaultSM)
+
+(type: InheritanceModifier
+  #FinalIM
+  #AbstractIM
+  #DefaultIM)
+
+(type: Class_Kind
+  #Class
+  #Interface)
+
+(type: StackFrame (primitive "java/lang/StackTraceElement"))
+(type: StackTrace (array.Array StackFrame))
+
+(type: Annotation_Parameter
+  [Text Code])
+
+(type: Annotation
+  {#ann_name   Text
+   #ann_params (List Annotation_Parameter)})
+
+(type: Member_Declaration
+  {#member_name Text
+   #member_privacy Privacy
+   #member_anns (List Annotation)})
+
+(type: FieldDecl
+  (#ConstantField (Type Value) Code)
+  (#VariableField StateModifier (Type Value)))
+
+(type: MethodDecl
+  {#method_tvars  (List (Type Var))
+   #method_inputs (List (Type Value))
+   #method_output (Type Return)
+   #method_exs    (List (Type Class))})
+
+(type: Method_Definition
+  (#ConstructorMethod [Bit
+                       (List (Type Var))
+                       Text
+                       (List Argument)
+                       (List (Typed Code))
+                       Code
+                       (List (Type Class))])
+  (#VirtualMethod [Bit
+                   Bit
+                   (List (Type Var))
+                   Text
+                   (List Argument)
+                   (Type Return)
+                   Code
+                   (List (Type Class))])
+  (#OverridenMethod [Bit
+                     (Type Declaration)
+                     (List (Type Var))
+                     Text
+                     (List Argument)
+                     (Type Return)
+                     Code
+                     (List (Type Class))])
+  (#StaticMethod [Bit
+                  (List (Type Var))
+                  (List Argument)
+                  (Type Return)
+                  Code
+                  (List (Type Class))])
+  (#AbstractMethod [(List (Type Var))
+                    (List Argument)
+                    (Type Return)
+                    (List (Type Class))])
+  (#NativeMethod [(List (Type Var))
+                  (List Argument)
+                  (Type Return)
+                  (List (Type Class))]))
+
+(type: Partial_Call
+  {#pc_method Name
+   #pc_args   (List Code)})
+
+(type: ImportMethodKind
+  #StaticIMK
+  #VirtualIMK)
+
+(type: ImportMethodCommons
+  {#import_member_mode   Primitive_Mode
+   #import_member_alias  Text
+   #import_member_kind   ImportMethodKind
+   #import_member_tvars  (List (Type Var))
+   #import_member_args   (List [Bit (Type Value)])
+   #import_member_maybe? Bit
+   #import_member_try?   Bit
+   #import_member_io?    Bit})
+
+(type: ImportConstructorDecl
+  {})
+
+(type: ImportMethodDecl
+  {#import_method_name    Text
+   #import_method_return  (Type Return)})
+
+(type: ImportFieldDecl
+  {#import_field_mode    Primitive_Mode
+   #import_field_name    Text
+   #import_field_static? Bit
+   #import_field_maybe?  Bit
+   #import_field_setter? Bit
+   #import_field_type    (Type Value)})
+
+(type: Import_Member_Declaration
+  (#EnumDecl        (List Text))
+  (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
+  (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
+  (#FieldAccessDecl ImportFieldDecl))
+
+(def: (primitive_type mode type)
+  (-> Primitive_Mode (Type Primitive) Code)
+  (case mode
+    #ManualPrM
+    (cond (\ type.equivalence = type.boolean type) (` ..Boolean)
+          (\ type.equivalence = type.byte type) (` ..Byte)
+          (\ type.equivalence = type.short type) (` ..Short)
+          (\ type.equivalence = type.int type) (` ..Integer)
+          (\ type.equivalence = type.long type) (` ..Long)
+          (\ type.equivalence = type.float type) (` ..Float)
+          (\ type.equivalence = type.double type) (` ..Double)
+          (\ type.equivalence = type.char type) (` ..Character)
+          ## else
+          (undefined))
+    
+    #AutoPrM
+    (cond (\ type.equivalence = type.boolean type)
+          (` .Bit)
+          
+          (or (\ type.equivalence = type.short type)
+              (\ type.equivalence = type.byte type)
+              (\ type.equivalence = type.int type)
+              (\ type.equivalence = type.long type))
+          (` .Int)
+          
+          (or (\ type.equivalence = type.float type)
+              (\ type.equivalence = type.double type))
+          (` .Frac)
+
+          (\ type.equivalence = type.char type)
+          (` .Nat)
+
+          ## else
+          (undefined))))
+
+(def: (parameter_type type)
+  (-> (Type Parameter) Code)
+  (`` (<| (~~ (template [  ]
+                [(case ( type)
+                   (#.Some )
+                   
+
+                   #.None)]
+
+                [parser.var? name (code.identifier ["" name])]
+                [parser.wildcard? _ (` .Any)]
+                [parser.lower? _ (` .Any)]
+                [parser.upper? limit (parameter_type limit)]
+                [parser.class? [name parameters]
+                 (` (.primitive (~ (code.text name))
+                                [(~+ (list\map parameter_type parameters))]))]))
+          ## else
+          (undefined)
+          )))
+
+(def: (value_type mode type)
+  (-> Primitive_Mode (Type Value) Code)
+  (`` (<| (~~ (template [  ]
+                [(case ( type)
+                   (#.Some )
+                   
+
+                   #.None)]
+
+                [parser.parameter? type (parameter_type type)]
+                [parser.primitive? type (primitive_type mode type)]
+                [parser.array? elementT (case (parser.primitive? elementT)
+                                          (#.Some elementT)
+                                          (` (#.Primitive (~ (code.text (..reflection (type.array elementT)))) #.Nil))
+                                          
+                                          #.None
+                                          (` (#.Primitive (~ (code.text array.type_name))
+                                                          (#.Cons (~ (value_type mode elementT)) #.Nil))))]))
+          (undefined)
+          )))
+
+(def: declaration_type$
+  (-> (Type Declaration) Code)
+  (|>> ..signature code.text))
+
+(def: (make_get_const_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (get_static_field class_name field_name))))
+
+(def: (make_get_var_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (get_virtual_field class_name field_name (' _jvm_this)))))
+
+(def: (make_put_var_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     [_ _ value] (: (Parser [Any Any Code])
+                    (.form ($_ <>.and (.this! (' :=)) (.this! (code.identifier ["" dotted_name])) .any)))]
+    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value))))))
+
+(def: (pre_walk_replace f input)
+  (-> (-> Code Code) Code Code)
+  (case (f input)
+    (^template []
+      [[meta ( parts)]
+       [meta ( (list\map (pre_walk_replace f) parts))]])
+    ([#.Form]
+     [#.Tuple])
+    
+    [meta (#.Record pairs)]
+    [meta (#.Record (list\map (: (-> [Code Code] [Code Code])
+                                 (function (_ [key val])
+                                   [(pre_walk_replace f key) (pre_walk_replace f val)]))
+                              pairs))]
+    
+    ast'
+    ast'))
+
+(def: (parser->replacer p ast)
+  (-> (Parser Code) (-> Code Code))
+  (case (<>.run p (list ast))
+    (#.Right [#.Nil ast'])
+    ast'
+
+    _
+    ast
+    ))
+
+(def: (field->parser class_name [[field_name _ _] field])
+  (-> Text [Member_Declaration FieldDecl] (Parser Code))
+  (case field
+    (#ConstantField _)
+    (make_get_const_parser class_name field_name)
+    
+    (#VariableField _)
+    (<>.either (make_get_var_parser class_name field_name)
+               (make_put_var_parser class_name field_name))))
+
+(def: (decorate_input [class value])
+  (-> [(Type Value) Code] Code)
+  (` [(~ (code.text (..signature class))) (~ value)]))
+
+(def: (make_constructor_parser class_name arguments)
+  (-> Text (List Argument) (Parser Code))
+  (do <>.monad
+    [args (: (Parser (List Code))
+             (.form (<>.after (.this! (' ::new!))
+                                    (.tuple (<>.exactly (list.size arguments) .any)))))]
+    (wrap (` ("jvm member invoke constructor" (~ (code.text class_name))
+              (~+ (|> args
+                      (list.zip/2 (list\map product.right arguments))
+                      (list\map ..decorate_input))))))))
+
+(def: (make_static_method_parser class_name method_name arguments)
+  (-> Text Text (List Argument) (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" method_name "!")]
+     args (: (Parser (List Code))
+             (.form (<>.after (.this! (code.identifier ["" dotted_name]))
+                                    (.tuple (<>.exactly (list.size arguments) .any)))))]
+    (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name))
+              (~+ (|> args
+                      (list.zip/2 (list\map product.right arguments))
+                      (list\map ..decorate_input))))))))
+
+(template [ ]
+  [(def: ( class_name method_name arguments)
+     (-> Text Text (List Argument) (Parser Code))
+     (do <>.monad
+       [#let [dotted_name (format "::" method_name "!")]
+        args (: (Parser (List Code))
+                (.form (<>.after (.this! (code.identifier ["" dotted_name]))
+                                       (.tuple (<>.exactly (list.size arguments) .any)))))]
+       (wrap (` ( (~ (code.text class_name)) (~ (code.text method_name))
+                          (~' _jvm_this)
+                          (~+ (|> args
+                                  (list.zip/2 (list\map product.right arguments))
+                                  (list\map ..decorate_input))))))))]
+
+  [make_special_method_parser "jvm member invoke special"]
+  [make_virtual_method_parser "jvm member invoke virtual"]
+  )
+
+(def: (method->parser class_name [[method_name _ _] meth_def])
+  (-> Text [Member_Declaration Method_Definition] (Parser Code))
+  (case meth_def
+    (#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs)
+    (make_constructor_parser class_name args)
+    
+    (#StaticMethod strict? type_vars args return_type return_expr exs)
+    (make_static_method_parser class_name method_name args)
+    
+    (^or (#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs)
+         (#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs))
+    (make_special_method_parser class_name method_name args)
+
+    (#AbstractMethod type_vars args return_type exs)
+    (make_virtual_method_parser class_name method_name args)
+
+    (#NativeMethod type_vars args return_type exs)
+    (make_virtual_method_parser class_name method_name args)))
+
+(def: privacy_modifier^
+  (Parser Privacy)
+  (let [(^open ".") <>.monad]
+    ($_ <>.or
+        (.this! (' #public))
+        (.this! (' #private))
+        (.this! (' #protected))
+        (wrap []))))
+
+(def: inheritance_modifier^
+  (Parser InheritanceModifier)
+  (let [(^open ".") <>.monad]
+    ($_ <>.or
+        (.this! (' #final))
+        (.this! (' #abstract))
+        (wrap []))))
+
+(exception: #export (class_names_cannot_contain_periods {name Text})
+  (exception.report
+   ["Name" (%.text name)]))
+
+(exception: #export (class_name_cannot_be_a_type_variable {name Text}
+                                                          {type_vars (List (Type Var))})
+  (exception.report
+   ["Name" (%.text name)]
+   ["Type Variables" (exception.enumerate parser.name type_vars)]))
+
+(def: (assert exception payload test)
+  (All [e] (-> (Exception e) e Bit (Parser Any)))
+  (<>.assert (exception.construct exception payload)
+             test))
+
+(def: (valid_class_name type_vars)
+  (-> (List (Type Var)) (Parser External))
+  (do <>.monad
+    [name .local_identifier
+     _ (..assert ..class_names_cannot_contain_periods [name]
+                 (not (text.contains? name.external_separator name)))
+     _ (..assert ..class_name_cannot_be_a_type_variable [name type_vars]
+                 (not (list.member? text.equivalence
+                                    (list\map parser.name type_vars)
+                                    name)))]
+    (wrap name)))
+
+(def: (class^' parameter^ type_vars)
+  (-> (-> (List (Type Var)) (Parser (Type Parameter)))
+      (-> (List (Type Var)) (Parser (Type Class))))
+  (do <>.monad
+    [[name parameters] (: (Parser [External (List (Type Parameter))])
+                          ($_ <>.either
+                              (<>.and (valid_class_name type_vars)
+                                      (<>\wrap (list)))
+                              (.form (<>.and .local_identifier
+                                                   (<>.some (parameter^ type_vars))))))]
+    (wrap (type.class (name.sanitize name) parameters))))
+
+(exception: #export (unexpected_type_variable {name Text}
+                                              {type_vars (List (Type Var))})
+  (exception.report
+   ["Unexpected Type Variable" (%.text name)]
+   ["Expected Type Variables" (exception.enumerate parser.name type_vars)]))
+
+(def: (variable^ type_vars)
+  (-> (List (Type Var)) (Parser (Type Parameter)))
+  (do <>.monad
+    [name .local_identifier
+     _ (..assert ..unexpected_type_variable [name type_vars]
+                 (list.member? text.equivalence (list\map parser.name type_vars) name))]
+    (wrap (type.var name))))
+
+(def: wildcard^
+  (Parser (Type Parameter))
+  (do <>.monad
+    [_ (.this! (' ?))]
+    (wrap type.wildcard)))
+
+(template [  ]
+  [(def: 
+     (-> (Parser (Type Class)) (Parser (Type Parameter)))
+     (|>> (<>.after (.this! (' )))
+          (<>.after ..wildcard^)
+          .tuple
+          (\ <>.monad map )))]
+
+  [upper^ < type.upper]
+  [lower^ > type.lower]
+  )
+
+(def: (parameter^ type_vars)
+  (-> (List (Type Var)) (Parser (Type Parameter)))
+  (<>.rec
+   (function (_ recur^)
+     (let [class^ (..class^' parameter^ type_vars)]
+       ($_ <>.either
+           (..variable^ type_vars)
+           ..wildcard^
+           (upper^ class^)
+           (lower^ class^)
+           class^
+           )))))
+
+(def: (itself^ type)
+  (All [category]
+    (-> (Type (<| Return' Value' category))
+        (Parser (Type (<| Return' Value' category)))))
+  (do <>.monad
+    [_ (.identifier! ["" (..reflection type)])]
+    (wrap type)))
+
+(def: primitive^
+  (Parser (Type Primitive))
+  ($_ <>.either
+      (itself^ type.boolean)
+      (itself^ type.byte)
+      (itself^ type.short)
+      (itself^ type.int)
+      (itself^ type.long)
+      (itself^ type.float)
+      (itself^ type.double)
+      (itself^ type.char)
+      ))
+
+(def: array^
+  (-> (Parser (Type Value)) (Parser (Type Array)))
+  (|>> .tuple
+       (\ <>.monad map type.array)))
+
+(def: (type^ type_vars)
+  (-> (List (Type Var)) (Parser (Type Value)))
+  (<>.rec
+   (function (_ type^)
+     ($_ <>.either
+         ..primitive^
+         (..parameter^ type_vars)
+         (..array^ type^)
+         ))))
+
+(def: void^
+  (Parser (Type Void))
+  (do <>.monad
+    [_ (.identifier! ["" (reflection.reflection reflection.void)])]
+    (wrap type.void)))
+
+(def: (return^ type_vars)
+  (-> (List (Type Var)) (Parser (Type Return)))
+  (<>.either ..void^
+             (..type^ type_vars)))
+
+(def: var^
+  (Parser (Type Var))
+  (\ <>.monad map type.var .local_identifier))
+
+(def: vars^
+  (Parser (List (Type Var)))
+  (.tuple (<>.some var^)))
+
+(def: declaration^
+  (Parser (Type Declaration))
+  (do <>.monad
+    [[name variables] (: (Parser [External (List (Type Var))])
+                         (<>.either (<>.and (..valid_class_name (list))
+                                            (<>\wrap (list)))
+                                    (.form (<>.and (..valid_class_name (list))
+                                                         (<>.some var^)))
+                                    ))]
+    (wrap (type.declaration name variables))))
+
+(def: (class^ type_vars)
+  (-> (List (Type Var)) (Parser (Type Class)))
+  (class^' parameter^ type_vars))
+
+(def: annotation_parameters^
+  (Parser (List Annotation_Parameter))
+  (.record (<>.some (<>.and .local_tag .any))))
+
+(def: annotation^
+  (Parser Annotation)
+  (<>.either (do <>.monad
+               [ann_name .local_identifier]
+               (wrap [ann_name (list)]))
+             (.form (<>.and .local_identifier
+                                  annotation_parameters^))))
+
+(def: annotations^'
+  (Parser (List Annotation))
+  (do <>.monad
+    [_ (.this! (' #ann))]
+    (.tuple (<>.some ..annotation^))))
+
+(def: annotations^
+  (Parser (List Annotation))
+  (do <>.monad
+    [anns?? (<>.maybe ..annotations^')]
+    (wrap (maybe.default (list) anns??))))
+
+(def: (throws_decl^ type_vars)
+  (-> (List (Type Var)) (Parser (List (Type Class))))
+  (<| (<>.default (list))
+      (do <>.monad
+        [_ (.this! (' #throws))]
+        (.tuple (<>.some (..class^ type_vars))))))
+
+(def: (method_decl^ type_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl]))
+  (.form (do <>.monad
+                 [tvars (<>.default (list) ..vars^)
+                  name .local_identifier
+                  anns ..annotations^
+                  inputs (.tuple (<>.some (..type^ type_vars)))
+                  output (..return^ type_vars)
+                  exs (throws_decl^ type_vars)]
+                 (wrap [[name #PublicP anns] {#method_tvars tvars
+                                              #method_inputs inputs
+                                              #method_output output
+                                              #method_exs    exs}]))))
+
+(def: state_modifier^
+  (Parser StateModifier)
+  ($_ <>.or
+      (.this! (' #volatile))
+      (.this! (' #final))
+      (\ <>.monad wrap [])))
+
+(def: (field_decl^ type_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl]))
+  (<>.either (.form (do <>.monad
+                            [_ (.this! (' #const))
+                             name .local_identifier
+                             anns ..annotations^
+                             type (..type^ type_vars)
+                             body .any]
+                            (wrap [[name #PublicP anns] (#ConstantField [type body])])))
+             (.form (do <>.monad
+                            [pm privacy_modifier^
+                             sm state_modifier^
+                             name .local_identifier
+                             anns ..annotations^
+                             type (..type^ type_vars)]
+                            (wrap [[name pm anns] (#VariableField [sm type])])))))
+
+(def: (argument^ type_vars)
+  (-> (List (Type Var)) (Parser Argument))
+  (.record (<>.and .local_identifier
+                         (..type^ type_vars))))
+
+(def: (arguments^ type_vars)
+  (-> (List (Type Var)) (Parser (List Argument)))
+  (<>.some (..argument^ type_vars)))
+
+(def: (constructor_arg^ type_vars)
+  (-> (List (Type Var)) (Parser (Typed Code)))
+  (.record (<>.and (..type^ type_vars) .any)))
+
+(def: (constructor_args^ type_vars)
+  (-> (List (Type Var)) (Parser (List (Typed Code))))
+  (.tuple (<>.some (..constructor_arg^ type_vars))))
+
+(def: (constructor_method^ class_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars (list\compose class_vars method_vars)]
+                  [_ self_name arguments] (.form ($_ <>.and
+                                                           (.this! (' new))
+                                                           .local_identifier
+                                                           (..arguments^ total_vars)))
+                  constructor_args (..constructor_args^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name constructor_method_name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)]))))
+
+(def: (virtual_method_def^ class_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  final? (<>.parses? (.this! (' #final)))
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars (list\compose class_vars method_vars)]
+                  [name self_name arguments] (.form ($_ <>.and
+                                                              .local_identifier
+                                                              .local_identifier
+                                                              (..arguments^ total_vars)))
+                  return_type (..return^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)]))))
+
+(def: overriden_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [strict_fp? (<>.parses? (.this! (' #strict)))
+                  owner_class ..declaration^
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars (list\compose (product.right (parser.declaration owner_class))
+                                                 method_vars)]
+                  [name self_name arguments] (.form ($_ <>.and
+                                                              .local_identifier
+                                                              .local_identifier
+                                                              (..arguments^ total_vars)))
+                  return_type (..return^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name name
+                         #member_privacy #PublicP
+                         #member_anns annotations}
+                        (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)]))))
+
+(def: static_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  _ (.this! (' #static))
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars method_vars]
+                  [name arguments] (.form (<>.and .local_identifier
+                                                        (..arguments^ total_vars)))
+                  return_type (..return^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#StaticMethod strict_fp? method_vars arguments return_type body exs)]))))
+
+(def: abstract_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  _ (.this! (' #abstract))
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars method_vars]
+                  [name arguments] (.form (<>.and .local_identifier
+                                                        (..arguments^ total_vars)))
+                  return_type (..return^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#AbstractMethod method_vars arguments return_type exs)]))))
+
+(def: native_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  _ (.this! (' #native))
+                  method_vars (<>.default (list) ..vars^)
+                  #let [total_vars method_vars]
+                  [name arguments] (.form (<>.and .local_identifier
+                                                        (..arguments^ total_vars)))
+                  return_type (..return^ total_vars)
+                  exs (throws_decl^ total_vars)
+                  annotations ..annotations^]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#NativeMethod method_vars arguments return_type exs)]))))
+
+(def: (method_def^ class_vars)
+  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
+  ($_ <>.either
+      (..constructor_method^ class_vars)
+      (..virtual_method_def^ class_vars)
+      ..overriden_method_def^
+      ..static_method_def^
+      ..abstract_method_def^
+      ..native_method_def^))
+
+(def: partial_call^
+  (Parser Partial_Call)
+  (.form (<>.and .identifier (<>.some .any))))
+
+(def: class_kind^
+  (Parser Class_Kind)
+  (<>.either (do <>.monad
+               [_ (.this! (' #class))]
+               (wrap #Class))
+             (do <>.monad
+               [_ (.this! (' #interface))]
+               (wrap #Interface))
+             ))
+
+(def: import_member_alias^
+  (Parser (Maybe Text))
+  (<>.maybe (do <>.monad
+              [_ (.this! (' #as))]
+              .local_identifier)))
+
+(def: (import_member_args^ type_vars)
+  (-> (List (Type Var)) (Parser (List [Bit (Type Value)])))
+  (.tuple (<>.some (<>.and (<>.parses? (.tag! ["" "?"]))
+                                 (..type^ type_vars)))))
+
+(def: import_member_return_flags^
+  (Parser [Bit Bit Bit])
+  ($_ <>.and
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      (<>.parses? (.this! (' #?)))))
+
+(def: primitive_mode^
+  (Parser Primitive_Mode)
+  (<>.or (.tag! ["" "manual"])
+         (.tag! ["" "auto"])))
+
+(def: (import_member_decl^ owner_vars)
+  (-> (List (Type Var)) (Parser Import_Member_Declaration))
+  ($_ <>.either
+      (.form (do <>.monad
+                     [_ (.this! (' #enum))
+                      enum_members (<>.some .local_identifier)]
+                     (wrap (#EnumDecl enum_members))))
+      (.form (do <>.monad
+                     [tvars (<>.default (list) ..vars^)
+                      _ (.identifier! ["" "new"])
+                      ?alias import_member_alias^
+                      #let [total_vars (list\compose owner_vars tvars)]
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      args (..import_member_args^ total_vars)
+                      [io? try? maybe?] import_member_return_flags^]
+                     (wrap (#ConstructorDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                               #import_member_alias   (maybe.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?}
+                                              {}]))
+                     ))
+      (.form (do <>.monad
+                     [kind (: (Parser ImportMethodKind)
+                              (<>.or (.tag! ["" "static"])
+                                     (wrap [])))
+                      tvars (<>.default (list) ..vars^)
+                      name .local_identifier
+                      ?alias import_member_alias^
+                      #let [total_vars (list\compose owner_vars tvars)]
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      args (..import_member_args^ total_vars)
+                      [io? try? maybe?] import_member_return_flags^
+                      return (..return^ total_vars)]
+                     (wrap (#MethodDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                          #import_member_alias   (maybe.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}]))))
+      (.form (do <>.monad
+                     [static? (<>.parses? (.this! (' #static)))
+                      name .local_identifier
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      gtype (..type^ owner_vars)
+                      maybe? (<>.parses? (.this! (' #?)))
+                      setter? (<>.parses? (.this! (' #!)))]
+                     (wrap (#FieldAccessDecl {#import_field_mode    (maybe.default #AutoPrM ?prim_mode)
+                                              #import_field_name    name
+                                              #import_field_static? static?
+                                              #import_field_maybe?  maybe?
+                                              #import_field_setter? setter?
+                                              #import_field_type    gtype}))))
+      ))
+
+(def: bundle
+  (-> (List (Type Var)) (Parser [Text (List Import_Member_Declaration)]))
+  (|>> ..import_member_decl^
+       <>.some
+       (<>.and .text)
+       .tuple))
+
+(def: (privacy_modifier$ pm)
+  (-> Privacy Code)
+  (case pm
+    #PublicP    (code.text "public")
+    #PrivateP   (code.text "private")
+    #ProtectedP (code.text "protected")
+    #DefaultP   (code.text "default")))
+
+(def: (inheritance_modifier$ im)
+  (-> InheritanceModifier Code)
+  (case im
+    #FinalIM    (code.text "final")
+    #AbstractIM (code.text "abstract")
+    #DefaultIM  (code.text "default")))
+
+(def: (annotation_parameter$ [name value])
+  (-> Annotation_Parameter Code)
+  (` [(~ (code.text name)) (~ value)]))
+
+(def: (annotation$ [name params])
+  (-> Annotation Code)
+  (` ((~ (code.text name)) (~+ (list\map annotation_parameter$ params)))))
+
+(template [ ]
+  [(def: 
+     (-> (Type ) Code)
+     (|>> ..signature code.text))]
+
+  [var$ Var]
+  [parameter$ Parameter]
+  [value$ Value]
+  [return$ Return]
+  [declaration$ Declaration]
+  [class$ Class]
+  )
+
+(def: var$'
+  (-> (Type Var) Code)
+  (|>> ..signature code.local_identifier))
+
+(def: (method_decl$ [[name pm anns] method_decl])
+  (-> [Member_Declaration MethodDecl] Code)
+  (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl]
+    (` ((~ (code.text name))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ method_tvars))]
+        [(~+ (list\map class$ method_exs))]
+        [(~+ (list\map value$ method_inputs))]
+        (~ (return$ method_output))))))
+
+(def: (state_modifier$ sm)
+  (-> StateModifier Code)
+  (case sm
+    #VolatileSM (' "volatile")
+    #FinalSM    (' "final")
+    #DefaultSM  (' "default")))
+
+(def: (field_decl$ [[name pm anns] field])
+  (-> [Member_Declaration FieldDecl] Code)
+  (case field
+    (#ConstantField class value)
+    (` ("constant" (~ (code.text name))
+        [(~+ (list\map annotation$ anns))]
+        (~ (value$ class))
+        (~ value)
+        ))
+
+    (#VariableField sm class)
+    (` ("variable" (~ (code.text name))
+        (~ (privacy_modifier$ pm))
+        (~ (state_modifier$ sm))
+        [(~+ (list\map annotation$ anns))]
+        (~ (value$ class))
+        ))
+    ))
+
+(def: (argument$ [name type])
+  (-> Argument Code)
+  (` [(~ (code.text name)) (~ (value$ type))]))
+
+(def: (constructor_arg$ [class term])
+  (-> (Typed Code) Code)
+  (` [(~ (value$ class)) (~ term)]))
+
+(def: (method_def$ replacer super_class [[name pm anns] method_def])
+  (-> (-> Code Code) (Type Class) [Member_Declaration Method_Definition] Code)
+  (case method_def
+    (#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs)
+    (` ("init"
+        (~ (privacy_modifier$ pm))
+        (~ (code.bit strict_fp?))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ type_vars))]
+        [(~+ (list\map class$ exs))]
+        (~ (code.text self_name))
+        [(~+ (list\map argument$ arguments))]
+        [(~+ (list\map constructor_arg$ constructor_args))]
+        (~ (pre_walk_replace replacer body))
+        ))
+    
+    (#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs)
+    (` ("virtual"
+        (~ (code.text name))
+        (~ (privacy_modifier$ pm))
+        (~ (code.bit final?))
+        (~ (code.bit strict_fp?))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ type_vars))]
+        (~ (code.text self_name))
+        [(~+ (list\map argument$ arguments))]
+        (~ (return$ return_type))
+        [(~+ (list\map class$ exs))]
+        (~ (pre_walk_replace replacer body))))
+    
+    (#OverridenMethod strict_fp? declaration type_vars self_name arguments return_type body exs)
+    (let [super_replacer (parser->replacer (.form (do <>.monad
+                                                          [_ (.this! (' ::super!))
+                                                           args (.tuple (<>.exactly (list.size arguments) .any))]
+                                                          (wrap (` ("jvm member invoke special"
+                                                                    (~ (code.text (product.left (parser.read_class super_class))))
+                                                                    (~ (code.text name))
+                                                                    (~' _jvm_this)
+                                                                    (~+ (|> args
+                                                                            (list.zip/2 (list\map product.right arguments))
+                                                                            (list\map ..decorate_input)))))))))]
+      (` ("override"
+          (~ (declaration$ declaration))
+          (~ (code.text name))
+          (~ (code.bit strict_fp?))
+          [(~+ (list\map annotation$ anns))]
+          [(~+ (list\map var$ type_vars))]
+          (~ (code.text self_name))
+          [(~+ (list\map argument$ arguments))]
+          (~ (return$ return_type))
+          [(~+ (list\map class$ exs))]
+          (~ (|> body
+                 (pre_walk_replace replacer)
+                 (pre_walk_replace super_replacer)))
+          )))
+
+    (#StaticMethod strict_fp? type_vars arguments return_type body exs)
+    (` ("static"
+        (~ (code.text name))
+        (~ (privacy_modifier$ pm))
+        (~ (code.bit strict_fp?))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ type_vars))]
+        [(~+ (list\map class$ exs))]
+        [(~+ (list\map argument$ arguments))]
+        (~ (return$ return_type))
+        (~ (pre_walk_replace replacer body))))
+
+    (#AbstractMethod type_vars arguments return_type exs)
+    (` ("abstract"
+        (~ (code.text name))
+        (~ (privacy_modifier$ pm))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ type_vars))]
+        [(~+ (list\map class$ exs))]
+        [(~+ (list\map argument$ arguments))]
+        (~ (return$ return_type))))
+
+    (#NativeMethod type_vars arguments return_type exs)
+    (` ("native"
+        (~ (code.text name))
+        (~ (privacy_modifier$ pm))
+        [(~+ (list\map annotation$ anns))]
+        [(~+ (list\map var$ type_vars))]
+        [(~+ (list\map class$ exs))]
+        [(~+ (list\map argument$ arguments))]
+        (~ (return$ return_type))))
+    ))
+
+(def: (complete_call$ g!obj [method args])
+  (-> Code Partial_Call Code)
+  (` ((~ (code.identifier method)) (~+ args) (~ g!obj))))
+
+(def: $Object
+  (Type Class)
+  (type.class "java.lang.Object" (list)))
+
+(syntax: #export (class:
+                   {#let [! <>.monad]}
+                   {im inheritance_modifier^}
+                   {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)}
+                   {super (<>.default $Object
+                                      (class^ class_vars))}
+                   {interfaces (<>.default (list)
+                                           (.tuple (<>.some (class^ class_vars))))}
+                   {annotations ..annotations^}
+                   {fields (<>.some (..field_decl^ class_vars))}
+                   {methods (<>.some (..method_def^ class_vars))})
+  {#.doc (doc "Allows defining JVM classes in Lux code."
+              "For example:"
+              (class: #final (TestClass A) [Runnable]
+                ## Fields
+                (#private foo boolean)
+                (#private bar A)
+                (#private baz java/lang/Object)
+                ## Methods
+                (#public [] (new [value A]) []
+                         (exec (:= ::foo #1)
+                           (:= ::bar value)
+                           (:= ::baz "")
+                           []))
+                (#public (virtual) java/lang/Object
+                         "")
+                (#public #static (static) java/lang/Object
+                         "")
+                (Runnable [] (run) void
+                          [])
+                )
+
+              "The tuple corresponds to parent interfaces."
+              "An optional super-class can be specified before the tuple. 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 #1) for modifying it."
+              "(::new! []) for calling the class's constructor."
+              "(::resolve! container [value]) for calling the 'resolve' method."
+              )}
+  (do meta.monad
+    [current_module meta.current_module_name
+     #let [fully_qualified_class_name (name.qualify current_module full_class_name)
+           field_parsers (list\map (field->parser fully_qualified_class_name) fields)
+           method_parsers (list\map (method->parser fully_qualified_class_name) methods)
+           replacer (parser->replacer (list\fold <>.either
+                                                 (<>.fail "")
+                                                 (list\compose field_parsers method_parsers)))]]
+    (wrap (list (` ("jvm class"
+                    (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars)))
+                    (~ (class$ super))
+                    [(~+ (list\map class$ interfaces))]
+                    (~ (inheritance_modifier$ im))
+                    [(~+ (list\map annotation$ annotations))]
+                    [(~+ (list\map field_decl$ fields))]
+                    [(~+ (list\map (method_def$ replacer super) methods))]))))))
+
+(syntax: #export (interface:
+                   {#let [! <>.monad]}
+                   {[full_class_name class_vars] (\ ! map parser.declaration ..declaration^)}
+                   {supers (<>.default (list)
+                                       (.tuple (<>.some (class^ class_vars))))}
+                   {annotations ..annotations^}
+                   {members (<>.some (..method_decl^ class_vars))})
+  {#.doc (doc "Allows defining JVM interfaces."
+              (interface: TestInterface
+                ([] foo [boolean String] void #throws [Exception])))}
+  (do meta.monad
+    [current_module meta.current_module_name]
+    (wrap (list (` ("jvm class interface"
+                    (~ (declaration$ (type.declaration (name.qualify current_module full_class_name) class_vars)))
+                    [(~+ (list\map class$ supers))]
+                    [(~+ (list\map annotation$ annotations))]
+                    (~+ (list\map method_decl$ members))))))))
+
+(syntax: #export (object
+                   {class_vars ..vars^}
+                   {super (<>.default $Object
+                                      (class^ class_vars))}
+                   {interfaces (<>.default (list)
+                                           (.tuple (<>.some (class^ class_vars))))}
+                   {constructor_args (..constructor_args^ class_vars)}
+                   {methods (<>.some ..overriden_method_def^)})
+  {#.doc (doc "Allows defining anonymous classes."
+              "The 1st tuple corresponds to class-level type-variables."
+              "The 2nd tuple corresponds to parent interfaces."
+              "The 3rd tuple corresponds to arguments to the super class constructor."
+              "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed."
+              (object [] [Runnable]
+                []
+                (Runnable [] (run self) void
+                          (exec (do_something some_value)
+                            [])))
+              )}
+  (wrap (list (` ("jvm class anonymous"
+                  [(~+ (list\map var$ class_vars))]
+                  (~ (class$ super))
+                  [(~+ (list\map class$ interfaces))]
+                  [(~+ (list\map constructor_arg$ constructor_args))]
+                  [(~+ (list\map (method_def$ function.identity super) methods))])))))
+
+(syntax: #export (null)
+  {#.doc (doc "Null object reference."
+              (null))}
+  (wrap (list (` ("jvm object null")))))
+
+(def: #export (null? obj)
+  {#.doc (doc "Test for null object reference."
+              (= (null? (null))
+                 true)
+              (= (null? "YOLO")
+                 false))}
+  (-> (primitive "java.lang.Object") Bit)
+  ("jvm object null?" obj))
+
+(syntax: #export (??? expr)
+  {#.doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it."
+              (= (??? (: java/lang/String (null)))
+                 #.None)
+              (= (??? "YOLO")
+                 (#.Some "YOLO")))}
+  (with_gensyms [g!temp]
+    (wrap (list (` (let [(~ g!temp) (~ expr)]
+                     (if ("jvm object null?" (~ g!temp))
+                       #.None
+                       (#.Some (~ g!temp)))))))))
+
+(syntax: #export (!!! expr)
+  {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
+              "A #.None would get translated into a (null)."
+              (= (null)
+                 (!!! (??? (: java/lang/Thread (null)))))
+              (= "foo"
+                 (!!! (??? "foo"))))}
+  (with_gensyms [g!value]
+    (wrap (list (` ({(#.Some (~ g!value))
+                     (~ g!value)
+
+                     #.None
+                     ("jvm object null")}
+                    (~ expr)))))))
+
+(syntax: #export (check {class (..type^ (list))}
+                        {unchecked (<>.maybe .any)})
+  {#.doc (doc "Checks whether an object is an instance of a particular class."
+              "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes."
+              (case (check String "YOLO")
+                (#.Some value_as_string)
+                #.None))}
+  (with_gensyms [g!_ g!unchecked]
+    (let [class_name (..reflection class)
+          class_type (` (.primitive (~ (code.text class_name))))
+          check_type (` (.Maybe (~ class_type)))
+          check_code (` (if ("jvm object instance?" (~ (code.text class_name)) (~ g!unchecked))
+                          (#.Some (.:as (~ class_type)
+                                        (~ g!unchecked)))
+                          #.None))]
+      (case unchecked
+        (#.Some unchecked)
+        (wrap (list (` (: (~ check_type)
+                          (let [(~ g!unchecked) (~ unchecked)]
+                            (~ check_code))))))
+
+        #.None
+        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
+                          (function ((~ g!_) (~ g!unchecked))
+                            (~ check_code))))))
+        ))))
+
+(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 (` ("jvm object synchronized" (~ lock) (~ body))))))
+
+(syntax: #export (do_to obj {methods (<>.some partial_call^)})
+  {#.doc (doc "Call a variety of methods on an object. Then, return the object."
+              (do_to object
+                (ClassName::method1 arg0 arg1 arg2)
+                (ClassName::method2 arg3 arg4 arg5)))}
+  (with_gensyms [g!obj]
+    (wrap (list (` (let [(~ g!obj) (~ obj)]
+                     (exec (~+ (list\map (complete_call$ g!obj) methods))
+                       (~ g!obj))))))))
+
+(def: (class_import$ declaration)
+  (-> (Type Declaration) Code)
+  (let [[full_name params] (parser.declaration declaration)
+        def_name (..internal full_name)
+        params' (list\map ..var$' params)]
+    (` (def: (~ (code.identifier ["" def_name]))
+         {#..jvm_class (~ (code.text (..internal full_name)))}
+         .Type
+         (All [(~+ params')]
+           (primitive (~ (code.text full_name))
+                      [(~+ params')]))))))
+
+(def: (member_type_vars class_tvars member)
+  (-> (List (Type Var)) Import_Member_Declaration (List (Type Var)))
+  (case member
+    (#ConstructorDecl [commons _])
+    (list\compose class_tvars (get@ #import_member_tvars commons))
+
+    (#MethodDecl [commons _])
+    (case (get@ #import_member_kind commons)
+      #StaticIMK
+      (get@ #import_member_tvars commons)
+
+      _
+      (list\compose class_tvars (get@ #import_member_tvars commons)))
+
+    _
+    class_tvars))
+
+(def: (member_def_arg_bindings vars member)
+  (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)]))
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (let [(^slots [#import_member_tvars #import_member_args]) commons]
+      (do {! meta.monad}
+        [arg_inputs (monad.map !
+                               (: (-> [Bit (Type Value)] (Meta [Bit Code]))
+                                  (function (_ [maybe? _])
+                                    (with_gensyms [arg_name]
+                                      (wrap [maybe? arg_name]))))
+                               import_member_args)
+         #let [input_jvm_types (list\map product.right import_member_args)
+               arg_types (list\map (: (-> [Bit (Type Value)] Code)
+                                      (function (_ [maybe? arg])
+                                        (let [arg_type (value_type (get@ #import_member_mode commons) arg)]
+                                          (if maybe?
+                                            (` (Maybe (~ arg_type)))
+                                            arg_type))))
+                                   import_member_args)]]
+        (wrap [arg_inputs input_jvm_types arg_types])))
+
+    _
+    (\ meta.monad wrap [(list) (list) (list)])))
+
+(def: (decorate_return_maybe member never_null? unboxed return_term)
+  (-> Import_Member_Declaration Bit (Type Value) Code Code)
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (cond (or never_null?
+              (dictionary.key? ..boxes unboxed))
+          return_term
+
+          (get@ #import_member_maybe? commons)
+          (` (??? (~ return_term)))
+
+          ## else
+          (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
+            (` (let [(~ g!temp) (~ return_term)]
+                 (if (not (..null? (:as (primitive "java.lang.Object")
+                                        (~ g!temp))))
+                   (~ g!temp)
+                   (error! "Cannot produce null references from method calls."))))))
+
+    _
+    return_term))
+
+(template [  ]
+  [(def: ( member return_term)
+     (-> Import_Member_Declaration Code Code)
+     (case member
+       (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+       (if (get@  commons)
+         
+         return_term)
+
+       _
+       return_term))]
+
+  [decorate_return_try #import_member_try? (` (.try (~ return_term)))]
+  [decorate_return_io  #import_member_io?  (` ((~! io.io) (~ return_term)))]
+  )
+
+(def: $String
+  (type.class "java.lang.String" (list)))
+
+(template [   ]
+  [(def: ( mode [unboxed raw])
+     (-> Primitive_Mode [(Type Value) Code] Code)
+     (let [[unboxed refined post] (: [(Type Value) Code (List Code)]
+                                     (case mode
+                                       #ManualPrM
+                                       [unboxed raw (list)]
+                                       
+                                       #AutoPrM
+                                       (with_expansions [' (template.splice )
+                                                          (template [  
 ]
+                                                                        [(\ type.equivalence =  unboxed)
+                                                                         (with_expansions [' (template.splice )]
+                                                                           [
+                                                                            (` (.|> (~ raw) (~+ 
)))
+                                                                            (list ')])]
+
+                                                                        ')]
+                                         (cond 
+                                               ## else
+                                               [unboxed
+                                                (if 
+                                                  (` ("jvm object cast" (~ raw)))
+                                                  raw)
+                                                (list)]))))
+           unboxed/boxed (case (dictionary.get unboxed ..boxes)
+                           (#.Some boxed)
+                           ( unboxed boxed refined)
+                           
+                           #.None
+                           refined)]
+       (case post
+         #.Nil
+         unboxed/boxed
+
+         _
+         (` (.|> (~ unboxed/boxed) (~+ post))))))]
+
+  [#1 auto_convert_input ..unbox
+   [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []]
+    [type.byte type.byte (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []]
+    [type.short type.short (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []]
+    [type.int type.int (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_int)) []]
+    [type.long type.long (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []]
+    [type.float type.float (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double))))) (` ..double_to_float)) []]
+    [type.double type.double (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []]
+    [..$String ..$String (list (` (.: .Text)) (` (.:as (.primitive (~ (code.text (..reflection ..$String))))))) []]
+    [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []]
+    [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []]
+    [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []]]]
+  [#0 auto_convert_output ..box
+   [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]]
+    [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
+    [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
+    [type.int type.long (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
+    [type.long type.long (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
+    [type.float type.double (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]]
+    [type.double type.double (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]]
+    [..$String ..$String (list) [(` (.: (.primitive (~ (code.text (..reflection ..$String)))))) (` (.:as .Text))]]
+    [(type.class box.boolean (list)) (type.class box.boolean (list)) (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]]
+    [(type.class box.long (list)) (type.class box.long (list)) (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]]
+    [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:as .Frac))]]]]
+  )
+
+(def: (un_quote quoted)
+  (-> Code Code)
+  (` ((~' ~) (~ quoted))))
+
+(def: (jvm_invoke_inputs mode classes inputs)
+  (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code))
+  (|> inputs
+      (list.zip/2 classes)
+      (list\map (function (_ [class [maybe? input]])
+                  (|> (if maybe?
+                        (` (: (.primitive (~ (code.text (..reflection class))))
+                              ((~! !!!) (~ (un_quote input)))))
+                        (un_quote input))
+                      [class]
+                      (auto_convert_input mode))))))
+
+(def: (import_name format class member)
+  (-> Text Text Text Text)
+  (|> format
+      (text.replace_all "#" class)
+      (text.replace_all "." member)))
+
+(def: (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format)
+  (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text Text (Meta (List Code)))
+  (let [[full_name class_tvars] (parser.declaration class)]
+    (case member
+      (#EnumDecl enum_members)
+      (do meta.monad
+        [#let [enum_type (: Code
+                            (case class_tvars
+                              #.Nil
+                              (` (primitive (~ (code.text full_name))))
+
+                              _
+                              (let [=class_tvars (list\map ..var$' class_tvars)]
+                                (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
+               getter_interop (: (-> Text Code)
+                                 (function (_ name)
+                                   (let [getter_name (code.identifier ["" (..import_name import_format method_prefix name)])]
+                                     (` (def: (~ getter_name)
+                                          (~ enum_type)
+                                          (~ (get_static_field full_name name)))))))]]
+        (wrap (list\map getter_interop enum_members)))
+      
+      (#ConstructorDecl [commons _])
+      (do meta.monad
+        [#let [classT (type.class full_name (list))
+               def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+               jvm_interop (|> [classT
+                                (` ("jvm member invoke constructor"
+                                    [(~+ (list\map ..var$ class_tvars))]
+                                    (~ (code.text full_name))
+                                    [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))]
+                                    (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
+                                            (list.zip/2 input_jvm_types)
+                                            (list\map ..decorate_input)))))]
+                               (auto_convert_output (get@ #import_member_mode commons))
+                               (decorate_return_maybe member true classT)
+                               (decorate_return_try member)
+                               (decorate_return_io member))]]
+        (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
+                        ((~' wrap) (.list (.` (~ jvm_interop)))))))))
+
+      (#MethodDecl [commons method])
+      (with_gensyms [g!obj]
+        (do meta.monad
+          [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+                 (^slots [#import_member_kind]) commons
+                 (^slots [#import_method_name]) method
+                 [jvm_op object_ast] (: [Text (List Code)]
+                                        (case import_member_kind
+                                          #StaticIMK
+                                          ["jvm member invoke static"
+                                           (list)]
+
+                                          #VirtualIMK
+                                          (case kind
+                                            #Class
+                                            ["jvm member invoke virtual"
+                                             (list g!obj)]
+                                            
+                                            #Interface
+                                            ["jvm member invoke interface"
+                                             (list g!obj)]
+                                            )))
+                 method_return (get@ #import_method_return method)
+                 callC (: Code
+                          (` ((~ (code.text jvm_op))
+                              [(~+ (list\map ..var$ class_tvars))]
+                              (~ (code.text full_name))
+                              (~ (code.text import_method_name))
+                              [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))]
+                              (~+ (|> object_ast
+                                      (list\map ..un_quote)
+                                      (list.zip/2 (list (type.class full_name (list))))
+                                      (list\map (auto_convert_input (get@ #import_member_mode commons)))))
+                              (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs)
+                                      (list.zip/2 input_jvm_types)
+                                      (list\map ..decorate_input))))))
+                 jvm_interop (: Code
+                                (case (type.void? method_return)
+                                  (#.Left method_return)
+                                  (|> [method_return
+                                       callC]
+                                      (auto_convert_output (get@ #import_member_mode commons))
+                                      (decorate_return_maybe member false method_return)
+                                      (decorate_return_try member)
+                                      (decorate_return_io member))
+                                  
+                                  
+                                  (#.Right method_return)
+                                  (|> callC
+                                      (decorate_return_try member)
+                                      (decorate_return_io member))))]]
+          (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
+                          ((~' wrap) (.list (.` (~ jvm_interop))))))))))
+
+      (#FieldAccessDecl fad)
+      (do meta.monad
+        [#let [(^open ".") fad
+               getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)])
+               setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])]
+         getter_interop (with_gensyms [g!obj]
+                          (let [getter_call (if import_field_static?
+                                              (` ((~ getter_name)))
+                                              (` ((~ getter_name) (~ g!obj))))
+                                getter_body (<| (auto_convert_output import_field_mode)
+                                                [import_field_type
+                                                 (if import_field_static?
+                                                   (get_static_field full_name import_field_name)
+                                                   (get_virtual_field full_name import_field_name (un_quote g!obj)))])
+                                getter_body (if import_field_maybe?
+                                              (` ((~! ???) (~ getter_body)))
+                                              getter_body)
+                                getter_body (if import_field_setter?
+                                              (` ((~! io.io) (~ getter_body)))
+                                              getter_body)]
+                            (wrap (` ((~! syntax:) (~ getter_call)
+                                      ((~' wrap) (.list (.` (~ getter_body)))))))))
+         setter_interop (: (Meta (List Code))
+                           (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_value (|> [import_field_type (un_quote g!value)]
+                                                      (auto_convert_input import_field_mode))
+                                     setter_value (if import_field_maybe?
+                                                    (` ((~! !!!) (~ setter_value)))
+                                                    setter_value)
+                                     setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield")
+                                                            ":" full_name ":" import_field_name)
+                                     g!obj+ (: (List Code)
+                                               (if import_field_static?
+                                                 (list)
+                                                 (list (un_quote g!obj))))]
+                                 (wrap (list (` ((~! syntax:) (~ setter_call)
+                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
+                             (wrap (list))))]
+        (wrap (list& getter_interop setter_interop)))
+      )))
+
+(def: (member_import$ vars kind class [import_format member])
+  (-> (List (Type Var)) Class_Kind (Type Declaration) [Text Import_Member_Declaration] (Meta (List Code)))
+  (let [[full_name _] (parser.declaration class)
+        method_prefix (..internal full_name)]
+    (do meta.monad
+      [=args (member_def_arg_bindings vars member)]
+      (member_def_interop vars kind class =args member method_prefix import_format))))
+
+(def: interface?
+  (All [a] (-> (primitive "java.lang.Class" [a]) Bit))
+  (|>> ("jvm member invoke virtual" [] "java.lang.Class" "isInterface" [])
+       "jvm object cast"
+       (: ..Boolean)
+       (:as Bit)))
+
+(def: load_class
+  (-> External (Try (primitive "java.lang.Class" [Any])))
+  (|>> (:as (primitive "java.lang.String"))
+       ["Ljava/lang/String;"]
+       ("jvm member invoke static" [] "java.lang.Class" "forName" [])
+       try))
+
+(def: (class_kind declaration)
+  (-> (Type Declaration) (Meta Class_Kind))
+  (let [[class_name _] (parser.declaration declaration)]
+    (case (load_class class_name)
+      (#.Right class)
+      (\ meta.monad wrap (if (interface? class)
+                           #Interface
+                           #Class))
+
+      (#.Left _)
+      (meta.fail (format "Unknown class: " class_name)))))
+
+(syntax: #export (import:
+                   {declaration ..declaration^}
+                   {#let [[class_name class_type_vars] (parser.declaration declaration)]}
+                   {bundles (<>.some (..bundle class_type_vars))})
+  {#.doc (doc "Allows importing JVM classes, and using them as types."
+              "Their methods, fields and enum options can also be imported."
+              (import: java/lang/Object
+                ["#::."
+                 (new [])
+                 (equals [java/lang/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 Try 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)."
+              (import: java/lang/String
+                ["#::."
+                 (new [[byte]])
+                 (#static valueOf [char] java/lang/String)
+                 (#static valueOf #as int_valueOf [int] java/lang/String)])
+
+              (import: (java/util/List e)
+                ["#::."
+                 (size [] int)
+                 (get [int] e)])
+
+              (import: (java/util/ArrayList a)
+                ["#::."
+                 ([T] toArray [[T]] [T])])
+              
+              "The class-type that is generated is of the fully-qualified name."
+              "This avoids a clash between the java.util.List type, and Lux's own List type."
+              "All enum options to be imported must be specified."
+              (import: java/lang/Character$UnicodeScript
+                ["#::."
+                 (#enum ARABIC CYRILLIC LATIN)])
+
+              "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-vars."
+              "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
+              (import: (lux/concurrency/promise/JvmPromise A)
+                ["#::."
+                 (resolve [A] boolean)
+                 (poll [] A)
+                 (wasResolved [] boolean)
+                 (waitOn [lux/Function] void)
+                 (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))])
+              
+              "Also, the names of the imported members will look like Class::member"
+              (java/lang/Object::new [])
+              (java/lang/Object::equals [other_object] my_object)
+              (java/util/List::size [] my_list)
+              java/lang/Character$UnicodeScript::LATIN
+              )}
+  (do {! meta.monad}
+    [kind (class_kind declaration)
+     =members (|> bundles
+                  (list\map (function (_ [import_format members])
+                              (list\map (|>> [import_format]) members)))
+                  list.concat
+                  (monad.map ! (member_import$ class_type_vars kind declaration)))]
+    (wrap (list& (class_import$ declaration) (list\join =members)))))
+
+(syntax: #export (array {type (..type^ (list))}
+                        size)
+  {#.doc (doc "Create an array of the given type, with the given size."
+              (array java/lang/Object 10))}
+  (let [g!size (` (|>  (~ size)
+                       (.: .Nat)
+                       (.:as (.primitive (~ (code.text box.long))))
+                       "jvm object cast"
+                       "jvm conversion long-to-int"))]
+    (`` (cond (~~ (template [ ]
+                    [(\ type.equivalence =  type)
+                     (wrap (list (` ( (~ g!size)))))]
+
+                    [type.boolean "jvm array new boolean"]
+                    [type.byte    "jvm array new byte"]
+                    [type.short   "jvm array new short"]
+                    [type.int     "jvm array new int"]
+                    [type.long    "jvm array new long"]
+                    [type.float   "jvm array new float"]
+                    [type.double  "jvm array new double"]
+                    [type.char    "jvm array new char"]))
+              ## else
+              (wrap (list (` (: (~ (value_type #ManualPrM (type.array type)))
+                                ("jvm array new object" (~ g!size))))))))))
+
+(exception: #export (cannot_convert_to_jvm_type {type .Type})
+  (exception.report
+   ["Lux Type" (%.type type)]))
+
+(with_expansions [ (as_is (meta.fail (exception.construct ..cannot_convert_to_jvm_type [type])))]
+  (def: (lux_type->jvm_type type)
+    (-> .Type (Meta (Type Value)))
+    (if (lux_type\= .Any type)
+      (\ meta.monad wrap $Object)
+      (case type
+        (#.Primitive name params)
+        (`` (cond (~~ (template []
+                        [(text\= (..reflection ) name)
+                         (case params
+                           #.Nil
+                           (\ meta.monad wrap )
+
+                           _
+                           )]
+                        
+                        [type.boolean]
+                        [type.byte]
+                        [type.short]
+                        [type.int]
+                        [type.long]
+                        [type.float]
+                        [type.double]
+                        [type.char]))
+
+                  (~~ (template []
+                        [(text\= (..reflection (type.array )) name)
+                         (case params
+                           #.Nil
+                           (\ meta.monad wrap (type.array ))
+
+                           _
+                           )]
+                        
+                        [type.boolean]
+                        [type.byte]
+                        [type.short]
+                        [type.int]
+                        [type.long]
+                        [type.float]
+                        [type.double]
+                        [type.char]))
+
+                  (text\= array.type_name name)
+                  (case params
+                    (#.Cons elementLT #.Nil)
+                    (\ meta.monad map type.array
+                       (lux_type->jvm_type elementLT))
+
+                    _
+                    )
+
+                  (text.starts_with? descriptor.array_prefix name)
+                  (case params
+                    #.Nil
+                    (let [[_ unprefixed] (maybe.assume (text.split_with descriptor.array_prefix name))]
+                      (\ meta.monad map type.array
+                         (lux_type->jvm_type (#.Primitive unprefixed (list)))))
+
+                    _
+                    )
+
+                  ## else
+                  (\ meta.monad map (type.class name)
+                     (: (Meta (List (Type Parameter)))
+                        (monad.map meta.monad
+                                   (function (_ paramLT)
+                                     (do meta.monad
+                                       [paramJT (lux_type->jvm_type paramLT)]
+                                       (case (parser.parameter? paramJT)
+                                         (#.Some paramJT)
+                                         (wrap paramJT)
+
+                                         #.None
+                                         )))
+                                   params)))))
+
+        (#.Apply A F)
+        (case (lux_type.apply (list A) F)
+          #.None
+          
+
+          (#.Some type')
+          (lux_type->jvm_type type'))
+        
+        (#.Named _ type')
+        (lux_type->jvm_type type')
+
+        _
+        ))))
+
+(syntax: #export (array_length array)
+  {#.doc (doc "Gives the length of an array."
+              (array_length my_array))}
+  (case array
+    [_ (#.Identifier array_name)]
+    (do meta.monad
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
+       #let [g!extension (code.text (`` (cond (~~ (template [ ]
+                                                    [(\ type.equivalence =
+                                                        (type.array )
+                                                        array_jvm_type)
+                                                     ]
+
+                                                    [type.boolean "jvm array length boolean"]
+                                                    [type.byte "jvm array length byte"]
+                                                    [type.short "jvm array length short"]
+                                                    [type.int "jvm array length int"]
+                                                    [type.long "jvm array length long"]
+                                                    [type.float "jvm array length float"]
+                                                    [type.double "jvm array length double"]
+                                                    [type.char "jvm array length char"]))
+                                              
+                                              ## else
+                                              "jvm array length object")))]]
+      (wrap (list (` (.|> ((~ g!extension) (~ array))
+                          "jvm conversion int-to-long"
+                          "jvm object cast"
+                          (.: (.primitive (~ (code.text box.long))))
+                          (.:as .Nat))))))
+
+    _
+    (with_gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (..array_length (~ g!array)))))))))
+
+(syntax: #export (array_read idx array)
+  {#.doc (doc "Loads an element from an array."
+              (array_read 10 my_array))}
+  (case array
+    [_ (#.Identifier array_name)]
+    (do meta.monad
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
+       #let [g!idx (` (.|> (~ idx)
+                           (.: .Nat)
+                           (.:as (.primitive (~ (code.text box.long))))
+                           "jvm object cast"
+                           "jvm conversion long-to-int"))]]
+      (`` (cond (~~ (template [  ]
+                      [(\ type.equivalence =
+                          (type.array )
+                          array_jvm_type)
+                       (wrap (list (` (.|> ( (~ g!idx) (~ array))
+                                           "jvm object cast"
+                                           (.: (.primitive (~ (code.text ))))))))]
+
+                      [type.boolean "jvm array read boolean" box.boolean]
+                      [type.byte "jvm array read byte" box.byte]
+                      [type.short "jvm array read short" box.short]
+                      [type.int "jvm array read int" box.int]
+                      [type.long "jvm array read long" box.long]
+                      [type.float "jvm array read float" box.float]
+                      [type.double "jvm array read double" box.double]
+                      [type.char "jvm array read char" box.char]))
+                
+                ## else
+                (wrap (list (` ("jvm array read object" (~ g!idx) (~ array))))))))
+
+    _
+    (with_gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (..array_read (~ idx) (~ g!array)))))))))
+
+(syntax: #export (array_write idx value array)
+  {#.doc (doc "Stores an element into an array."
+              (array_write 10 my_object my_array))}
+  (case array
+    [_ (#.Identifier array_name)]
+    (do meta.monad
+      [array_type (meta.find_type array_name)
+       array_jvm_type (lux_type->jvm_type array_type)
+       #let [g!idx (` (.|> (~ idx)
+                           (.: .Nat)
+                           (.:as (.primitive (~ (code.text box.long))))
+                           "jvm object cast"
+                           "jvm conversion long-to-int"))]]
+      (`` (cond (~~ (template [  ]
+                      [(\ type.equivalence =
+                          (type.array )
+                          array_jvm_type)
+                       (let [g!value (` (.|> (~ value)
+                                             (.:as (.primitive (~ (code.text ))))
+                                             "jvm object cast"))]
+                         (wrap (list (` ( (~ g!idx) (~ g!value) (~ array))))))]
+
+                      [type.boolean "jvm array write boolean" box.boolean]
+                      [type.byte "jvm array write byte" box.byte]
+                      [type.short "jvm array write short" box.short]
+                      [type.int "jvm array write int" box.int]
+                      [type.long "jvm array write long" box.long]
+                      [type.float "jvm array write float" box.float]
+                      [type.double "jvm array write double" box.double]
+                      [type.char "jvm array write char" box.char]))
+                
+                ## else
+                (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array))))))))
+
+    _
+    (with_gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (..array_write (~ idx) (~ value) (~ g!array)))))))))
+
+(syntax: #export (class_for {type (..type^ (list))})
+  {#.doc (doc "Loads the class as a java.lang.Class object."
+              (class_for java/lang/String))}
+  (wrap (list (` ("jvm object class" (~ (code.text (..reflection type))))))))
+
+(syntax: #export (type {type (..type^ (list))})
+  (wrap (list (..value_type #ManualPrM type))))
+
+(exception: #export (cannot_cast_to_non_object {type (Type Value)})
+  (exception.report
+   ["Signature" (..signature type)]
+   ["Reflection" (..reflection type)]))
+
+(syntax: #export (:cast {type (..type^ (list))}
+                        object)
+  (case [(parser.array? type)
+         (parser.class? type)]
+    (^or [(#.Some _) _] [_ (#.Some _)])
+    (wrap (list (` (.: (~ (..value_type #ManualPrM type))
+                       ("jvm object cast" (~ object))))))
+
+    _
+    (meta.fail (exception.construct ..cannot_cast_to_non_object [type]))))
diff --git a/stdlib/source/library/lux/ffi.lua.lux b/stdlib/source/library/lux/ffi.lua.lux
new file mode 100644
index 000000000..0099865f5
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.lua.lux
@@ -0,0 +1,310 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    ["@" target]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract: #export  Any)
+     (type: #export 
+       (..Object )))]
+
+  [Nil]
+  [Function]
+  [Table]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Integer Int]
+  [Float   Frac]
+  [String  Text]
+  )
+
+(type: Nilable
+  [Bit Code])
+
+(def: nilable
+  (Parser Nilable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Field
+  [Bit Text Nilable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   ..nilable)))
+
+(def: constant
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>\wrap true)
+                   .local_identifier
+                   ..nilable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Text)
+   #inputs (List Nilable)
+   #io? Bit
+   #try? Bit
+   #output Nilable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+  (#Static Static_Method)
+  (#Virtual Virtual_Method))
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe (<>.after (.this! (' #as)) .local_identifier))
+      (.tuple (<>.some ..nilable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..nilable))
+
+(def: static_method
+  (<>.after ..static! ..common_method))
+
+(def: method
+  (Parser Method)
+  (.form (<>.or ..static_method
+                      ..common_method)))
+
+(type: Member
+  (#Field Field)
+  (#Method Method))
+
+(def: member
+  (Parser Member)
+  ($_ <>.or
+      ..field
+      ..method
+      ))
+
+(def: input_variables
+  (-> (List Nilable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [nilable? type]])
+                   [nilable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nilable_type [nilable? type])
+  (-> Nilable Code)
+  (if nilable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_nil g!temp [nilable? input])
+  (-> Code [Bit Code] Code)
+  (if nilable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.Nil
+         ("lua object nil")))
+    input))
+
+(def: (without_nil g!temp [nilable? outputT] output)
+  (-> Code Nilable Code Code)
+  (if nilable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("lua object nil?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("lua object nil?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "Nil is an invalid value!"))))))
+
+(type: Import
+  (#Class [Text Text (List Member)])
+  (#Function Static_Method)
+  (#Constant Field))
+
+(def: import
+  ($_ <>.or
+      (<>.and .local_identifier
+              (<>.default ["" (list)]
+                          (.tuple (<>.and .text
+                                                (<>.some member)))))
+      (.form ..common_method)
+      ..constant
+      ))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (.try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Code (List Nilable) Bit Bit Nilable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map nilable_type inputsT))]
+             (~ (|> (nilable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_nil g!temp outputT)
+                 (` ("lua apply"
+                     (:as ..Function (~ source))
+                     (~+ (list\map (with_nil g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Class [class format members])
+      (with_gensyms [g!object]
+        (let [qualify (: (-> Text Code)
+                         (function (_ member_name)
+                           (|> format
+                               (text.replace_all "#" class)
+                               (text.replace_all "." member_name)
+                               code.local_identifier)))
+              g!type (code.local_identifier class)
+              real_class (text.replace_all "/" "." class)
+              imported (case (text.split_all_with "/" class)
+                         (#.Cons head tail)
+                         (list\fold (function (_ sub super)
+                                      (` ("lua object get" (~ (code.text sub))
+                                          (:as (..Object .Any) (~ super)))))
+                                    (` ("lua import" (~ (code.text head))))
+                                    tail)
+                         
+                         #.Nil
+                         (` ("lua import" (~ (code.text class)))))]
+          (wrap (list& (` (type: (~ g!type)
+                            (..Object (primitive (~ (code.text real_class))))))
+                       (list\map (function (_ member)
+                                   (case member
+                                     (#Field [static? field fieldT])
+                                     (if static?
+                                       (` ((~! syntax:) ((~ (qualify field)))
+                                           (\ (~! meta.monad) (~' wrap)
+                                              (list (` (.:as (~ (nilable_type fieldT))
+                                                             ("lua object get" (~ (code.text field))
+                                                              (:as (..Object .Any) (~ imported)))))))))
+                                       (` (def: ((~ (qualify field))
+                                                 (~ g!object))
+                                            (-> (~ g!type)
+                                                (~ (nilable_type fieldT)))
+                                            (:assume
+                                             (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field))
+                                                                               (:as (..Object .Any) (~ g!object))))))))))
+                                     
+                                     (#Method method)
+                                     (case method
+                                       (#Static [method alias inputsT io? try? outputT])
+                                       (..make_function (qualify (maybe.default method alias))
+                                                        g!temp
+                                                        (` ("lua object get" (~ (code.text method))
+                                                            (:as (..Object .Any) (~ imported))))
+                                                        inputsT
+                                                        io?
+                                                        try?
+                                                        outputT)
+                                       
+                                       (#Virtual [method alias inputsT io? try? outputT])
+                                       (let [g!inputs (input_variables inputsT)]
+                                         (` (def: ((~ (qualify (maybe.default method alias)))
+                                                   [(~+ (list\map product.right g!inputs))]
+                                                   (~ g!object))
+                                              (-> [(~+ (list\map nilable_type inputsT))]
+                                                  (~ g!type)
+                                                  (~ (|> (nilable_type outputT)
+                                                         (try_type try?)
+                                                         (io_type io?))))
+                                              (:assume
+                                               (~ (<| (with_io io?)
+                                                      (with_try try?)
+                                                      (without_nil g!temp outputT)
+                                                      (` ("lua object do"
+                                                          (~ (code.text method))
+                                                          (~ g!object)
+                                                          (~+ (list\map (with_nil g!temp) g!inputs)))))))))))))
+                                 members)))))
+      
+      (#Function [name alias inputsT io? try? outputT])
+      (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                   g!temp
+                                   (` ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))
+                                   inputsT
+                                   io?
+                                   try?
+                                   outputT)))
+
+      (#Constant [_ name fieldT])
+      (wrap (list (` ((~! syntax:) ((~ (code.local_identifier name)))
+                      (\ (~! meta.monad) (~' wrap)
+                         (list (` (.:as (~ (nilable_type fieldT))
+                                        ("lua constant" (~ (code.text (text.replace_all "/" "." name))))))))))))
+      )))
+
+(template: #export (closure  )
+  (.:as ..Function
+        (`` ("lua function"
+             (~~ (template.count ))
+             (.function (_ [])
+               )))))
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
new file mode 100644
index 000000000..fdb5d1412
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -0,0 +1,1829 @@
+(.module:
+  [library
+   [lux (#- type interface:)
+    ["." type ("#\." equivalence)]
+    [abstract
+     ["." monad (#+ Monad do)]
+     ["." enum]]
+    [control
+     ["." function]
+     ["." io]
+     ["." try (#+ Try)]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." maybe]
+     ["." product]
+     ["." bit ("#\." codec)]
+     ["." text ("#\." equivalence monoid)
+      ["%" format (#+ format)]]
+     [collection
+      ["." array (#+ Array)]
+      ["." list ("#\." monad fold monoid)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]]
+    ["." meta
+     ["." annotation]]]])
+
+(template [   ]
+  [(def: #export ( value)
+     {#.doc (doc "Type converter."
+                 (: 
+                    ( (:  foo))))}
+     (-> (primitive ) (primitive ))
+     ( value))]
+
+  [byte_to_long "jvm convert byte-to-long" "java.lang.Byte"      "java.lang.Long"]
+
+  [short_to_long "jvm convert short-to-long" "java.lang.Short"     "java.lang.Long"]
+  
+  [double_to_int "jvm convert double-to-int" "java.lang.Double"    "java.lang.Integer"]
+  [double_to_long "jvm convert double-to-long" "java.lang.Double"    "java.lang.Long"]
+  [double_to_float "jvm convert double-to-float" "java.lang.Double"    "java.lang.Float"]
+
+  [float_to_int "jvm convert float-to-int" "java.lang.Float"     "java.lang.Integer"]
+  [float_to_long "jvm convert float-to-long" "java.lang.Float"     "java.lang.Long"]
+  [float_to_double "jvm convert float-to-double" "java.lang.Float"     "java.lang.Double"]
+  
+  [int_to_byte "jvm convert int-to-byte" "java.lang.Integer"   "java.lang.Byte"]
+  [int_to_short "jvm convert int-to-short" "java.lang.Integer"   "java.lang.Short"]
+  [int_to_long "jvm convert int-to-long" "java.lang.Integer"   "java.lang.Long"]
+  [int_to_float "jvm convert int-to-float" "java.lang.Integer"   "java.lang.Float"]
+  [int_to_double "jvm convert int-to-double" "java.lang.Integer"   "java.lang.Double"]
+  [int_to_char "jvm convert int-to-char" "java.lang.Integer"   "java.lang.Character"]
+
+  [long_to_byte "jvm convert long-to-byte" "java.lang.Long"      "java.lang.Byte"]
+  [long_to_short "jvm convert long-to-short" "java.lang.Long"      "java.lang.Short"]
+  [long_to_int "jvm convert long-to-int" "java.lang.Long"      "java.lang.Integer"]
+  [long_to_float "jvm convert long-to-float" "java.lang.Long"      "java.lang.Float"]
+  [long_to_double "jvm convert long-to-double" "java.lang.Long"      "java.lang.Double"]
+
+  [char_to_byte "jvm convert char-to-byte" "java.lang.Character" "java.lang.Byte"]
+  [char_to_short "jvm convert char-to-short" "java.lang.Character" "java.lang.Short"]
+  [char_to_int "jvm convert char-to-int" "java.lang.Character" "java.lang.Integer"]
+  [char_to_long "jvm convert char-to-long" "java.lang.Character" "java.lang.Long"]
+  )
+
+## [Utils]
+(def: constructor_method_name "")
+(def: member_separator "::")
+
+## Types
+(type: JVM_Code Text)
+
+(type: BoundKind
+  #UpperBound
+  #LowerBound)
+
+(type: #rec GenericType
+  (#GenericTypeVar Text)
+  (#GenericClass [Text (List GenericType)])
+  (#GenericArray GenericType)
+  (#GenericWildcard (Maybe [BoundKind GenericType])))
+
+(type: Type_Parameter
+  [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: Class_Kind
+  #Class
+  #Interface)
+
+(type: Class_Declaration
+  {#class_name   Text
+   #class_params (List Type_Parameter)})
+
+(type: StackFrame (primitive "java/lang/StackTraceElement"))
+(type: StackTrace (Array StackFrame))
+
+(type: Super_Class_Decl
+  {#super_class_name   Text
+   #super_class_params (List GenericType)})
+
+(type: AnnotationParam
+  [Text Code])
+
+(type: Annotation
+  {#ann_name   Text
+   #ann_params (List AnnotationParam)})
+
+(type: Member_Declaration
+  {#member_name Text
+   #member_privacy PrivacyModifier
+   #member_anns (List Annotation)})
+
+(type: FieldDecl
+  (#ConstantField GenericType Code)
+  (#VariableField StateModifier GenericType))
+
+(type: MethodDecl
+  {#method_tvars  (List Type_Parameter)
+   #method_inputs (List GenericType)
+   #method_output GenericType
+   #method_exs    (List GenericType)})
+
+(type: ArgDecl
+  {#arg_name Text
+   #arg_type GenericType})
+
+(type: ConstructorArg
+  [GenericType Code])
+
+(type: Method_Definition
+  (#ConstructorMethod [Bit
+                       (List Type_Parameter)
+                       (List ArgDecl)
+                       (List ConstructorArg)
+                       Code
+                       (List GenericType)])
+  (#VirtualMethod [Bit
+                   Bit
+                   (List Type_Parameter)
+                   Text
+                   (List ArgDecl)
+                   GenericType
+                   Code
+                   (List GenericType)])
+  (#OverridenMethod [Bit
+                     Class_Declaration
+                     (List Type_Parameter)
+                     Text
+                     (List ArgDecl)
+                     GenericType
+                     Code
+                     (List GenericType)])
+  (#StaticMethod [Bit
+                  (List Type_Parameter)
+                  (List ArgDecl)
+                  GenericType
+                  Code
+                  (List GenericType)])
+  (#AbstractMethod [(List Type_Parameter)
+                    (List ArgDecl)
+                    GenericType
+                    (List GenericType)])
+  (#NativeMethod [(List Type_Parameter)
+                  (List ArgDecl)
+                  GenericType
+                  (List GenericType)]))
+
+(type: Partial_Call
+  {#pc_method Name
+   #pc_args   (List Code)})
+
+(type: ImportMethodKind
+  #StaticIMK
+  #VirtualIMK)
+
+(type: ImportMethodCommons
+  {#import_member_mode   Primitive_Mode
+   #import_member_alias  Text
+   #import_member_kind   ImportMethodKind
+   #import_member_tvars  (List Type_Parameter)
+   #import_member_args   (List [Bit GenericType])
+   #import_member_maybe? Bit
+   #import_member_try?   Bit
+   #import_member_io?    Bit})
+
+(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? Bit
+   #import_field_maybe?  Bit
+   #import_field_setter? Bit
+   #import_field_type    GenericType})
+
+(type: Import_Member_Declaration
+  (#EnumDecl        (List Text))
+  (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
+  (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
+  (#FieldAccessDecl ImportFieldDecl))
+
+## Utils
+(def: (manual_primitive_to_type class)
+  (-> Text (Maybe Code))
+  (case class
+    (^template [ ]
+      [
+       (#.Some (' ))])
+    (["boolean" (primitive "java.lang.Boolean")]
+     ["byte"    (primitive "java.lang.Byte")]
+     ["short"   (primitive "java.lang.Short")]
+     ["int"     (primitive "java.lang.Integer")]
+     ["long"    (primitive "java.lang.Long")]
+     ["float"   (primitive "java.lang.Float")]
+     ["double"  (primitive "java.lang.Double")]
+     ["char"    (primitive "java.lang.Character")]
+     ["void"    .Any])
+
+    _
+    #.None))
+
+(def: (auto_primitive_to_type class)
+  (-> Text (Maybe Code))
+  (case class
+    (^template [ ]
+      [
+       (#.Some (' ))])
+    (["boolean" .Bit]
+     ["byte"    .Int]
+     ["short"   .Int]
+     ["int"     .Int]
+     ["long"    .Int]
+     ["float"   .Frac]
+     ["double"  .Frac]
+     ["void"    .Any])
+
+    _
+    #.None))
+
+(def: sanitize
+  (-> Text Text)
+  (text.replace_all "/" "."))
+
+(def: (generic_class_to_type' mode type_params in_array? name+params
+                              class_to_type')
+  (-> Primitive_Mode (List Type_Parameter) Bit [Text (List GenericType)]
+      (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code)
+      Code)
+  (case [name+params mode in_array?]
+    (^multi [[prim #.Nil] #ManualPrM #0]
+            [(manual_primitive_to_type prim) (#.Some output)])
+    output
+
+    (^multi [[prim #.Nil] #AutoPrM #0]
+            [(auto_primitive_to_type prim) (#.Some output)])
+    output
+    
+    [[name params] _ _]
+    (let [name (sanitize name)
+          =params (list\map (class_to_type' mode type_params in_array?) params)]
+      (` (primitive (~ (code.text name)) [(~+ =params)])))))
+
+(def: (class_to_type' mode type_params in_array? class)
+  (-> Primitive_Mode (List Type_Parameter) Bit GenericType Code)
+  (case class
+    (#GenericTypeVar name)
+    (case (list.find (function (_ [pname pbounds])
+                       (and (text\= name pname)
+                            (not (list.empty? pbounds))))
+                     type_params)
+      #.None
+      (code.identifier ["" name])
+
+      (#.Some [pname pbounds])
+      (class_to_type' mode type_params in_array? (maybe.assume (list.head pbounds))))
+    
+    (#GenericClass name+params)
+    (generic_class_to_type' mode type_params in_array? name+params
+                            class_to_type')
+
+    (#GenericArray param)
+    (let [=param (class_to_type' mode type_params #1 param)]
+      (` ((~! array.Array) (~ =param))))
+
+    (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _])))
+    (` .Any)
+
+    (#GenericWildcard (#.Some [#UpperBound upper_bound]))
+    (class_to_type' mode type_params in_array? upper_bound)
+    ))
+
+(def: (class_to_type mode type_params class)
+  (-> Primitive_Mode (List Type_Parameter) GenericType Code)
+  (class_to_type' mode type_params #0 class))
+
+(def: (type_param_type$ [name bounds])
+  (-> Type_Parameter Code)
+  (code.identifier ["" name]))
+
+(def: (class_decl_type$ (^slots [#class_name #class_params]))
+  (-> Class_Declaration Code)
+  (let [=params (list\map (: (-> Type_Parameter Code)
+                             (function (_ [pname pbounds])
+                               (case pbounds
+                                 #.Nil
+                                 (code.identifier ["" pname])
+
+                                 (#.Cons bound1 _)
+                                 (class_to_type #ManualPrM class_params bound1))))
+                          class_params)]
+    (` (primitive (~ (code.text (sanitize class_name)))
+                  [(~+ =params)]))))
+
+(def: type_var_class Text "java.lang.Object")
+
+(def: (simple_class$ env class)
+  (-> (List Type_Parameter) GenericType Text)
+  (case class
+    (#GenericTypeVar name)
+    (case (list.find (function (_ [pname pbounds])
+                       (and (text\= name pname)
+                            (not (list.empty? pbounds))))
+                     env)
+      #.None
+      type_var_class
+
+      (#.Some [pname pbounds])
+      (simple_class$ env (maybe.assume (list.head pbounds))))
+
+    (^or (#GenericWildcard #.None) (#GenericWildcard (#.Some [#LowerBound _])))
+    type_var_class
+    
+    (#GenericWildcard (#.Some [#UpperBound upper_bound]))
+    (simple_class$ env upper_bound)
+    
+    (#GenericClass name env)
+    (sanitize name)
+
+    (#GenericArray param')
+    (case param'
+      (#GenericArray param)
+      (format "[" (simple_class$ env 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$ env param) ";"))
+    ))
+
+(def: (make_get_const_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name))))))))
+
+(def: (make_get_var_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     _ (.this! (code.identifier ["" dotted_name]))]
+    (wrap (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this)))))
+
+(def: (make_put_var_parser class_name field_name)
+  (-> Text Text (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" field_name)]
+     [_ _ value] (: (Parser [Any Any Code])
+                    (.form ($_ <>.and (.this! (' :=)) (.this! (code.identifier ["" dotted_name])) .any)))]
+    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value))))))
+
+(def: (pre_walk_replace f input)
+  (-> (-> Code Code) Code Code)
+  (case (f input)
+    (^template []
+      [[meta ( parts)]
+       [meta ( (list\map (pre_walk_replace f) parts))]])
+    ([#.Form]
+     [#.Tuple])
+    
+    [meta (#.Record pairs)]
+    [meta (#.Record (list\map (: (-> [Code Code] [Code Code])
+                                 (function (_ [key val])
+                                   [(pre_walk_replace f key) (pre_walk_replace f val)]))
+                              pairs))]
+    
+    ast'
+    ast'))
+
+(def: (parser->replacer p ast)
+  (-> (Parser Code) (-> Code Code))
+  (case (<>.run p (list ast))
+    (#.Right [#.Nil ast'])
+    ast'
+
+    _
+    ast
+    ))
+
+(def: (field->parser class_name [[field_name _ _] field])
+  (-> Text [Member_Declaration FieldDecl] (Parser Code))
+  (case field
+    (#ConstantField _)
+    (make_get_const_parser class_name field_name)
+    
+    (#VariableField _)
+    (<>.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 Type_Parameter) Text (List ArgDecl) (Parser Code))
+  (do <>.monad
+    [args (: (Parser (List Code))
+             (.form (<>.after (.this! (' ::new!))
+                                    (.tuple (<>.exactly (list.size arg_decls) .any)))))
+     #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+    (wrap (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls'))))
+              (~+ args))))))
+
+(def: (make_static_method_parser params class_name method_name arg_decls)
+  (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code))
+  (do <>.monad
+    [#let [dotted_name (format "::" method_name "!")]
+     args (: (Parser (List Code))
+             (.form (<>.after (.this! (code.identifier ["" dotted_name]))
+                                    (.tuple (<>.exactly (list.size arg_decls) .any)))))
+     #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+    (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls'))))
+               (~+ args))))))
+
+(template [ ]
+  [(def: ( params class_name method_name arg_decls)
+     (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code))
+     (do <>.monad
+       [#let [dotted_name (format "::" method_name "!")]
+        args (: (Parser (List Code))
+                (.form (<>.after (.this! (code.identifier ["" dotted_name]))
+                                       (.tuple (<>.exactly (list.size arg_decls) .any)))))
+        #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]]
+       (wrap (`' ((~ (code.text (format  ":" class_name ":" method_name ":" (text.join_with "," arg_decls'))))
+                  (~' _jvm_this) (~+ args))))))]
+
+  [make_special_method_parser "jvm invokespecial"]
+  [make_virtual_method_parser "jvm invokevirtual"]
+  )
+
+(def: (method->parser params class_name [[method_name _ _] meth_def])
+  (-> (List Type_Parameter) Text [Member_Declaration Method_Definition] (Parser Code))
+  (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 self_name args return_type return_expr exs)
+         (#OverridenMethod strict? owner_class type_vars self_name 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)))
+
+## Parsers
+(def: privacy_modifier^
+  (Parser PrivacyModifier)
+  (let [(^open ".") <>.monad]
+    ($_ <>.or
+        (.this! (' #public))
+        (.this! (' #private))
+        (.this! (' #protected))
+        (wrap []))))
+
+(def: inheritance_modifier^
+  (Parser InheritanceModifier)
+  (let [(^open ".") <>.monad]
+    ($_ <>.or
+        (.this! (' #final))
+        (.this! (' #abstract))
+        (wrap []))))
+
+(def: bound_kind^
+  (Parser BoundKind)
+  (<>.or (.this! (' <))
+         (.this! (' >))))
+
+(def: (assert_no_periods name)
+  (-> Text (Parser Any))
+  (<>.assert "Names in class declarations cannot contain periods."
+             (not (text.contains? "." name))))
+
+(def: (generic_type^ type_vars)
+  (-> (List Type_Parameter) (Parser GenericType))
+  (<>.rec
+   (function (_ recur^)
+     ($_ <>.either
+         (do <>.monad
+           [_ (.this! (' ?))]
+           (wrap (#GenericWildcard #.None)))
+         (.tuple (do <>.monad
+                         [_ (.this! (' ?))
+                          bound_kind bound_kind^
+                          bound recur^]
+                         (wrap (#GenericWildcard (#.Some [bound_kind bound])))))
+         (do <>.monad
+           [name .local_identifier
+            _ (assert_no_periods name)]
+           (if (list.member? text.equivalence (list\map product.left type_vars) name)
+             (wrap (#GenericTypeVar name))
+             (wrap (#GenericClass name (list)))))
+         (.tuple (do <>.monad
+                         [component recur^]
+                         (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)))))
+         (.form (do <>.monad
+                        [name .local_identifier
+                         _ (assert_no_periods name)
+                         params (<>.some recur^)
+                         _ (<>.assert (format name " cannot be a type-parameter!")
+                                      (not (list.member? text.equivalence (list\map product.left type_vars) name)))]
+                        (wrap (#GenericClass name params))))
+         ))))
+
+(def: type_param^
+  (Parser Type_Parameter)
+  (<>.either (do <>.monad
+               [param_name .local_identifier]
+               (wrap [param_name (list)]))
+             (.tuple (do <>.monad
+                             [param_name .local_identifier
+                              _ (.this! (' <))
+                              bounds (<>.many (..generic_type^ (list)))]
+                             (wrap [param_name bounds])))))
+
+(def: type_params^
+  (Parser (List Type_Parameter))
+  (|> ..type_param^
+      <>.some
+      .tuple
+      (<>.default (list))))
+
+(def: class_decl^
+  (Parser Class_Declaration)
+  (<>.either (do <>.monad
+               [name .local_identifier
+                _ (assert_no_periods name)]
+               (wrap [name (list)]))
+             (.form (do <>.monad
+                            [name .local_identifier
+                             _ (assert_no_periods name)
+                             params (<>.some ..type_param^)]
+                            (wrap [name params])))
+             ))
+
+(def: (super_class_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser Super_Class_Decl))
+  (<>.either (do <>.monad
+               [name .local_identifier
+                _ (assert_no_periods name)]
+               (wrap [name (list)]))
+             (.form (do <>.monad
+                            [name .local_identifier
+                             _ (assert_no_periods name)
+                             params (<>.some (..generic_type^ type_vars))]
+                            (wrap [name params])))))
+
+(def: annotation_params^
+  (Parser (List AnnotationParam))
+  (.record (<>.some (<>.and .local_tag .any))))
+
+(def: annotation^
+  (Parser Annotation)
+  (<>.either (do <>.monad
+               [ann_name .local_identifier]
+               (wrap [ann_name (list)]))
+             (.form (<>.and .local_identifier
+                                  annotation_params^))))
+
+(def: annotations^'
+  (Parser (List Annotation))
+  (do <>.monad
+    [_ (.this! (' #ann))]
+    (.tuple (<>.some ..annotation^))))
+
+(def: annotations^
+  (Parser (List Annotation))
+  (do <>.monad
+    [anns?? (<>.maybe ..annotations^')]
+    (wrap (maybe.default (list) anns??))))
+
+(def: (throws_decl'^ type_vars)
+  (-> (List Type_Parameter) (Parser (List GenericType)))
+  (do <>.monad
+    [_ (.this! (' #throws))]
+    (.tuple (<>.some (..generic_type^ type_vars)))))
+
+(def: (throws_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser (List GenericType)))
+  (do <>.monad
+    [exs? (<>.maybe (throws_decl'^ type_vars))]
+    (wrap (maybe.default (list) exs?))))
+
+(def: (method_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration MethodDecl]))
+  (.form (do <>.monad
+                 [tvars ..type_params^
+                  name .local_identifier
+                  anns ..annotations^
+                  inputs (.tuple (<>.some (..generic_type^ type_vars)))
+                  output (..generic_type^ type_vars)
+                  exs (..throws_decl^ type_vars)]
+                 (wrap [[name #PublicPM anns] {#method_tvars tvars
+                                               #method_inputs inputs
+                                               #method_output output
+                                               #method_exs    exs}]))))
+
+(def: state_modifier^
+  (Parser StateModifier)
+  ($_ <>.or
+      (.this! (' #volatile))
+      (.this! (' #final))
+      (\ <>.monad wrap [])))
+
+(def: (field_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl]))
+  (<>.either (.form (do <>.monad
+                            [_ (.this! (' #const))
+                             name .local_identifier
+                             anns ..annotations^
+                             type (..generic_type^ type_vars)
+                             body .any]
+                            (wrap [[name #PublicPM anns] (#ConstantField [type body])])))
+             (.form (do <>.monad
+                            [pm privacy_modifier^
+                             sm state_modifier^
+                             name .local_identifier
+                             anns ..annotations^
+                             type (..generic_type^ type_vars)]
+                            (wrap [[name pm anns] (#VariableField [sm type])])))))
+
+(def: (arg_decl^ type_vars)
+  (-> (List Type_Parameter) (Parser ArgDecl))
+  (.record (<>.and .local_identifier
+                         (..generic_type^ type_vars))))
+
+(def: (arg_decls^ type_vars)
+  (-> (List Type_Parameter) (Parser (List ArgDecl)))
+  (<>.some (arg_decl^ type_vars)))
+
+(def: (constructor_arg^ type_vars)
+  (-> (List Type_Parameter) (Parser ConstructorArg))
+  (.record (<>.and (..generic_type^ type_vars) .any)))
+
+(def: (constructor_args^ type_vars)
+  (-> (List Type_Parameter) (Parser (List ConstructorArg)))
+  (.tuple (<>.some (constructor_arg^ type_vars))))
+
+(def: (constructor_method^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  method_vars ..type_params^
+                  #let [total_vars (list\compose class_vars method_vars)]
+                  [_ arg_decls] (.form (<>.and (.this! (' new))
+                                                     (..arg_decls^ total_vars)))
+                  constructor_args (..constructor_args^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .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^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  final? (<>.parses? (.this! (' #final)))
+                  method_vars ..type_params^
+                  #let [total_vars (list\compose class_vars method_vars)]
+                  [name this_name arg_decls] (.form ($_ <>.and
+                                                              .local_identifier
+                                                              .local_identifier
+                                                              (..arg_decls^ total_vars)))
+                  return_type (..generic_type^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#VirtualMethod final? strict_fp?
+                                        method_vars
+                                        this_name arg_decls return_type
+                                        body exs)]))))
+
+(def: overriden_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [strict_fp? (<>.parses? (.this! (' #strict)))
+                  owner_class ..class_decl^
+                  method_vars ..type_params^
+                  #let [total_vars (list\compose (product.right owner_class) method_vars)]
+                  [name this_name arg_decls] (.form ($_ <>.and
+                                                              .local_identifier
+                                                              .local_identifier
+                                                              (..arg_decls^ total_vars)))
+                  return_type (..generic_type^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .any]
+                 (wrap [{#member_name name
+                         #member_privacy #PublicPM
+                         #member_anns annotations}
+                        (#OverridenMethod strict_fp?
+                                          owner_class method_vars
+                                          this_name arg_decls return_type
+                                          body exs)]))))
+
+(def: static_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  strict_fp? (<>.parses? (.this! (' #strict)))
+                  _ (.this! (' #static))
+                  method_vars ..type_params^
+                  #let [total_vars method_vars]
+                  [name arg_decls] (.form (<>.and .local_identifier
+                                                        (..arg_decls^ total_vars)))
+                  return_type (..generic_type^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^
+                  body .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^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  _ (.this! (' #abstract))
+                  method_vars ..type_params^
+                  #let [total_vars method_vars]
+                  [name arg_decls] (.form (<>.and .local_identifier
+                                                        (..arg_decls^ total_vars)))
+                  return_type (..generic_type^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#AbstractMethod method_vars arg_decls return_type exs)]))))
+
+(def: native_method_def^
+  (Parser [Member_Declaration Method_Definition])
+  (.form (do <>.monad
+                 [pm privacy_modifier^
+                  _ (.this! (' #native))
+                  method_vars ..type_params^
+                  #let [total_vars method_vars]
+                  [name arg_decls] (.form (<>.and .local_identifier
+                                                        (..arg_decls^ total_vars)))
+                  return_type (..generic_type^ total_vars)
+                  exs (..throws_decl^ total_vars)
+                  annotations ..annotations^]
+                 (wrap [{#member_name name
+                         #member_privacy pm
+                         #member_anns annotations}
+                        (#NativeMethod method_vars arg_decls return_type exs)]))))
+
+(def: (method_def^ class_vars)
+  (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition]))
+  ($_ <>.either
+      (..constructor_method^ class_vars)
+      (..virtual_method_def^ class_vars)
+      ..overriden_method_def^
+      ..static_method_def^
+      ..abstract_method_def^
+      ..native_method_def^))
+
+(def: partial_call^
+  (Parser Partial_Call)
+  (.form (<>.and .identifier (<>.some .any))))
+
+(def: class_kind^
+  (Parser Class_Kind)
+  (<>.either (do <>.monad
+               [_ (.this! (' #class))]
+               (wrap #Class))
+             (do <>.monad
+               [_ (.this! (' #interface))]
+               (wrap #Interface))
+             ))
+
+(def: import_member_alias^
+  (Parser (Maybe Text))
+  (<>.maybe (do <>.monad
+              [_ (.this! (' #as))]
+              .local_identifier)))
+
+(def: (import_member_args^ type_vars)
+  (-> (List Type_Parameter) (Parser (List [Bit GenericType])))
+  (.tuple (<>.some (<>.and (<>.parses? (.this! (' #?))) (..generic_type^ type_vars)))))
+
+(def: import_member_return_flags^
+  (Parser [Bit Bit Bit])
+  ($_ <>.and (<>.parses? (.this! (' #io))) (<>.parses? (.this! (' #try))) (<>.parses? (.this! (' #?)))))
+
+(def: primitive_mode^
+  (Parser Primitive_Mode)
+  (<>.or (.this! (' #manual))
+         (.this! (' #auto))))
+
+(def: (import_member_decl^ owner_vars)
+  (-> (List Type_Parameter) (Parser Import_Member_Declaration))
+  ($_ <>.either
+      (.form (do <>.monad
+                     [_ (.this! (' #enum))
+                      enum_members (<>.some .local_identifier)]
+                     (wrap (#EnumDecl enum_members))))
+      (.form (do <>.monad
+                     [tvars ..type_params^
+                      _ (.this! (' new))
+                      ?alias import_member_alias^
+                      #let [total_vars (list\compose owner_vars tvars)]
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      args (..import_member_args^ total_vars)
+                      [io? try? maybe?] import_member_return_flags^]
+                     (wrap (#ConstructorDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                               #import_member_alias   (maybe.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?}
+                                              {}]))
+                     ))
+      (.form (do <>.monad
+                     [kind (: (Parser ImportMethodKind)
+                              (<>.or (.this! (' #static))
+                                     (wrap [])))
+                      tvars ..type_params^
+                      name .local_identifier
+                      ?alias import_member_alias^
+                      #let [total_vars (list\compose owner_vars tvars)]
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      args (..import_member_args^ total_vars)
+                      [io? try? maybe?] import_member_return_flags^
+                      return (..generic_type^ total_vars)]
+                     (wrap (#MethodDecl [{#import_member_mode    (maybe.default #AutoPrM ?prim_mode)
+                                          #import_member_alias   (maybe.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
+                                          }]))))
+      (.form (do <>.monad
+                     [static? (<>.parses? (.this! (' #static)))
+                      name .local_identifier
+                      ?prim_mode (<>.maybe primitive_mode^)
+                      gtype (..generic_type^ owner_vars)
+                      maybe? (<>.parses? (.this! (' #?)))
+                      setter? (<>.parses? (.this! (' #!)))]
+                     (wrap (#FieldAccessDecl {#import_field_mode    (maybe.default #AutoPrM ?prim_mode)
+                                              #import_field_name    name
+                                              #import_field_static? static?
+                                              #import_field_maybe?  maybe?
+                                              #import_field_setter? setter?
+                                              #import_field_type    gtype}))))
+      ))
+
+(def: bundle
+  (-> (List Type_Parameter) (Parser [Text (List Import_Member_Declaration)]))
+  (|>> ..import_member_decl^
+       <>.some
+       (<>.and .text)
+       .tuple))
+
+## Generators
+(def: with_parens
+  (-> JVM_Code JVM_Code)
+  (text.enclose ["(" ")"]))
+
+(def: with_brackets
+  (-> JVM_Code JVM_Code)
+  (text.enclose ["[" "]"]))
+
+(def: spaced
+  (-> (List JVM_Code) JVM_Code)
+  (text.join_with " "))
+
+(def: (privacy_modifier$ pm)
+  (-> PrivacyModifier JVM_Code)
+  (case pm
+    #PublicPM    "public"
+    #PrivatePM   "private"
+    #ProtectedPM "protected"
+    #DefaultPM   "default"))
+
+(def: (inheritance_modifier$ im)
+  (-> InheritanceModifier JVM_Code)
+  (case im
+    #FinalIM    "final"
+    #AbstractIM "abstract"
+    #DefaultIM  "default"))
+
+(def: (annotation_param$ [name value])
+  (-> AnnotationParam JVM_Code)
+  (format name "=" (code.format value)))
+
+(def: (annotation$ [name params])
+  (-> Annotation JVM_Code)
+  (format "(" name " " "{" (text.join_with text.tab (list\map annotation_param$ params)) "}" ")"))
+
+(def: (bound_kind$ kind)
+  (-> BoundKind JVM_Code)
+  (case kind
+    #UpperBound "<"
+    #LowerBound ">"))
+
+(def: (generic_type$ gtype)
+  (-> GenericType JVM_Code)
+  (case gtype
+    (#GenericTypeVar name)
+    name
+
+    (#GenericClass name params)
+    (format "(" (sanitize name) " " (spaced (list\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])
+  (-> Type_Parameter JVM_Code)
+  (format "(" name " " (spaced (list\map generic_type$ bounds)) ")"))
+
+(def: (class_decl$ (^open "."))
+  (-> Class_Declaration JVM_Code)
+  (format "(" (sanitize class_name) " " (spaced (list\map type_param$ class_params)) ")"))
+
+(def: (super_class_decl$ (^slots [#super_class_name #super_class_params]))
+  (-> Super_Class_Decl JVM_Code)
+  (format "(" (sanitize super_class_name) " " (spaced (list\map generic_type$ super_class_params)) ")"))
+
+(def: (method_decl$ [[name pm anns] method_decl])
+  (-> [Member_Declaration MethodDecl] JVM_Code)
+  (let [(^slots [#method_tvars #method_inputs #method_output #method_exs]) method_decl]
+    (with_parens
+      (spaced (list name
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ method_tvars)))
+                    (with_brackets (spaced (list\map generic_type$ method_exs)))
+                    (with_brackets (spaced (list\map generic_type$ method_inputs)))
+                    (generic_type$ method_output))
+              ))))
+
+(def: (state_modifier$ sm)
+  (-> StateModifier JVM_Code)
+  (case sm
+    #VolatileSM "volatile"
+    #FinalSM    "final"
+    #DefaultSM  "default"))
+
+(def: (field_decl$ [[name pm anns] field])
+  (-> [Member_Declaration FieldDecl] JVM_Code)
+  (case field
+    (#ConstantField class value)
+    (with_parens
+      (spaced (list "constant" name
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (generic_type$ class)
+                    (code.format value))
+              ))
+
+    (#VariableField sm class)
+    (with_parens
+      (spaced (list "variable" name
+                    (privacy_modifier$ pm)
+                    (state_modifier$ sm)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (generic_type$ class))
+              ))
+    ))
+
+(def: (arg_decl$ [name type])
+  (-> ArgDecl JVM_Code)
+  (with_parens
+    (spaced (list name (generic_type$ type)))))
+
+(def: (constructor_arg$ [class term])
+  (-> ConstructorArg JVM_Code)
+  (with_brackets
+    (spaced (list (generic_type$ class) (code.format term)))))
+
+(def: (method_def$ replacer super_class [[name pm anns] method_def])
+  (-> (-> Code Code) Super_Class_Decl [Member_Declaration Method_Definition] JVM_Code)
+  (case method_def
+    (#ConstructorMethod strict_fp? type_vars arg_decls constructor_args body exs)
+    (with_parens
+      (spaced (list "init"
+                    (privacy_modifier$ pm)
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (with_brackets (spaced (list\map constructor_arg$ constructor_args)))
+                    (code.format (pre_walk_replace replacer body))
+                    )))
+    
+    (#VirtualMethod final? strict_fp? type_vars this_name arg_decls return_type body exs)
+    (with_parens
+      (spaced (list "virtual"
+                    name
+                    (privacy_modifier$ pm)
+                    (bit\encode final?)
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type)
+                    (code.format (pre_walk_replace replacer (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)]
+                                                                 (~ body))))))))
+    
+    (#OverridenMethod strict_fp? class_decl type_vars this_name arg_decls return_type body exs)
+    (let [super_replacer (parser->replacer (.form (do <>.monad
+                                                          [_ (.this! (' ::super!))
+                                                           args (.tuple (<>.exactly (list.size arg_decls) .any))
+                                                           #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list)))
+                                                                                                     arg_decls))]]
+                                                          (wrap (`' ((~ (code.text (format "jvm 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
+                      (bit\encode strict_fp?)
+                      (with_brackets (spaced (list\map annotation$ anns)))
+                      (with_brackets (spaced (list\map type_param$ type_vars)))
+                      (with_brackets (spaced (list\map generic_type$ exs)))
+                      (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                      (generic_type$ return_type)
+                      (|> (` (let [(~ (code.local_identifier this_name)) (~' _jvm_this)]
+                               (~ body)))
+                          (pre_walk_replace replacer)
+                          (pre_walk_replace super_replacer)
+                          (code.format))
+                      ))))
+
+    (#StaticMethod strict_fp? type_vars arg_decls return_type body exs)
+    (with_parens
+      (spaced (list "static"
+                    name
+                    (privacy_modifier$ pm)
+                    (bit\encode strict_fp?)
+                    (with_brackets (spaced (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type)
+                    (code.format (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 (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\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 (list\map annotation$ anns)))
+                    (with_brackets (spaced (list\map type_param$ type_vars)))
+                    (with_brackets (spaced (list\map generic_type$ exs)))
+                    (with_brackets (spaced (list\map arg_decl$ arg_decls)))
+                    (generic_type$ return_type))))
+    ))
+
+(def: (complete_call$ g!obj [method args])
+  (-> Code Partial_Call Code)
+  (` ((~ (code.identifier method)) (~+ args) (~ g!obj))))
+
+## [Syntax]
+(def: object_super_class
+  Super_Class_Decl
+  {#super_class_name   "java/lang/Object"
+   #super_class_params (list)})
+
+(syntax: #export (class:
+                   {im inheritance_modifier^}
+                   {class_decl ..class_decl^}
+                   {#let [full_class_name (product.left class_decl)]}
+                   {#let [class_vars (product.right class_decl)]}
+                   {super (<>.default object_super_class
+                                      (..super_class_decl^ class_vars))}
+                   {interfaces (<>.default (list)
+                                           (.tuple (<>.some (..super_class_decl^ class_vars))))}
+                   {annotations ..annotations^}
+                   {fields (<>.some (..field_decl^ class_vars))}
+                   {methods (<>.some (..method_def^ class_vars))})
+  {#.doc (doc "Allows defining JVM classes in Lux code."
+              "For example:"
+              (class: #final (TestClass A) [Runnable]
+                ## Fields
+                (#private foo boolean)
+                (#private bar A)
+                (#private baz java/lang/Object)
+                ## Methods
+                (#public [] (new [value A]) []
+                         (exec (:= ::foo #1)
+                           (:= ::bar value)
+                           (:= ::baz "")
+                           []))
+                (#public (virtual) java/lang/Object
+                         "")
+                (#public #static (static) java/lang/Object
+                         "")
+                (Runnable [] (run) void
+                          [])
+                )
+
+              "The tuple corresponds to parent interfaces."
+              "An optional super-class can be specified before the tuple. 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 #1) for modifying it."
+              "(::new! []) for calling the class's constructor."
+              "(::resolve! container [value]) for calling the 'resolve' method."
+              )}
+  (do meta.monad
+    [current_module meta.current_module_name
+     #let [fully_qualified_class_name (format (sanitize current_module) "." full_class_name)
+           field_parsers (list\map (field->parser fully_qualified_class_name) fields)
+           method_parsers (list\map (method->parser (product.right class_decl) fully_qualified_class_name) methods)
+           replacer (parser->replacer (list\fold <>.either
+                                                 (<>.fail "")
+                                                 (list\compose field_parsers method_parsers)))
+           def_code (format "jvm class:"
+                            (spaced (list (class_decl$ class_decl)
+                                          (super_class_decl$ super)
+                                          (with_brackets (spaced (list\map super_class_decl$ interfaces)))
+                                          (inheritance_modifier$ im)
+                                          (with_brackets (spaced (list\map annotation$ annotations)))
+                                          (with_brackets (spaced (list\map field_decl$ fields)))
+                                          (with_brackets (spaced (list\map (method_def$ replacer super) methods))))))]]
+    (wrap (list (` ((~ (code.text def_code))))))))
+
+(syntax: #export (interface:
+                   {class_decl ..class_decl^}
+                   {#let [class_vars (product.right class_decl)]}
+                   {supers (<>.default (list)
+                                       (.tuple (<>.some (..super_class_decl^ class_vars))))}
+                   {annotations ..annotations^}
+                   {members (<>.some (..method_decl^ class_vars))})
+  {#.doc (doc "Allows defining JVM interfaces."
+              (interface: TestInterface
+                ([] foo [boolean String] void #throws [Exception])))}
+  (let [def_code (format "jvm interface:"
+                         (spaced (list (class_decl$ class_decl)
+                                       (with_brackets (spaced (list\map super_class_decl$ supers)))
+                                       (with_brackets (spaced (list\map annotation$ annotations)))
+                                       (spaced (list\map method_decl$ members)))))]
+    (wrap (list (` ((~ (code.text def_code))))))
+    ))
+
+(syntax: #export (object
+                   {class_vars (.tuple (<>.some ..type_param^))}
+                   {super (<>.default object_super_class
+                                      (..super_class_decl^ class_vars))}
+                   {interfaces (<>.default (list)
+                                           (.tuple (<>.some (..super_class_decl^ class_vars))))}
+                   {constructor_args (..constructor_args^ class_vars)}
+                   {methods (<>.some ..overriden_method_def^)})
+  {#.doc (doc "Allows defining anonymous classes."
+              "The 1st tuple corresponds to class-level type-variables."
+              "The 2nd tuple corresponds to parent interfaces."
+              "The 3rd tuple corresponds to arguments to the super class constructor."
+              "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed."
+              (object [] [Runnable]
+                []
+                (Runnable [] (run self) void
+                          (exec (do_something some_value)
+                            [])))
+              )}
+  (let [def_code (format "jvm anon-class:"
+                         (spaced (list (super_class_decl$ super)
+                                       (with_brackets (spaced (list\map super_class_decl$ interfaces)))
+                                       (with_brackets (spaced (list\map constructor_arg$ constructor_args)))
+                                       (with_brackets (spaced (list\map (method_def$ function.identity super) methods))))))]
+    (wrap (list (` ((~ (code.text def_code))))))))
+
+(syntax: #export (null)
+  {#.doc (doc "Null object reference."
+              (null))}
+  (wrap (list (` ("jvm object null")))))
+
+(def: #export (null? obj)
+  {#.doc (doc "Test for null object reference."
+              (= (null? (null))
+                 true)
+              (= (null? "YOLO")
+                 false))}
+  (-> (primitive "java.lang.Object") Bit)
+  ("jvm object null?" obj))
+
+(syntax: #export (??? expr)
+  {#.doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it."
+              (= (??? (: java/lang/String (null)))
+                 #.None)
+              (= (??? "YOLO")
+                 (#.Some "YOLO")))}
+  (with_gensyms [g!temp]
+    (wrap (list (` (let [(~ g!temp) (~ expr)]
+                     (if ("jvm object null?" (~ g!temp))
+                       #.None
+                       (#.Some (~ g!temp)))))))))
+
+(syntax: #export (!!! expr)
+  {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
+              "A #.None would get translated into a (null)."
+              (= (null)
+                 (!!! (??? (: java/lang/Thread (null)))))
+              (= "foo"
+                 (!!! (??? "foo"))))}
+  (with_gensyms [g!value]
+    (wrap (list (` ({(#.Some (~ g!value))
+                     (~ g!value)
+
+                     #.None
+                     ("jvm object null")}
+                    (~ expr)))))))
+
+(syntax: #export (check {class (..generic_type^ (list))}
+                        {unchecked (<>.maybe .any)})
+  {#.doc (doc "Checks whether an object is an instance of a particular class."
+              "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes."
+              (case (check java/lang/String "YOLO")
+                (#.Some value_as_string)
+                #.None))}
+  (with_gensyms [g!_ g!unchecked]
+    (let [class_name (simple_class$ (list) class)
+          class_type (` (.primitive (~ (code.text class_name))))
+          check_type (` (.Maybe (~ class_type)))
+          check_code (` (if ((~ (code.text (format "jvm instanceof" ":" class_name))) (~ g!unchecked))
+                          (#.Some (.:as (~ class_type)
+                                        (~ g!unchecked)))
+                          #.None))]
+      (case unchecked
+        (#.Some unchecked)
+        (wrap (list (` (: (~ check_type)
+                          (let [(~ g!unchecked) (~ unchecked)]
+                            (~ check_code))))))
+
+        #.None
+        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type))
+                          (function ((~ g!_) (~ g!unchecked))
+                            (~ check_code))))))
+        ))))
+
+(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 (` ("jvm object synchronized" (~ lock) (~ body))))))
+
+(syntax: #export (do_to obj {methods (<>.some partial_call^)})
+  {#.doc (doc "Call a variety of methods on an object. Then, return the object."
+              (do_to object
+                (ClassName::method1 arg0 arg1 arg2)
+                (ClassName::method2 arg3 arg4 arg5)))}
+  (with_gensyms [g!obj]
+    (wrap (list (` (let [(~ g!obj) (~ obj)]
+                     (exec (~+ (list\map (complete_call$ g!obj) methods))
+                       (~ g!obj))))))))
+
+(def: (class_import$ [full_name params])
+  (-> Class_Declaration Code)
+  (let [params' (list\map (|>> product.left code.local_identifier) params)]
+    (` (def: (~ (code.identifier ["" full_name]))
+         {#..jvm_class (~ (code.text full_name))}
+         Type
+         (All [(~+ params')]
+           (primitive (~ (code.text (sanitize full_name)))
+                      [(~+ params')]))))))
+
+(def: (member_type_vars class_tvars member)
+  (-> (List Type_Parameter) Import_Member_Declaration (List Type_Parameter))
+  (case member
+    (#ConstructorDecl [commons _])
+    (list\compose class_tvars (get@ #import_member_tvars commons))
+
+    (#MethodDecl [commons _])
+    (case (get@ #import_member_kind commons)
+      #StaticIMK
+      (get@ #import_member_tvars commons)
+
+      _
+      (list\compose class_tvars (get@ #import_member_tvars commons)))
+
+    _
+    class_tvars))
+
+(def: (member_def_arg_bindings type_params class member)
+  (-> (List Type_Parameter) Class_Declaration Import_Member_Declaration (Meta [(List [Bit Code]) (List Text) (List Code)]))
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (let [(^slots [#import_member_tvars #import_member_args]) commons]
+      (do {! meta.monad}
+        [arg_inputs (monad.map !
+                               (: (-> [Bit GenericType] (Meta [Bit Code]))
+                                  (function (_ [maybe? _])
+                                    (with_gensyms [arg_name]
+                                      (wrap [maybe? arg_name]))))
+                               import_member_args)
+         #let [arg_classes (: (List Text)
+                              (list\map (|>> product.right (simple_class$ (list\compose type_params import_member_tvars)))
+                                        import_member_args))
+               arg_types (list\map (: (-> [Bit GenericType] Code)
+                                      (function (_ [maybe? arg])
+                                        (let [arg_type (class_to_type (get@ #import_member_mode commons) type_params arg)]
+                                          (if maybe?
+                                            (` (Maybe (~ arg_type)))
+                                            arg_type))))
+                                   import_member_args)]]
+        (wrap [arg_inputs arg_classes arg_types])))
+
+    _
+    (\ meta.monad wrap [(list) (list) (list)])))
+
+(def: (decorate_return_maybe class member return_term)
+  (-> Class_Declaration Import_Member_Declaration Code Code)
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (if (get@ #import_member_maybe? commons)
+      (` (??? (~ return_term)))
+      (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
+        (` (let [(~ g!temp) (~ return_term)]
+             (if (not (..null? (:as (primitive "java.lang.Object")
+                                    (~ g!temp))))
+               (~ g!temp)
+               (error! (~ (code.text (format "Cannot produce null references from method calls @ "
+                                             (get@ #class_name class)
+                                             "." (get@ #import_member_alias commons))))))))))
+
+    _
+    return_term))
+
+(template [  ]
+  [(def: ( member return_term)
+     (-> Import_Member_Declaration Code Code)
+     (case member
+       (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+       (if (get@  commons)
+         
+         return_term)
+
+       _
+       return_term))]
+
+  [decorate_return_try #import_member_try? (` (.try (~ return_term)))]
+  [decorate_return_io  #import_member_io?  (` ((~! io.io) (~ return_term)))]
+  )
+
+(def: (free_type_param? [name bounds])
+  (-> Type_Parameter Bit)
+  (case bounds
+    #.Nil #1
+    _     #0))
+
+(def: (type_param->type_arg [name _])
+  (-> Type_Parameter Code)
+  (code.identifier ["" name]))
+
+(template [    ]
+  [(def: ( mode [class expression])
+     (-> Primitive_Mode [Text Code] Code)
+     (case mode
+       #ManualPrM
+       expression
+       
+       #AutoPrM
+       (case class
+         "byte"  (` ( (~ expression)))
+         "short" (` ( (~ expression)))
+         "int"   (` ( (~ expression)))
+         "float" (` ( (~ expression)))
+         _       expression)))]
+
+  [auto_convert_input  long_to_byte long_to_short long_to_int double_to_float]
+  [auto_convert_output byte_to_long short_to_long int_to_long float_to_double]
+  )
+
+(def: (un_quote quoted)
+  (-> Code Code)
+  (` ((~' ~) (~ quoted))))
+
+(def: (jvm_extension_inputs mode classes inputs)
+  (-> Primitive_Mode (List Text) (List [Bit Code]) (List Code))
+  (|> inputs
+      (list\map (function (_ [maybe? input])
+                  (if maybe?
+                    (` ((~! !!!) (~ (un_quote input))))
+                    (un_quote input))))
+      (list.zip/2 classes)
+      (list\map (auto_convert_input mode))))
+
+(def: (import_name format class member)
+  (-> Text Text Text Text)
+  (|> format
+      (text.replace_all "#" class)
+      (text.replace_all "." member)))
+
+(def: (member_def_interop type_params kind class [arg_function_inputs arg_classes arg_types] member method_prefix import_format)
+  (-> (List Type_Parameter) Class_Kind Class_Declaration [(List [Bit Code]) (List Text) (List Code)] Import_Member_Declaration Text Text (Meta (List Code)))
+  (let [[full_name class_tvars] class
+        full_name (sanitize full_name)
+        all_params (|> (member_type_vars class_tvars member)
+                       (list.filter free_type_param?)
+                       (list\map type_param->type_arg))]
+    (case member
+      (#EnumDecl enum_members)
+      (do {! meta.monad}
+        [#let [enum_type (: Code
+                            (case class_tvars
+                              #.Nil
+                              (` (primitive (~ (code.text full_name))))
+
+                              _
+                              (let [=class_tvars (|> class_tvars
+                                                     (list.filter free_type_param?)
+                                                     (list\map type_param->type_arg))]
+                                (` (All [(~+ =class_tvars)] (primitive (~ (code.text full_name)) [(~+ =class_tvars)]))))))
+               getter_interop (: (-> Text Code)
+                                 (function (_ name)
+                                   (let [getter_name (code.identifier ["" (..import_name import_format method_prefix name)])]
+                                     (` (def: (~ getter_name)
+                                          (~ enum_type)
+                                          ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]]
+        (wrap (list\map getter_interop enum_members)))
+      
+      (#ConstructorDecl [commons _])
+      (do meta.monad
+        [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+               jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes)))
+               jvm_interop (|> (` ((~ jvm_extension)
+                                   (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))
+                               (decorate_return_maybe class member)
+                               (decorate_return_try member)
+                               (decorate_return_io member))]]
+        (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)))
+                        ((~' wrap) (.list (.` (~ jvm_interop)))))))))
+
+      (#MethodDecl [commons method])
+      (with_gensyms [g!obj]
+        (do meta.monad
+          [#let [def_name (code.identifier ["" (..import_name import_format method_prefix (get@ #import_member_alias commons))])
+                 (^slots [#import_member_kind]) commons
+                 (^slots [#import_method_name]) method
+                 [jvm_op object_ast] (: [Text (List Code)]
+                                        (case import_member_kind
+                                          #StaticIMK
+                                          ["invokestatic"
+                                           (list)]
+
+                                          #VirtualIMK
+                                          (case kind
+                                            #Class
+                                            ["invokevirtual"
+                                             (list g!obj)]
+                                            
+                                            #Interface
+                                            ["invokeinterface"
+                                             (list g!obj)]
+                                            )))
+                 jvm_extension (code.text (format "jvm " jvm_op ":" full_name ":" import_method_name ":" (text.join_with "," arg_classes)))
+                 jvm_interop (|> [(simple_class$ (list) (get@ #import_method_return method))
+                                  (` ((~ jvm_extension) (~+ (list\map un_quote object_ast))
+                                      (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))]
+                                 (auto_convert_output (get@ #import_member_mode commons))
+                                 (decorate_return_maybe class member)
+                                 (decorate_return_try member)
+                                 (decorate_return_io member))]]
+          (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast))
+                          ((~' wrap) (.list (.` (~ jvm_interop))))))))))
+
+      (#FieldAccessDecl fad)
+      (do meta.monad
+        [#let [(^open ".") fad
+               base_gtype (class_to_type import_field_mode type_params import_field_type)
+               classC (class_decl_type$ class)
+               typeC (if import_field_maybe?
+                       (` (Maybe (~ base_gtype)))
+                       base_gtype)
+               tvar_asts (: (List Code)
+                            (|> class_tvars
+                                (list.filter free_type_param?)
+                                (list\map type_param->type_arg)))
+               getter_name (code.identifier ["" (..import_name import_format method_prefix import_field_name)])
+               setter_name (code.identifier ["" (..import_name import_format method_prefix (format import_field_name "!"))])]
+         getter_interop (with_gensyms [g!obj]
+                          (let [getter_call (if import_field_static?
+                                              (` ((~ getter_name)))
+                                              (` ((~ getter_name) (~ g!obj))))
+                                getter_body (<| (auto_convert_output import_field_mode)
+                                                [(simple_class$ (list) import_field_type)
+                                                 (if import_field_static?
+                                                   (let [jvm_extension (code.text (format "jvm getstatic" ":" full_name ":" import_field_name))]
+                                                     (` ((~ jvm_extension))))
+                                                   (let [jvm_extension (code.text (format "jvm getfield" ":" full_name ":" import_field_name))]
+                                                     (` ((~ jvm_extension) (~ (un_quote g!obj))))))])
+                                getter_body (if import_field_maybe?
+                                              (` ((~! ???) (~ getter_body)))
+                                              getter_body)
+                                getter_body (if import_field_setter?
+                                              (` ((~! io.io) (~ getter_body)))
+                                              getter_body)]
+                            (wrap (` ((~! syntax:) (~ getter_call)
+                                      ((~' wrap) (.list (.` (~ getter_body)))))))))
+         setter_interop (: (Meta (List Code))
+                           (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_value (auto_convert_input import_field_mode
+                                                                      [(simple_class$ (list) import_field_type) (un_quote g!value)])
+                                     setter_value (if import_field_maybe?
+                                                    (` ((~! !!!) (~ setter_value)))
+                                                    setter_value)
+                                     setter_command (format (if import_field_static? "jvm putstatic" "jvm putfield")
+                                                            ":" full_name ":" import_field_name)
+                                     g!obj+ (: (List Code)
+                                               (if import_field_static?
+                                                 (list)
+                                                 (list (un_quote g!obj))))]
+                                 (wrap (list (` ((~! syntax:) (~ setter_call)
+                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value))))))))))))
+                             (wrap (list))))]
+        (wrap (list& getter_interop setter_interop)))
+      )))
+
+(def: (member_import$ type_params kind class [import_format member])
+  (-> (List Type_Parameter) Class_Kind Class_Declaration [Text Import_Member_Declaration] (Meta (List Code)))
+  (let [[method_prefix _] class]
+    (do meta.monad
+      [=args (member_def_arg_bindings type_params class member)]
+      (member_def_interop type_params kind class =args member method_prefix import_format))))
+
+(type: (java/lang/Class a)
+  (primitive "java.lang.Class" [a]))
+
+(def: interface?
+  (All [a] (-> (java/lang/Class a) Bit))
+  (|>> "jvm invokevirtual:java.lang.Class:isInterface:"))
+
+(def: (load_class class_name)
+  (-> Text (Try (java/lang/Class Any)))
+  (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class_name)))
+
+(def: (class_kind [class_name _])
+  (-> Class_Declaration (Meta Class_Kind))
+  (let [class_name (..sanitize class_name)]
+    (case (..load_class class_name)
+      (#try.Success class)
+      (\ meta.monad wrap (if (interface? class)
+                           #Interface
+                           #Class))
+
+      (#try.Failure error)
+      (meta.fail (format "Cannot load class: " class_name text.new_line
+                         error)))))
+
+(syntax: #export (import:
+                   {class_decl ..class_decl^}
+                   {bundles (<>.some (..bundle (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."
+              (import: java/lang/Object
+                ["#::."
+                 (new [])
+                 (equals [java/lang/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 Try 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)."
+              (import: java/lang/String
+                ["#::."
+                 (new [[byte]])
+                 (#static valueOf [char] java/lang/String)
+                 (#static valueOf #as int_valueOf [int] java/lang/String)])
+
+              (import: (java/util/List e)
+                ["#::."
+                 (size [] int)
+                 (get [int] e)])
+
+              (import: (java/util/ArrayList a)
+                ["#::."
+                 ([T] toArray [[T]] [T])])
+              
+              "The class-type that is generated is of the fully-qualified name."
+              "This avoids a clash between the java.util.List type, and Lux's own List type."
+              "All enum options to be imported must be specified."
+              (import: java/lang/Character$UnicodeScript
+                ["#::."
+                 (#enum ARABIC CYRILLIC LATIN)])
+
+              "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 cannot be named (otherwise, they'd be confused for Java classes)."
+              (import: (lux/concurrency/promise/JvmPromise A)
+                ["#::."
+                 (resolve [A] boolean)
+                 (poll [] A)
+                 (wasResolved [] boolean)
+                 (waitOn [lux/Function] void)
+                 (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))])
+              
+              "Also, the names of the imported members will look like Class::member"
+              (java/lang/Object::new [])
+              (java/lang/Object::equals [other_object] my_object)
+              (java/util/List::size [] my_list)
+              java/lang/Character$UnicodeScript::LATIN
+              )}
+  (do {! meta.monad}
+    [kind (class_kind class_decl)
+     =members (|> bundles
+                  (list\map (function (_ [import_format members])
+                              (list\map (|>> [import_format]) members)))
+                  list.concat
+                  (monad.map ! (member_import$ (product.right class_decl) kind class_decl)))]
+    (wrap (list& (class_import$ class_decl) (list\join =members)))))
+
+(syntax: #export (array {type (..generic_type^ (list))}
+                        size)
+  {#.doc (doc "Create an array of the given type, with the given size."
+              (array java/lang/Object 10))}
+  (case type
+    (^template [ ]
+      [(^ (#GenericClass  (list)))
+       (wrap (list (` ( (~ size)))))])
+    (["boolean" "jvm znewarray"]
+     ["byte"    "jvm bnewarray"]
+     ["short"   "jvm snewarray"]
+     ["int"     "jvm inewarray"]
+     ["long"    "jvm lnewarray"]
+     ["float"   "jvm fnewarray"]
+     ["double"  "jvm dnewarray"]
+     ["char"    "jvm cnewarray"])
+
+    _
+    (wrap (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size)))))))
+
+(syntax: #export (array_length array)
+  {#.doc (doc "Gives the length of an array."
+              (array_length my_array))}
+  (wrap (list (` ("jvm arraylength" (~ array))))))
+
+(def: (type->class_name type)
+  (-> Type (Meta Text))
+  (if (type\= Any type)
+    (\ meta.monad wrap "java.lang.Object")
+    (case type
+      (#.Primitive name params)
+      (\ meta.monad wrap name)
+
+      (#.Apply A F)
+      (case (type.apply (list A) F)
+        #.None
+        (meta.fail (format "Cannot apply type: " (type.format F) " to " (type.format A)))
+
+        (#.Some type')
+        (type->class_name type'))
+      
+      (#.Named _ type')
+      (type->class_name type')
+
+      _
+      (meta.fail (format "Cannot convert to JvmType: " (type.format type))))))
+
+(syntax: #export (array_read idx array)
+  {#.doc (doc "Loads an element from an array."
+              (array_read 10 my_array))}
+  (case array
+    [_ (#.Identifier array_name)]
+    (do meta.monad
+      [array_type (meta.find_type array_name)
+       array_jvm_type (type->class_name array_type)]
+      (case array_jvm_type
+        (^template [ ]
+          [
+           (wrap (list (` ( (~ array) (~ idx)))))])
+        (["[Z" "jvm zaload"]
+         ["[B" "jvm baload"]
+         ["[S" "jvm saload"]
+         ["[I" "jvm iaload"]
+         ["[J" "jvm jaload"]
+         ["[F" "jvm faload"]
+         ["[D" "jvm daload"]
+         ["[C" "jvm caload"])
+
+        _
+        (wrap (list (` ("jvm aaload" (~ array) (~ idx)))))))
+
+    _
+    (with_gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (..array_read (~ idx) (~ g!array)))))))))
+
+(syntax: #export (array_write idx value array)
+  {#.doc (doc "Stores an element into an array."
+              (array_write 10 my_object my_array))}
+  (case array
+    [_ (#.Identifier array_name)]
+    (do meta.monad
+      [array_type (meta.find_type array_name)
+       array_jvm_type (type->class_name array_type)]
+      (case array_jvm_type
+        (^template [ ]
+          [
+           (wrap (list (` ( (~ array) (~ idx) (~ value)))))])
+        (["[Z" "jvm zastore"]
+         ["[B" "jvm bastore"]
+         ["[S" "jvm sastore"]
+         ["[I" "jvm iastore"]
+         ["[J" "jvm jastore"]
+         ["[F" "jvm fastore"]
+         ["[D" "jvm dastore"]
+         ["[C" "jvm castore"])
+
+        _
+        (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value)))))))
+
+    _
+    (with_gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (..array_write (~ idx) (~ value) (~ g!array)))))))))
+
+(syntax: #export (class_for {type (..generic_type^ (list))})
+  {#.doc (doc "Loads the class as a java.lang.Class object."
+              (class_for java/lang/String))}
+  (wrap (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type))))))))
+
+(syntax: #export (type {type (..generic_type^ (list))})
+  (wrap (list (..class_to_type #ManualPrM (list) type))))
diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux
new file mode 100644
index 000000000..eb9b5fbed
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.php.lux
@@ -0,0 +1,314 @@
+(.module:
+  [library
+   [lux (#- Alias)
+    ["." meta]
+    ["@" target]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract: #export  Any)
+     (type: #export 
+       (..Object )))]
+
+  [Null]
+  [Function]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Integer Int]
+  [Float   Frac]
+  [String  Text]
+  )
+
+(type: Nullable
+  [Bit Code])
+
+(def: nullable
+  (Parser Nullable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Alias
+  Text)
+
+(def: alias
+  (Parser Alias)
+  (<>.after (.this! (' #as)) .local_identifier))
+
+(type: Field
+  [Bit Text (Maybe Alias) Nullable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nullable)))
+
+(def: constant
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>\wrap true)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nullable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Alias)
+   #inputs (List Nullable)
+   #io? Bit
+   #try? Bit
+   #output Nullable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+  (#Static Static_Method)
+  (#Virtual Virtual_Method))
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe ..alias)
+      (.tuple (<>.some ..nullable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..nullable))
+
+(def: static_method
+  (<>.after ..static! ..common_method))
+
+(def: method
+  (Parser Method)
+  (.form (<>.or ..static_method
+                      ..common_method)))
+
+(type: Member
+  (#Field Field)
+  (#Method Method))
+
+(def: member
+  (Parser Member)
+  ($_ <>.or
+      ..field
+      ..method
+      ))
+
+(def: input_variables
+  (-> (List Nullable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [nullable? type]])
+                   [nullable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nullable_type [nullable? type])
+  (-> Nullable Code)
+  (if nullable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_null g!temp [nullable? input])
+  (-> Code [Bit Code] Code)
+  (if nullable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.Null
+         ("php object null")))
+    input))
+
+(def: (without_null g!temp [nullable? outputT] output)
+  (-> Code Nullable Code Code)
+  (if nullable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("php object null?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("php object null?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "Null is an invalid value!"))))))
+
+(type: Import
+  (#Class Text (Maybe Alias) Text (List Member))
+  (#Function Static_Method)
+  (#Constant Field))
+
+(def: import
+  (Parser Import)
+  ($_ <>.or
+      ($_ <>.and
+          .local_identifier
+          (<>.maybe ..alias)
+          (<>.default ["" (list)]
+                      (.tuple (<>.and .text
+                                            (<>.some member)))))
+      (.form ..common_method)
+      ..constant
+      ))
+
+(syntax: #export (try expression)
+  {#.doc (doc (case (try (risky_computation input))
+                (#.Right success)
+                (do_something success)
+
+                (#.Left error)
+                (recover_from_failure error)))}
+  (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (..try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Code (List Nullable) Bit Bit Nullable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map nullable_type inputsT))]
+             (~ (|> (nullable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_null g!temp outputT)
+                 (` ("php apply"
+                     (:as ..Function (~ source))
+                     (~+ (list\map (with_null g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Class [class alias format members])
+      (with_gensyms [g!object]
+        (let [qualify (: (-> Text Code)
+                         (function (_ member_name)
+                           (|> format
+                               (text.replace_all "#" (maybe.default class alias))
+                               (text.replace_all "." member_name)
+                               code.local_identifier)))
+              g!type (code.local_identifier (maybe.default class alias))
+              class_import (` ("php constant" (~ (code.text class))))]
+          (wrap (list& (` (type: (~ g!type)
+                            (..Object (primitive (~ (code.text class))))))
+                       (list\map (function (_ member)
+                                   (case member
+                                     (#Field [static? field alias fieldT])
+                                     (if static?
+                                       (` ((~! syntax:) ((~ (qualify (maybe.default field alias))))
+                                           (\ (~! meta.monad) (~' wrap)
+                                              (list (` (.:as (~ (nullable_type fieldT))
+                                                             ("php constant" (~ (code.text (%.format class "::" field))))))))))
+                                       (` (def: ((~ (qualify field))
+                                                 (~ g!object))
+                                            (-> (~ g!type)
+                                                (~ (nullable_type fieldT)))
+                                            (:assume
+                                             (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field))
+                                                                                (:as (..Object .Any) (~ g!object))))))))))
+                                     
+                                     (#Method method)
+                                     (case method
+                                       (#Static [method alias inputsT io? try? outputT])
+                                       (..make_function (qualify (maybe.default method alias))
+                                                        g!temp
+                                                        (` ("php object get" (~ (code.text method))
+                                                            (:as (..Object .Any)
+                                                                 ("php constant" (~ (code.text (%.format class "::" method)))))))
+                                                        inputsT
+                                                        io?
+                                                        try?
+                                                        outputT)
+                                       
+                                       (#Virtual [method alias inputsT io? try? outputT])
+                                       (let [g!inputs (input_variables inputsT)]
+                                         (` (def: ((~ (qualify (maybe.default method alias)))
+                                                   [(~+ (list\map product.right g!inputs))]
+                                                   (~ g!object))
+                                              (-> [(~+ (list\map nullable_type inputsT))]
+                                                  (~ g!type)
+                                                  (~ (|> (nullable_type outputT)
+                                                         (try_type try?)
+                                                         (io_type io?))))
+                                              (:assume
+                                               (~ (<| (with_io io?)
+                                                      (with_try try?)
+                                                      (without_null g!temp outputT)
+                                                      (` ("php object do"
+                                                          (~ (code.text method))
+                                                          (~ g!object)
+                                                          (~+ (list\map (with_null g!temp) g!inputs)))))))))))))
+                                 members)))))
+      
+      (#Function [name alias inputsT io? try? outputT])
+      (let [imported (` ("php constant" (~ (code.text name))))]
+        (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                     g!temp
+                                     imported
+                                     inputsT
+                                     io?
+                                     try?
+                                     outputT))))
+
+      (#Constant [_ name alias fieldT])
+      (let [imported (` ("php constant" (~ (code.text name))))]
+        (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias))))
+                        (\ (~! meta.monad) (~' wrap)
+                           (list (` (.:as (~ (nullable_type fieldT)) (~ imported))))))))))
+      )))
diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux
new file mode 100644
index 000000000..737cfefd8
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.py.lux
@@ -0,0 +1,315 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    ["@" target]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract:  Any)
+     (type: #export 
+       (..Object )))]
+
+  [None]
+  [Dict]
+  [Function]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Integer Int]
+  [Float   Frac]
+  [String  Text]
+  )
+
+(type: Noneable
+  [Bit Code])
+
+(def: noneable
+  (Parser Noneable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Constructor
+  (List Noneable))
+
+(def: constructor
+  (Parser Constructor)
+  (.form (<>.after (.this! (' new))
+                         (.tuple (<>.some ..noneable)))))
+
+(type: Field
+  [Bit Text Noneable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   ..noneable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Text)
+   #inputs (List Noneable)
+   #io? Bit
+   #try? Bit
+   #output Noneable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+  (#Static Static_Method)
+  (#Virtual Virtual_Method))
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe (<>.after (.this! (' #as)) .local_identifier))
+      (.tuple (<>.some ..noneable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..noneable))
+
+(def: static_method
+  (<>.after ..static! ..common_method))
+
+(def: method
+  (Parser Method)
+  (.form (<>.or ..static_method
+                      ..common_method)))
+
+(type: Member
+  (#Constructor Constructor)
+  (#Field Field)
+  (#Method Method))
+
+(def: member
+  (Parser Member)
+  ($_ <>.or
+      ..constructor
+      ..field
+      ..method
+      ))
+
+(def: input_variables
+  (-> (List Noneable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [noneable? type]])
+                   [noneable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (noneable_type [noneable? type])
+  (-> Noneable Code)
+  (if noneable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_none g!temp [noneable? input])
+  (-> Code [Bit Code] Code)
+  (if noneable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.None
+         ("python object none")))
+    input))
+
+(def: (without_none g!temp [noneable? outputT] output)
+  (-> Code Noneable Code Code)
+  (if noneable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("python object none?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("python object none?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "None is an invalid value!"))))))
+
+(type: Import
+  (#Class [Text Text (List Member)])
+  (#Function Static_Method))
+
+(def: import
+  (Parser Import)
+  (<>.or (<>.and .local_identifier
+                 (<>.default ["" (list)]
+                             (.tuple (<>.and .text
+                                                   (<>.some member)))))
+         (.form ..common_method)))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (.try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Code (List Noneable) Bit Bit Noneable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map noneable_type inputsT))]
+             (~ (|> (noneable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_none g!temp outputT)
+                 (` ("python apply"
+                     (:as ..Function (~ source))
+                     (~+ (list\map (with_none g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Class [class format members])
+      (with_gensyms [g!object]
+        (let [qualify (: (-> Text Code)
+                         (function (_ member_name)
+                           (|> format
+                               (text.replace_all "#" class)
+                               (text.replace_all "." member_name)
+                               code.local_identifier)))
+              g!type (code.local_identifier class)
+              real_class (text.replace_all "/" "." class)
+              imported (case (text.split_all_with "/" class)
+                         (#.Cons head tail)
+                         (list\fold (function (_ sub super)
+                                      (` ("python object get" (~ (code.text sub))
+                                          (:as (..Object .Any) (~ super)))))
+                                    (` ("python import" (~ (code.text head))))
+                                    tail)
+                         
+                         #.Nil
+                         (` ("python import" (~ (code.text class)))))]
+          (wrap (list& (` (type: (~ g!type)
+                            (..Object (primitive (~ (code.text real_class))))))
+                       (list\map (function (_ member)
+                                   (case member
+                                     (#Constructor inputsT)
+                                     (let [g!inputs (input_variables inputsT)]
+                                       (` (def: ((~ (qualify "new"))
+                                                 [(~+ (list\map product.right g!inputs))])
+                                            (-> [(~+ (list\map noneable_type inputsT))]
+                                                (~ g!type))
+                                            (:assume
+                                             ("python apply"
+                                              (:as ..Function (~ imported))
+                                              (~+ (list\map (with_none g!temp) g!inputs)))))))
+                                     
+                                     (#Field [static? field fieldT])
+                                     (if static?
+                                       (` ((~! syntax:) ((~ (qualify field)))
+                                           (\ (~! meta.monad) (~' wrap)
+                                              (list (` (.:as (~ (noneable_type fieldT))
+                                                             ("python object get" (~ (code.text field))
+                                                              (:as (..Object .Any) (~ imported)))))))))
+                                       (` (def: ((~ (qualify field))
+                                                 (~ g!object))
+                                            (-> (~ g!type)
+                                                (~ (noneable_type fieldT)))
+                                            (:assume
+                                             (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field))
+                                                                                (:as (..Object .Any) (~ g!object))))))))))
+                                     
+                                     (#Method method)
+                                     (case method
+                                       (#Static [method alias inputsT io? try? outputT])
+                                       (..make_function (qualify (maybe.default method alias))
+                                                        g!temp
+                                                        (` ("python object get" (~ (code.text method))
+                                                            (:as (..Object .Any) (~ imported))))
+                                                        inputsT
+                                                        io?
+                                                        try?
+                                                        outputT)
+                                       
+                                       (#Virtual [method alias inputsT io? try? outputT])
+                                       (let [g!inputs (input_variables inputsT)]
+                                         (` (def: ((~ (qualify (maybe.default method alias)))
+                                                   [(~+ (list\map product.right g!inputs))]
+                                                   (~ g!object))
+                                              (-> [(~+ (list\map noneable_type inputsT))]
+                                                  (~ g!type)
+                                                  (~ (|> (noneable_type outputT)
+                                                         (try_type try?)
+                                                         (io_type io?))))
+                                              (:assume
+                                               (~ (<| (with_io io?)
+                                                      (with_try try?)
+                                                      (without_none g!temp outputT)
+                                                      (` ("python object do"
+                                                          (~ (code.text method))
+                                                          (~ g!object)
+                                                          (~+ (list\map (with_none g!temp) g!inputs)))))))))))))
+                                 members)))))
+      
+      (#Function [name alias inputsT io? try? outputT])
+      (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                   g!temp
+                                   (` ("python constant" (~ (code.text name))))
+                                   inputsT
+                                   io?
+                                   try?
+                                   outputT)))
+      )))
+
+(template: #export (lambda  )
+  (.:as ..Function
+        (`` ("python function"
+             (~~ (template.count ))
+             (.function (_ [])
+               )))))
diff --git a/stdlib/source/library/lux/ffi.rb.lux b/stdlib/source/library/lux/ffi.rb.lux
new file mode 100644
index 000000000..511351bad
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.rb.lux
@@ -0,0 +1,332 @@
+(.module:
+  [library
+   [lux (#- Alias)
+    ["@" target]
+    ["." meta]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract: #export  Any)
+     (type: #export 
+       (..Object )))]
+
+  [Nil]
+  [Function]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Integer Int]
+  [Float   Frac]
+  [String  Text]
+  )
+
+(type: Nilable
+  [Bit Code])
+
+(def: nilable
+  (Parser Nilable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Alias
+  Text)
+
+(def: alias
+  (Parser Alias)
+  (<>.after (.this! (' #as)) .local_identifier))
+
+(type: Field
+  [Bit Text (Maybe Alias) Nilable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nilable)))
+
+(def: constant
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>\wrap true)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nilable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Alias)
+   #inputs (List Nilable)
+   #io? Bit
+   #try? Bit
+   #output Nilable})
+
+(type: Static_Method Common_Method)
+(type: Virtual_Method Common_Method)
+
+(type: Method
+  (#Static Static_Method)
+  (#Virtual Virtual_Method))
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe ..alias)
+      (.tuple (<>.some ..nilable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..nilable))
+
+(def: static_method
+  (<>.after ..static! ..common_method))
+
+(def: method
+  (Parser Method)
+  (.form (<>.or ..static_method
+                      ..common_method)))
+
+(type: Member
+  (#Field Field)
+  (#Method Method))
+
+(def: member
+  (Parser Member)
+  ($_ <>.or
+      ..field
+      ..method
+      ))
+
+(def: input_variables
+  (-> (List Nilable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [nilable? type]])
+                   [nilable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nilable_type [nilable? type])
+  (-> Nilable Code)
+  (if nilable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_nil g!temp [nilable? input])
+  (-> Code [Bit Code] Code)
+  (if nilable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.Nil
+         ("ruby object nil")))
+    input))
+
+(def: (without_nil g!temp [nilable? outputT] output)
+  (-> Code Nilable Code Code)
+  (if nilable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("ruby object nil?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("ruby object nil?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "Nil is an invalid value!"))))))
+
+(type: Import
+  (#Class Text (Maybe Alias) Text (List Member))
+  (#Function Static_Method)
+  (#Constant Field))
+
+(def: import
+  (Parser [(Maybe Text) Import])
+  ($_ <>.and
+      (<>.maybe .text)
+      ($_ <>.or
+          ($_ <>.and
+              .local_identifier
+              (<>.maybe ..alias)
+              (<>.default ["" (list)]
+                          (.tuple (<>.and .text
+                                                (<>.some member)))))
+          (.form ..common_method)
+          ..constant
+          )))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (.try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Code (List Nilable) Bit Bit Nilable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map nilable_type inputsT))]
+             (~ (|> (nilable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_nil g!temp outputT)
+                 (` ("ruby apply"
+                     (:as ..Function (~ source))
+                     (~+ (list\map (with_nil g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {[?module import] ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Class [class alias format members])
+      (with_gensyms [g!object]
+        (let [qualify (: (-> Text Code)
+                         (function (_ member_name)
+                           (|> format
+                               (text.replace_all "#" (maybe.default class alias))
+                               (text.replace_all "." member_name)
+                               code.local_identifier)))
+              g!type (code.local_identifier (maybe.default class alias))
+              module_import (: (List Code)
+                               (case ?module
+                                 (#.Some module)
+                                 (list (` ("ruby import" (~ (code.text module)))))
+
+                                 #.None
+                                 (list)))
+              class_import (` ("ruby constant" (~ (code.text class))))]
+          (wrap (list& (` (type: (~ g!type)
+                            (..Object (primitive (~ (code.text class))))))
+                       (list\map (function (_ member)
+                                   (case member
+                                     (#Field [static? field alias fieldT])
+                                     (if static?
+                                       (` ((~! syntax:) ((~ (qualify (maybe.default field alias))))
+                                           (\ (~! meta.monad) (~' wrap)
+                                              (list (` (.:as (~ (nilable_type fieldT))
+                                                             (.exec
+                                                               (~+ module_import)
+                                                               ("ruby constant" (~ (code.text (%.format class "::" field)))))))))))
+                                       (` (def: ((~ (qualify field))
+                                                 (~ g!object))
+                                            (-> (~ g!type)
+                                                (~ (nilable_type fieldT)))
+                                            (:assume
+                                             (~ (without_nil g!temp fieldT (` ("ruby object get" (~ (code.text field))
+                                                                               (:as (..Object .Any) (~ g!object))))))))))
+                                     
+                                     (#Method method)
+                                     (case method
+                                       (#Static [method alias inputsT io? try? outputT])
+                                       (..make_function (qualify (maybe.default method alias))
+                                                        g!temp
+                                                        (` ("ruby object get" (~ (code.text method))
+                                                            (:as (..Object .Any)
+                                                                 (.exec
+                                                                   (~+ module_import)
+                                                                   ("ruby constant" (~ (code.text (%.format class "::" method))))))))
+                                                        inputsT
+                                                        io?
+                                                        try?
+                                                        outputT)
+                                       
+                                       (#Virtual [method alias inputsT io? try? outputT])
+                                       (let [g!inputs (input_variables inputsT)]
+                                         (` (def: ((~ (qualify (maybe.default method alias)))
+                                                   [(~+ (list\map product.right g!inputs))]
+                                                   (~ g!object))
+                                              (-> [(~+ (list\map nilable_type inputsT))]
+                                                  (~ g!type)
+                                                  (~ (|> (nilable_type outputT)
+                                                         (try_type try?)
+                                                         (io_type io?))))
+                                              (:assume
+                                               (~ (<| (with_io io?)
+                                                      (with_try try?)
+                                                      (without_nil g!temp outputT)
+                                                      (` ("ruby object do"
+                                                          (~ (code.text method))
+                                                          (~ g!object)
+                                                          (~+ (list\map (with_nil g!temp) g!inputs)))))))))))))
+                                 members)))))
+      
+      (#Function [name alias inputsT io? try? outputT])
+      (let [imported (` (.exec
+                          (~+ (case ?module
+                                (#.Some module)
+                                (list (` ("ruby import" (~ (code.text module)))))
+
+                                #.None
+                                (list)))
+                          ("ruby constant" (~ (code.text name)))))]
+        (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                     g!temp
+                                     imported
+                                     inputsT
+                                     io?
+                                     try?
+                                     outputT))))
+
+      (#Constant [_ name alias fieldT])
+      (let [imported (` (.exec
+                          (~+ (case ?module
+                                (#.Some module)
+                                (list (` ("ruby import" (~ (code.text module)))))
+
+                                #.None
+                                (list)))
+                          ("ruby constant" (~ (code.text name)))))]
+        (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias))))
+                        (\ (~! meta.monad) (~' wrap)
+                           (list (` (.:as (~ (nilable_type fieldT)) (~ imported))))))))))
+      )))
diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux
new file mode 100644
index 000000000..85370fcf6
--- /dev/null
+++ b/stdlib/source/library/lux/ffi.scm.lux
@@ -0,0 +1,220 @@
+(.module:
+  [library
+   [lux (#- Alias)
+    ["@" target]
+    ["." meta]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [type
+     abstract]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]
+     ["." template]]]])
+
+(abstract: #export (Object brand) Any)
+
+(template []
+  [(with_expansions [ (template.identifier [ "'"])]
+     (abstract: #export  Any)
+     (type: #export 
+       (..Object )))]
+
+  [Nil]
+  [Function]
+  )
+
+(template [ ]
+  [(type: #export 
+     )]
+
+  [Boolean Bit]
+  [Integer Int]
+  [Float   Frac]
+  [String  Text]
+  )
+
+(type: Nilable
+  [Bit Code])
+
+(def: nilable
+  (Parser Nilable)
+  (let [token (' #?)]
+    (<| (<>.and (<>.parses? (.this! token)))
+        (<>.after (<>.not (.this! token)))
+        .any)))
+
+(type: Alias
+  Text)
+
+(def: alias
+  (Parser Alias)
+  (<>.after (.this! (' #as)) .local_identifier))
+
+(type: Field
+  [Bit Text (Maybe Alias) Nilable])
+
+(def: static!
+  (Parser Any)
+  (.this! (' #static)))
+
+(def: field
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>.parses? ..static!)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nilable)))
+
+(def: constant
+  (Parser Field)
+  (.form ($_ <>.and
+                   (<>\wrap true)
+                   .local_identifier
+                   (<>.maybe ..alias)
+                   ..nilable)))
+
+(type: Common_Method
+  {#name Text
+   #alias (Maybe Alias)
+   #inputs (List Nilable)
+   #io? Bit
+   #try? Bit
+   #output Nilable})
+
+(def: common_method
+  (Parser Common_Method)
+  ($_ <>.and
+      .local_identifier
+      (<>.maybe ..alias)
+      (.tuple (<>.some ..nilable))
+      (<>.parses? (.this! (' #io)))
+      (<>.parses? (.this! (' #try)))
+      ..nilable))
+
+(def: input_variables
+  (-> (List Nilable) (List [Bit Code]))
+  (|>> list.enumeration
+       (list\map (function (_ [idx [nilable? type]])
+                   [nilable? (|> idx %.nat code.local_identifier)]))))
+
+(def: (nilable_type [nilable? type])
+  (-> Nilable Code)
+  (if nilable?
+    (` (.Maybe (~ type)))
+    type))
+
+(def: (with_nil g!temp [nilable? input])
+  (-> Code [Bit Code] Code)
+  (if nilable?
+    (` (case (~ input)
+         (#.Some (~ g!temp))
+         (~ g!temp)
+
+         #.Nil
+         ("scheme object nil")))
+    input))
+
+(def: (without_nil g!temp [nilable? outputT] output)
+  (-> Code Nilable Code Code)
+  (if nilable?
+    (` (let [(~ g!temp) (~ output)]
+         (if ("scheme object nil?" (~ g!temp))
+           #.None
+           (#.Some (~ g!temp)))))
+    (` (let [(~ g!temp) (~ output)]
+         (if (not ("scheme object nil?" (~ g!temp)))
+           (~ g!temp)
+           (.error! "Nil is an invalid value!"))))))
+
+(type: Import
+  (#Function Common_Method)
+  (#Constant Field))
+
+(def: import
+  (Parser Import)
+  ($_ <>.or
+      (.form ..common_method)
+      ..constant
+      ))
+
+(syntax: #export (try expression)
+  {#.doc (doc (case (try (risky_computation input))
+                (#.Right success)
+                (do_something success)
+
+                (#.Left error)
+                (recover_from_failure error)))}
+  (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
+
+(def: (with_io with? without)
+  (-> Bit Code Code)
+  (if with?
+    (` (io.io (~ without)))
+    without))
+
+(def: (io_type io? rawT)
+  (-> Bit Code Code)
+  (if io?
+    (` (io.IO (~ rawT)))
+    rawT))
+
+(def: (with_try with? without_try)
+  (-> Bit Code Code)
+  (if with?
+    (` (..try (~ without_try)))
+    without_try))
+
+(def: (try_type try? rawT)
+  (-> Bit Code Code)
+  (if try?
+    (` (.Either .Text (~ rawT)))
+    rawT))
+
+(def: (make_function g!method g!temp source inputsT io? try? outputT)
+  (-> Code Code Code (List Nilable) Bit Bit Nilable Code)
+  (let [g!inputs (input_variables inputsT)]
+    (` (def: ((~ g!method)
+              [(~+ (list\map product.right g!inputs))])
+         (-> [(~+ (list\map nilable_type inputsT))]
+             (~ (|> (nilable_type outputT)
+                    (try_type try?)
+                    (io_type io?))))
+         (:assume
+          (~ (<| (with_io io?)
+                 (with_try try?)
+                 (without_nil g!temp outputT)
+                 (` ("scheme apply"
+                     (:as ..Function (~ source))
+                     (~+ (list\map (with_nil g!temp) g!inputs)))))))))))
+
+(syntax: #export (import: {import ..import})
+  (with_gensyms [g!temp]
+    (case import
+      (#Function [name alias inputsT io? try? outputT])
+      (let [imported (` ("scheme constant" (~ (code.text name))))]
+        (wrap (list (..make_function (code.local_identifier (maybe.default name alias))
+                                     g!temp
+                                     imported
+                                     inputsT
+                                     io?
+                                     try?
+                                     outputT))))
+
+      (#Constant [_ name alias fieldT])
+      (let [imported (` ("scheme constant" (~ (code.text name))))]
+        (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias))))
+                        (\ (~! meta.monad) (~' wrap)
+                           (list (` (.:as (~ (nilable_type fieldT)) (~ imported))))))))))
+      )))
diff --git a/stdlib/source/library/lux/locale.lux b/stdlib/source/library/lux/locale.lux
new file mode 100644
index 000000000..381938c74
--- /dev/null
+++ b/stdlib/source/library/lux/locale.lux
@@ -0,0 +1,45 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     ["." hash (#+ Hash)]]
+    [data
+     ["." maybe ("#\." functor)]
+     ["." text
+      ["%" format (#+ format)]
+      ["." encoding (#+ Encoding)]]]
+    [type
+     abstract]]]
+  [/
+   ["." language (#+ Language)]
+   ["." territory (#+ Territory)]])
+
+(abstract: #export Locale
+  Text
+
+  (def: territory_separator "_")
+  (def: encoding_separator ".")
+
+  (def: #export (locale language territory encoding)
+    (-> Language (Maybe Territory) (Maybe Encoding) Locale)
+    (:abstraction (format (language.code language)
+                          (|> territory
+                              (maybe\map (|>> territory.long_code (format ..territory_separator)))
+                              (maybe.default ""))
+                          (|> encoding
+                              (maybe\map (|>> encoding.name (format ..encoding_separator)))
+                              (maybe.default "")))))
+
+  (def: #export code
+    (-> Locale Text)
+    (|>> :representation))
+
+  (def: #export hash
+    (Hash Locale)
+    (\ hash.functor map ..code text.hash))
+
+  (def: #export equivalence
+    (Equivalence Locale)
+    (\ ..hash &equivalence))
+  )
diff --git a/stdlib/source/library/lux/locale/language.lux b/stdlib/source/library/lux/locale/language.lux
new file mode 100644
index 000000000..554606609
--- /dev/null
+++ b/stdlib/source/library/lux/locale/language.lux
@@ -0,0 +1,573 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]
+    [data
+     ["." text]]
+    [type
+     abstract]
+    [macro
+     ["." template]]]])
+
+## https://en.wikipedia.org/wiki/List_of_ISO_639-2_codes
+(abstract: #export Language
+  {#name Text
+   #code Text}
+
+  (template [ ]
+    [(def: #export 
+       (-> Language Text)
+       (|>> :representation (get@ )))]
+
+    [name #name]
+    [code #code]
+    )
+
+  (template []
+    [(with_expansions [' (template.splice )]
+       (template [   +]
+         [(def: #export 
+            Language
+            (:abstraction {#name 
+                           #code }))
+          (`` (template []
+                [(def: #export 
+                   Language
+                   )]
+
+                (~~ (template.splice +))))]
+
+         '
+         ))]
+
+    [[["mis" "uncoded languages" uncoded []]
+      ["mul" "multiple languages" multiple []]
+      ["und" "undetermined" undetermined []]
+      ["zxx" "no linguistic content; not applicable" not_applicable []]]]
+
+    [[["aar" "Afar" afar []]
+      ["abk" "Abkhazian" abkhazian []]
+      ["ace" "Achinese" achinese []]
+      ["ach" "Acoli" acoli []]
+      ["ada" "Adangme" adangme []]
+      ["ady" "Adyghe; Adygei" adyghe []]
+      ["afa" "Afro-Asiatic languages" afro_asiatic []]
+      ["afh" "Afrihili" afrihili []]
+      ["afr" "Afrikaans" afrikaans []]
+      ["ain" "Ainu" ainu []]
+      ["aka" "Akan" akan []]
+      ["akk" "Akkadian" akkadian []]
+      ["ale" "Aleut" aleut []]
+      ["alg" "Algonquian languages" algonquian []]
+      ["alt" "Southern Altai" southern_altai []]
+      ["amh" "Amharic" amharic []]
+      ["ang" "Old English (ca.450–1100)" old_english []]
+      ["anp" "Angika" angika []]
+      ["apa" "Apache languages" apache []]
+      ["ara" "Arabic" arabic []]
+      ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official_aramaic [[imperial_aramaic]]]
+      ["arg" "Aragonese" aragonese []]
+      ["arn" "Mapudungun; Mapuche" mapudungun []]
+      ["arp" "Arapaho" arapaho []]
+      ["art" "Artificial languages" artificial []]
+      ["arw" "Arawak" arawak []]
+      ["asm" "Assamese" assamese []]
+      ["ast" "Asturian; Bable; Leonese; Asturleonese" asturian [[bable] [leonese] [asturleonese]]]
+      ["ath" "Athapascan languages" athapascan []]
+      ["aus" "Australian languages" australian []]
+      ["ava" "Avaric" avaric []]
+      ["ave" "Avestan" avestan []]
+      ["awa" "Awadhi" awadhi []]
+      ["aym" "Aymara" aymara []]
+      ["aze" "Azerbaijani" azerbaijani []]]]
+    
+    [[["bad" "Banda languages" banda []]
+      ["bai" "Bamileke languages" bamileke []]
+      ["bak" "Bashkir" bashkir []]
+      ["bal" "Baluchi" baluchi []]
+      ["bam" "Bambara" bambara []]
+      ["ban" "Balinese" balinese []]
+      ["bas" "Basa" basa []]
+      ["bat" "Baltic languages" baltic []]
+      ["bej" "Beja; Bedawiyet" beja []]
+      ["bel" "Belarusian" belarusian []]
+      ["bem" "Bemba" bemba []]
+      ["ben" "Bengali" bengali []]
+      ["ber" "Berber languages" berber []]
+      ["bho" "Bhojpuri" bhojpuri []]
+      ["bih" "Bihari languages" bihari []]
+      ["bik" "Bikol" bikol []]
+      ["bin" "Bini; Edo" bini [[edo]]]
+      ["bis" "Bislama" bislama []]
+      ["bla" "Siksika" siksika []]
+      ["bnt" "Bantu languages" bantu []]
+      ["bod" "Tibetan" tibetan []]
+      ["bos" "Bosnian" bosnian []]
+      ["bra" "Braj" braj []]
+      ["bre" "Breton" breton []]
+      ["btk" "Batak languages" batak []]
+      ["bua" "Buriat" buriat []]
+      ["bug" "Buginese" buginese []]
+      ["bul" "Bulgarian" bulgarian []]
+      ["byn" "Blin; Bilin" blin [[bilin]]]]]
+
+    [[["cad" "Caddo" caddo []]
+      ["cai" "Central American Indian languages" central_american_indian []]
+      ["car" "Galibi Carib" galibi_carib []]
+      ["cat" "Catalan; Valencian" catalan [[valencian]]]
+      ["cau" "Caucasian languages" caucasian []]
+      ["ceb" "Cebuano" cebuano []]
+      ["cel" "Celtic languages" celtic []]
+      ["ces" "Czech" czech []]
+      ["cha" "Chamorro" chamorro []]
+      ["chb" "Chibcha" chibcha []]
+      ["che" "Chechen" chechen []]
+      ["chg" "Chagatai" chagatai []]
+      ["chk" "Chuukese" chuukese []]
+      ["chm" "Mari" mari []]
+      ["chn" "Chinook jargon" chinook []]
+      ["cho" "Choctaw" choctaw []]
+      ["chp" "Chipewyan; Dene Suline" chipewyan []]
+      ["chr" "Cherokee" cherokee []]
+      ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church_slavic [[old_slavonic] [church_slavonic] [old_bulgarian] [old_church_slavonic]]]
+      ["chv" "Chuvash" chuvash []]
+      ["chy" "Cheyenne" cheyenne []]
+      ["cmc" "Chamic languages" chamic []]
+      ["cnr" "Montenegrin" montenegrin []]
+      ["cop" "Coptic" coptic []]
+      ["cor" "Cornish" cornish []]
+      ["cos" "Corsican" corsican []]
+      ["cpe" "Creoles and pidgins, English based" creoles_and_pidgins/english []]
+      ["cpf" "Creoles and pidgins, French-based" creoles_and_pidgins/french []]
+      ["cpp" "Creoles and pidgins, Portuguese-based" creoles_and_pidgins/portuguese []]
+      ["cre" "Cree" cree []]
+      ["crh" "Crimean Tatar; Crimean Turkish" crimean []]
+      ["crp" "Creoles and pidgins" creoles_and_pidgins []]
+      ["csb" "Kashubian" kashubian []]
+      ["cus" "Cushitic languages" cushitic []]
+      ["cym" "Welsh" welsh []]]]
+    
+    [[["dak" "Dakota" dakota []]
+      ["dan" "Danish" danish []]
+      ["dar" "Dargwa" dargwa []]
+      ["day" "Land Dayak languages" land_dayak []]
+      ["del" "Delaware" delaware []]
+      ["den" "Slave (Athapascan)" slavey []]
+      ["deu" "German" german []]
+      ["dgr" "Dogrib" dogrib []]
+      ["din" "Dinka" dinka []]
+      ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]]
+      ["doi" "Dogri" dogri []]
+      ["dra" "Dravidian languages" dravidian []]
+      ["dsb" "Lower Sorbian" lower_sorbian []]
+      ["dua" "Duala" duala []]
+      ["dum" "Middle Dutch (ca. 1050–1350)" middle_dutch []]
+      ["dyu" "Dyula" dyula []]
+      ["dzo" "Dzongkha" dzongkha []]]]
+
+    [[["efi" "Efik" efik []]
+      ["egy" "Ancient Egyptian" egyptian []]
+      ["eka" "Ekajuk" ekajuk []]
+      ["ell" "Modern Greek (1453–)" greek []]
+      ["elx" "Elamite" elamite []]
+      ["eng" "English" english []]
+      ["enm" "Middle English (1100–1500)" middle_english []]
+      ["epo" "Esperanto" esperanto []]
+      ["est" "Estonian" estonian []]
+      ["eus" "Basque" basque []]
+      ["ewe" "Ewe" ewe []]
+      ["ewo" "Ewondo" ewondo []]]]
+
+    [[["fan" "Fang" fang []]
+      ["fao" "Faroese" faroese []]
+      ["fas" "Persian" persian []]
+      ["fat" "Fanti" fanti []]
+      ["fij" "Fijian" fijian []]
+      ["fil" "Filipino; Pilipino" filipino []]
+      ["fin" "Finnish" finnish []]
+      ["fiu" "Finno-Ugrian languages" finno_ugrian []]
+      ["fon" "Fon" fon []]
+      ["fra" "French" french []]
+      ["frm" "Middle French (ca. 1400–1600)" middle_french []]
+      ["fro" "Old French (ca. 842–1400)" old_french []]
+      ["frr" "Northern Frisian" northern_frisian []]
+      ["frs" "Eastern Frisian" eastern_frisian []]
+      ["fry" "Western Frisian" western_frisian []]
+      ["ful" "Fulah" fulah []]
+      ["fur" "Friulian" friulian []]]]
+
+    [[["gaa" "Ga" ga []]
+      ["gay" "Gayo" gayo []]
+      ["gba" "Gbaya" gbaya []]
+      ["gem" "Germanic languages" germanic []]
+      ["gez" "Geez" geez []]
+      ["gil" "Gilbertese" gilbertese []]
+      ["gla" "Gaelic; Scottish Gaelic" gaelic []]
+      ["gle" "Irish" irish []]
+      ["glg" "Galician" galician []]
+      ["glv" "Manx" manx []]
+      ["gmh" "Middle High German (ca. 1050–1500)" middle_high_german []]
+      ["goh" "Old High German (ca. 750–1050)" old_high_german []]
+      ["gon" "Gondi" gondi []]
+      ["gor" "Gorontalo" gorontalo []]
+      ["got" "Gothic" gothic []]
+      ["grb" "Grebo" grebo []]
+      ["grc" "Ancient Greek (to 1453)" ancient_greek []]
+      ["grn" "Guarani" guarani []]
+      ["gsw" "Swiss German; Alemannic; Alsatian" swiss_german [[alemannic] [alsatian]]]
+      ["guj" "Gujarati" gujarati []]
+      ["gwi" "Gwich'in" gwich'in []]]]
+
+    [[["hai" "Haida" haida []]
+      ["hat" "Haitian; Haitian Creole" haitian []]
+      ["hau" "Hausa" hausa []]
+      ["haw" "Hawaiian" hawaiian []]
+      ["heb" "Hebrew" hebrew []]
+      ["her" "Herero" herero []]
+      ["hil" "Hiligaynon" hiligaynon []]
+      ["him" "Himachali languages; Pahari languages" himachali []]
+      ["hin" "Hindi" hindi []]
+      ["hit" "Hittite" hittite []]
+      ["hmn" "Hmong; Mong" hmong []]
+      ["hmo" "Hiri Motu" hiri_motu []]
+      ["hrv" "Croatian" croatian []]
+      ["hsb" "Upper Sorbian" upper_sorbian []]
+      ["hun" "Hungarian" hungarian []]
+      ["hup" "Hupa" hupa []]
+      ["hye" "Armenian" armenian []]]]
+
+    [[["iba" "Iban" iban []]
+      ["ibo" "Igbo" igbo []]
+      ["ido" "Ido" ido []]
+      ["iii" "Sichuan Yi; Nuosu" sichuan_yi [[nuosu]]]
+      ["ijo" "Ijo languages" ijo []]
+      ["iku" "Inuktitut" inuktitut []]
+      ["ile" "Interlingue; Occidental" interlingue []]
+      ["ilo" "Iloko" iloko []]
+      ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []]
+      ["inc" "Indic languages" indic []]
+      ["ind" "Indonesian" indonesian []]
+      ["ine" "Indo-European languages" indo_european []]
+      ["inh" "Ingush" ingush []]
+      ["ipk" "Inupiaq" inupiaq []]
+      ["ira" "Iranian languages" iranian []]
+      ["iro" "Iroquoian languages" iroquoian []]
+      ["isl" "Icelandic" icelandic []]
+      ["ita" "Italian" italian []]]]
+
+    [[["jav" "Javanese" javanese []]
+      ["jbo" "Lojban" lojban []]
+      ["jpn" "Japanese" japanese []]
+      ["jpr" "Judeo-Persian" judeo_persian []]
+      ["jrb" "Judeo-Arabic" judeo_arabic []]]]
+
+    [[["kaa" "Kara-Kalpak" kara_kalpak []]
+      ["kab" "Kabyle" kabyle []]
+      ["kac" "Kachin; Jingpho" kachin [[jingpho]]]
+      ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]]
+      ["kam" "Kamba" kamba []]
+      ["kan" "Kannada" kannada []]
+      ["kar" "Karen languages" karen []]
+      ["kas" "Kashmiri" kashmiri []]
+      ["kat" "Georgian" georgian []]
+      ["kau" "Kanuri" kanuri []]
+      ["kaw" "Kawi" kawi []]
+      ["kaz" "Kazakh" kazakh []]
+      ["kbd" "Kabardian" kabardian []]
+      ["kha" "Khasi" khasi []]
+      ["khi" "Khoisan languages" khoisan []]
+      ["khm" "Central Khmer" central_khmer []]
+      ["kho" "Khotanese; Sakan" khotanese [[sakan]]]
+      ["kik" "Kikuyu; Gikuyu" gikuyu []]
+      ["kin" "Kinyarwanda" kinyarwanda []]
+      ["kir" "Kirghiz; Kyrgyz" kyrgyz []]
+      ["kmb" "Kimbundu" kimbundu []]
+      ["kok" "Konkani" konkani []]
+      ["kom" "Komi" komi []]
+      ["kon" "Kongo" kongo []]
+      ["kor" "Korean" korean []]
+      ["kos" "Kosraean" kosraean []]
+      ["kpe" "Kpelle" kpelle []]
+      ["krc" "Karachay-Balkar" karachay_balkar []]
+      ["krl" "Karelian" karelian []]
+      ["kro" "Kru languages" kru []]
+      ["kru" "Kurukh" kurukh []]
+      ["kua" "Kuanyama; Kwanyama" kwanyama []]
+      ["kum" "Kumyk" kumyk []]
+      ["kur" "Kurdish" kurdish []]
+      ["kut" "Kutenai" kutenai []]]]
+
+    [[["lad" "Ladino" ladino []]
+      ["lah" "Lahnda" lahnda []]
+      ["lam" "Lamba" lamba []]
+      ["lao" "Lao" lao []]
+      ["lat" "Latin" latin []]
+      ["lav" "Latvian" latvian []]
+      ["lez" "Lezghian" lezghian []]
+      ["lim" "Limburgan; Limburger; Limburgish" limburgan []]
+      ["lin" "Lingala" lingala []]
+      ["lit" "Lithuanian" lithuanian []]
+      ["lol" "Mongo" mongo []]
+      ["loz" "Lozi" lozi []]
+      ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []]
+      ["lua" "Luba-Lulua" luba_lulua []]
+      ["lub" "Luba-Katanga" luba_katanga []]
+      ["lug" "Ganda" ganda []]
+      ["lui" "Luiseno" luiseno []]
+      ["lun" "Lunda" lunda []]
+      ["luo" "Luo (Kenya and Tanzania)" luo []]
+      ["lus" "Lushai" lushai []]]]
+
+    [[["mad" "Madurese" madurese []]
+      ["mag" "Magahi" magahi []]
+      ["mah" "Marshallese" marshallese []]
+      ["mai" "Maithili" maithili []]
+      ["mak" "Makasar" makasar []]
+      ["mal" "Malayalam" malayalam []]
+      ["man" "Mandingo" mandingo []]
+      ["map" "Austronesian languages" austronesian []]
+      ["mar" "Marathi" marathi []]
+      ["mas" "Masai" masai []]
+      ["mdf" "Moksha" moksha []]
+      ["mdr" "Mandar" mandar []]
+      ["men" "Mende" mende []]
+      ["mga" "Middle Irish (900–1200)" middle_irish []]
+      ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]]
+      ["min" "Minangkabau" minangkabau []]
+      ["mkd" "Macedonian" macedonian []]
+      ["mkh" "Mon-Khmer languages" mon_khmer []]
+      ["mlg" "Malagasy" malagasy []]
+      ["mlt" "Maltese" maltese []]
+      ["mnc" "Manchu" manchu []]
+      ["mni" "Manipuri" manipuri []]
+      ["mno" "Manobo languages" manobo []]
+      ["moh" "Mohawk" mohawk []]
+      ["mon" "Mongolian" mongolian []]
+      ["mos" "Mossi" mossi []]
+      ["mri" "Maori" maori []]
+      ["msa" "Malay" malay []]
+      ["mun" "Munda languages" munda []]
+      ["mus" "Creek" creek []]
+      ["mwl" "Mirandese" mirandese []]
+      ["mwr" "Marwari" marwari []]
+      ["mya" "Burmese" burmese []]
+      ["myn" "Mayan languages" mayan []]
+      ["myv" "Erzya" erzya []]]]
+
+    [[["nah" "Nahuatl languages" nahuatl []]
+      ["nai" "North American Indian languages" north_american_indian []]
+      ["nap" "Neapolitan" neapolitan []]
+      ["nau" "Nauru" nauru []]
+      ["nav" "Navajo; Navaho" navajo []]
+      ["nbl" "South Ndebele" south_ndebele []]
+      ["nde" "North Ndebele" north_ndebele []]
+      ["ndo" "Ndonga" ndonga []]
+      ["nds" "Low German; Low Saxon" low_german []]
+      ["nep" "Nepali" nepali []]
+      ["new" "Nepal Bhasa; Newari" newari [[nepal_bhasa]]]
+      ["nia" "Nias" nias []]
+      ["nic" "Niger-Kordofanian languages" niger_kordofanian []]
+      ["niu" "Niuean" niuean []]
+      ["nld" "Dutch; Flemish" dutch [[flemish]]]
+      ["nno" "Norwegian Nynorsk" nynorsk []]
+      ["nob" "Norwegian Bokmål" bokmal []]
+      ["nog" "Nogai" nogai []]
+      ["non" "Old Norse" old_norse []]
+      ["nor" "Norwegian" norwegian []]
+      ["nqo" "N'Ko" n'ko []]
+      ["nso" "Pedi; Sepedi; Northern Sotho" northern_sotho [[pedi] [sepedi]]]
+      ["nub" "Nubian languages" nubian []]
+      ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old_newari [[classical_newari] [classical_nepal_bhasa]]]
+      ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]]
+      ["nym" "Nyamwezi" nyamwezi []]
+      ["nyn" "Nyankole" nyankole []]
+      ["nyo" "Nyoro" nyoro []]
+      ["nzi" "Nzima" nzima []]]]
+
+    [[["oci" "Occitan (post 1500); Provençal" occitan [[provencal]]]
+      ["oji" "Ojibwa" ojibwa []]
+      ["ori" "Oriya" oriya []]
+      ["orm" "Oromo" oromo []]
+      ["osa" "Osage" osage []]
+      ["oss" "Ossetian; Ossetic" ossetic []]
+      ["ota" "Ottoman Turkish (1500–1928)" ottoman_turkish []]
+      ["oto" "Otomian languages" otomian []]]]
+
+    [[["paa" "Papuan languages" papuan []]
+      ["pag" "Pangasinan" pangasinan []]
+      ["pal" "Pahlavi" pahlavi []]
+      ["pam" "Pampanga; Kapampangan" pampanga [[kapampangan]]]
+      ["pan" "Panjabi; Punjabi" punjabi []]
+      ["pap" "Papiamento" papiamento []]
+      ["pau" "Palauan" palauan []]
+      ["peo" "Old Persian (ca. 600–400 B.C.)" old_persian []]
+      ["phi" "Philippine languages" philippine []]
+      ["phn" "Phoenician" phoenician []]
+      ["pli" "Pali" pali []]
+      ["pol" "Polish" polish []]
+      ["pon" "Pohnpeian" pohnpeian []]
+      ["por" "Portuguese" portuguese []]
+      ["pra" "Prakrit languages" prakrit []]
+      ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old_provencal []]
+      ["pus" "Pushto; Pashto" pashto []]]]
+
+    [[["que" "Quechua" quechua []]]]
+
+    [[["raj" "Rajasthani" rajasthani []]
+      ["rap" "Rapanui" rapanui []]
+      ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook_islands_maori]]]
+      ["roa" "Romance languages" romance []]
+      ["roh" "Romansh" romansh []]
+      ["rom" "Romany" romany []]
+      ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]]
+      ["run" "Rundi" rundi []]
+      ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo_romanian]]]
+      ["rus" "Russian" russian []]]]
+
+    [[["sad" "Sandawe" sandawe []]
+      ["sag" "Sango" sango []]
+      ["sah" "Yakut" yakut []]
+      ["sai" "South American Indian (Other)" south_american_indian []]
+      ["sal" "Salishan languages" salishan []]
+      ["sam" "Samaritan Aramaic" samaritan_aramaic []]
+      ["san" "Sanskrit" sanskrit []]
+      ["sas" "Sasak" sasak []]
+      ["sat" "Santali" santali []]
+      ["scn" "Sicilian" sicilian []]
+      ["sco" "Scots" scots []]
+      ["sel" "Selkup" selkup []]
+      ["sem" "Semitic languages" semitic []]
+      ["sga" "Old Irish (to 900)" old_irish []]
+      ["sgn" "Sign Languages" sign []]
+      ["shn" "Shan" shan []]
+      ["sid" "Sidamo" sidamo []]
+      ["sin" "Sinhala; Sinhalese" sinhalese []]
+      ["sio" "Siouan languages" siouan []]
+      ["sit" "Sino-Tibetan languages" sino_tibetan []]
+      ["sla" "Slavic languages" slavic []]
+      ["slk" "Slovak" slovak []]
+      ["slv" "Slovenian" slovenian []]
+      ["sma" "Southern Sami" southern_sami []]
+      ["sme" "Northern Sami" northern_sami []]
+      ["smi" "Sami languages" sami []]
+      ["smj" "Lule Sami" lule []]
+      ["smn" "Inari Sami" inari []]
+      ["smo" "Samoan" samoan []]
+      ["sms" "Skolt Sami" skolt_sami []]
+      ["sna" "Shona" shona []]
+      ["snd" "Sindhi" sindhi []]
+      ["snk" "Soninke" soninke []]
+      ["sog" "Sogdian" sogdian []]
+      ["som" "Somali" somali []]
+      ["son" "Songhai languages" songhai []]
+      ["sot" "Southern Sotho" southern_sotho []]
+      ["spa" "Spanish; Castilian" spanish [[castilian]]]
+      ["sqi" "Albanian" albanian []]
+      ["srd" "Sardinian" sardinian []]
+      ["srn" "Sranan Tongo" sranan_tongo []]
+      ["srp" "Serbian" serbian []]
+      ["srr" "Serer" serer []]
+      ["ssa" "Nilo-Saharan languages" nilo_saharan []]
+      ["ssw" "Swati" swati []]
+      ["suk" "Sukuma" sukuma []]
+      ["sun" "Sundanese" sundanese []]
+      ["sus" "Susu" susu []]
+      ["sux" "Sumerian" sumerian []]
+      ["swa" "Swahili" swahili []]
+      ["swe" "Swedish" swedish []]
+      ["syc" "Classical Syriac" classical_syriac []]
+      ["syr" "Syriac" syriac []]]]
+
+    [[["tah" "Tahitian" tahitian []]
+      ["tai" "Tai languages" tai []]
+      ["tam" "Tamil" tamil []]
+      ["tat" "Tatar" tatar []]
+      ["tel" "Telugu" telugu []]
+      ["tem" "Timne" timne []]
+      ["ter" "Tereno" tereno []]
+      ["tet" "Tetum" tetum []]
+      ["tgk" "Tajik" tajik []]
+      ["tgl" "Tagalog" tagalog []]
+      ["tha" "Thai" thai []]
+      ["tig" "Tigre" tigre []]
+      ["tir" "Tigrinya" tigrinya []]
+      ["tiv" "Tiv" tiv []]
+      ["tkl" "Tokelau" tokelau []]
+      ["tlh" "Klingon; tlhIngan-Hol" klingon []]
+      ["tli" "Tlingit" tlingit []]
+      ["tmh" "Tamashek" tamashek []]
+      ["tog" "Tonga (Nyasa)" tonga []]
+      ["ton" "Tonga (Tonga Islands)" tongan []]
+      ["tpi" "Tok Pisin" tok_pisin []]
+      ["tsi" "Tsimshian" tsimshian []]
+      ["tsn" "Tswana" tswana []]
+      ["tso" "Tsonga" tsonga []]
+      ["tuk" "Turkmen" turkmen []]
+      ["tum" "Tumbuka" tumbuka []]
+      ["tup" "Tupi languages" tupi []]
+      ["tur" "Turkish" turkish []]
+      ["tut" "Altaic languages" altaic []]
+      ["tvl" "Tuvalu" tuvalu []]
+      ["twi" "Twi" twi []]
+      ["tyv" "Tuvinian" tuvinian []]]]
+
+    [[["udm" "Udmurt" udmurt []]
+      ["uga" "Ugaritic" ugaritic []]
+      ["uig" "Uighur; Uyghur" uyghur []]
+      ["ukr" "Ukrainian" ukrainian []]
+      ["umb" "Umbundu" umbundu []]
+      ["urd" "Urdu" urdu []]
+      ["uzb" "Uzbek" uzbek []]]]
+
+    [[["vai" "Vai" vai []]
+      ["ven" "Venda" venda []]
+      ["vie" "Vietnamese" vietnamese []]
+      ["vol" "Volapük" volapük []]
+      ["vot" "Votic" votic []]]]
+
+    [[["wak" "Wakashan languages" wakashan []]
+      ["wal" "Wolaitta; Wolaytta" walamo []]
+      ["war" "Waray" waray []]
+      ["was" "Washo" washo []]
+      ["wen" "Sorbian languages" sorbian []]
+      ["wln" "Walloon" walloon []]
+      ["wol" "Wolof" wolof []]]]
+
+    [[["xal" "Kalmyk; Oirat" kalmyk [[oirat]]]
+      ["xho" "Xhosa" xhosa []]]]
+
+    [[["yao" "Yao" yao []]
+      ["yap" "Yapese" yapese []]
+      ["yid" "Yiddish" yiddish []]
+      ["yor" "Yoruba" yoruba []]
+      ["ypk" "Yupik languages" yupik []]]]
+
+    [[["zap" "Zapotec" zapotec []]
+      ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []]
+      ["zen" "Zenaga" zenaga []]
+      ["zgh" "Standard Moroccan Tamazight" standard_moroccan_tamazight []]
+      ["zha" "Zhuang; Chuang" zhuang []]
+      ["zho" "Chinese" chinese []]
+      ["znd" "Zande languages" zande []]
+      ["zul" "Zulu" zulu []]
+      ["zun" "Zuni" zuni []]
+      ["zza" "Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]]])
+
+  (implementation: #export equivalence
+    (Equivalence Language)
+    
+    (def: (= reference sample)
+      (is? reference sample)))
+
+  (implementation: #export hash
+    (Hash Language)
+    
+    (def: &equivalence
+      ..equivalence)
+    
+    (def: hash
+      (|>> ..code
+           (\ text.hash hash))))
+  )
diff --git a/stdlib/source/library/lux/locale/territory.lux b/stdlib/source/library/lux/locale/territory.lux
new file mode 100644
index 000000000..be60b6734
--- /dev/null
+++ b/stdlib/source/library/lux/locale/territory.lux
@@ -0,0 +1,312 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]
+    [data
+     ["." text]]
+    [type
+     abstract]
+    [macro
+     ["." template]]]])
+
+## https://en.wikipedia.org/wiki/ISO_3166-1
+(abstract: #export Territory
+  {#name Text
+   #short Text
+   #long Text
+   #code Nat}
+
+  (template [  ]
+    [(def: #export 
+       (-> Territory )
+       (|>> :representation
+            (get@ )))]
+
+    [name         #name  Text]
+    [short_code   #short Text]
+    [long_code    #long  Text]
+    [numeric_code #code  Nat]
+    )
+
+  (template [    
 +]
+    [(def: #export 

+       Territory
+       (:abstraction {#name 
+                      #short 
+                      #long 
+                      #code }))
+
+     (`` (template []
+           [(def: #export  Territory 
)]
+
+           (~~ (template.splice +))))]
+
+    ["AF" "AFG" 004 "Afghanistan" afghanistan []]
+    ["AX" "ALA" 248 "Ã…land Islands" aland_islands []]
+    ["AL" "ALB" 008 "Albania" albania []]
+    ["DZ" "DZA" 012 "Algeria" algeria []]
+    ["AS" "ASM" 016 "American Samoa" american_samoa []]
+    ["AD" "AND" 020 "Andorra" andorra []]
+    ["AO" "AGO" 024 "Angola" angola []]
+    ["AI" "AIA" 660 "Anguilla" anguilla []]
+    ["AQ" "ATA" 010 "Antarctica" antarctica []]
+    ["AG" "ATG" 028 "Antigua and Barbuda" antigua [[barbuda]]]
+    ["AR" "ARG" 032 "Argentina" argentina []]
+    ["AM" "ARM" 051 "Armenia" armenia []]
+    ["AW" "ABW" 533 "Aruba" aruba []]
+    ["AU" "AUS" 036 "Australia" australia []]
+    ["AT" "AUT" 040 "Austria" austria []]
+    ["AZ" "AZE" 031 "Azerbaijan" azerbaijan []]
+    ["BS" "BHS" 044 "The Bahamas" the_bahamas []]
+    ["BH" "BHR" 048 "Bahrain" bahrain []]
+    ["BD" "BGD" 050 "Bangladesh" bangladesh []]
+    ["BB" "BRB" 052 "Barbados" barbados []]
+    ["BY" "BLR" 112 "Belarus" belarus []]
+    ["BE" "BEL" 056 "Belgium" belgium []]
+    ["BZ" "BLZ" 084 "Belize" belize []]
+    ["BJ" "BEN" 204 "Benin" benin []]
+    ["BM" "BMU" 060 "Bermuda" bermuda []]
+    ["BT" "BTN" 064 "Bhutan" bhutan []]
+    ["BO" "BOL" 068 "Bolivia" bolivia []]
+    ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint_eustatius] [saba]]]
+    ["BA" "BIH" 070 "Bosnia and Herzegovina" bosnia [[herzegovina]]]
+    ["BW" "BWA" 072 "Botswana" botswana []]
+    ["BV" "BVT" 074 "Bouvet Island" bouvet_island []]
+    ["BR" "BRA" 076 "Brazil" brazil []]
+    ["IO" "IOT" 086 "British Indian Ocean Territory" british_indian_ocean_territory []]
+    ["BN" "BRN" 096 "Brunei Darussalam" brunei_darussalam []]
+    ["BG" "BGR" 100 "Bulgaria" bulgaria []]
+    ["BF" "BFA" 854 "Burkina Faso" burkina_faso []]
+    ["BI" "BDI" 108 "Burundi" burundi []]
+    ["CV" "CPV" 132 "Cape Verde" cape_verde []]
+    ["KH" "KHM" 116 "Cambodia" cambodia []]
+    ["CM" "CMR" 120 "Cameroon" cameroon []]
+    ["CA" "CAN" 124 "Canada" canada []]
+    ["KY" "CYM" 136 "Cayman Islands" cayman_islands []]
+    ["CF" "CAF" 140 "Central African Republic" central_african_republic []]
+    ["TD" "TCD" 148 "Chad" chad []]
+    ["CL" "CHL" 152 "Chile" chile []]
+    ["CN" "CHN" 156 "China" china []]
+    ["CX" "CXR" 162 "Christmas Island" christmas_island []]
+    ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos_islands []]
+    ["CO" "COL" 170 "Colombia" colombia []]
+    ["KM" "COM" 174 "Comoros" comoros []]
+    ["CG" "COG" 178 "Congo" congo []]
+    ["CD" "COD" 180 "Democratic Republic of the Congo" democratic_republic_of_the_congo []]
+    ["CK" "COK" 184 "Cook Islands" cook_islands []]
+    ["CR" "CRI" 188 "Costa Rica" costa_rica []]
+    ["CI" "CIV" 384 "Ivory Coast" ivory_coast []]
+    ["HR" "HRV" 191 "Croatia" croatia []]
+    ["CU" "CUB" 192 "Cuba" cuba []]
+    ["CW" "CUW" 531 "Curacao" curacao []]
+    ["CY" "CYP" 196 "Cyprus" cyprus []]
+    ["CZ" "CZE" 203 "Czech Republic" czech_republic []]
+    ["DK" "DNK" 208 "Denmark" denmark []]
+    ["DJ" "DJI" 262 "Djibouti" djibouti []]
+    ["DM" "DMA" 212 "Dominica" dominica []]
+    ["DO" "DOM" 214 "Dominican Republic" dominican_republic []]
+    ["EC" "ECU" 218 "Ecuador" ecuador []]
+    ["EG" "EGY" 818 "Egypt" egypt []]
+    ["SV" "SLV" 222 "El Salvador" el_salvador []]
+    ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial_guinea []]
+    ["ER" "ERI" 232 "Eritrea" eritrea []]
+    ["EE" "EST" 233 "Estonia" estonia []]
+    ["SZ" "SWZ" 748 "Eswatini" eswatini []]
+    ["ET" "ETH" 231 "Ethiopia" ethiopia []]
+    ["FK" "FLK" 238 "Falkland Islands" falkland_islands []]
+    ["FO" "FRO" 234 "Faroe Islands" faroe_islands []]
+    ["FJ" "FJI" 242 "Fiji" fiji []]
+    ["FI" "FIN" 246 "Finland" finland []]
+    ["FR" "FRA" 250 "France" france []]
+    ["GF" "GUF" 254 "French Guiana" french_guiana []]
+    ["PF" "PYF" 258 "French Polynesia" french_polynesia []]
+    ["TF" "ATF" 260 "French Southern Territories" french_southern_territories []]
+    ["GA" "GAB" 266 "Gabon" gabon []]
+    ["GM" "GMB" 270 "The Gambia" the_gambia []]
+    ["GE" "GEO" 268 "Georgia" georgia []]
+    ["DE" "DEU" 276 "Germany" germany []]
+    ["GH" "GHA" 288 "Ghana" ghana []]
+    ["GI" "GIB" 292 "Gibraltar" gibraltar []]
+    ["GR" "GRC" 300 "Greece" greece []]
+    ["GL" "GRL" 304 "Greenland" greenland []]
+    ["GD" "GRD" 308 "Grenada" grenada []]
+    ["GP" "GLP" 312 "Guadeloupe" guadeloupe []]
+    ["GU" "GUM" 316 "Guam" guam []]
+    ["GT" "GTM" 320 "Guatemala" guatemala []]
+    ["GG" "GGY" 831 "Guernsey" guernsey []]
+    ["GN" "GIN" 324 "Guinea" guinea []]
+    ["GW" "GNB" 624 "Guinea-Bissau" guinea_bissau []]
+    ["GY" "GUY" 328 "Guyana" guyana []]
+    ["HT" "HTI" 332 "Haiti" haiti []]
+    ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard_island [[mcdonald_islands]]]
+    ["VA" "VAT" 336 "Vatican City" vatican_city []]
+    ["HN" "HND" 340 "Honduras" honduras []]
+    ["HK" "HKG" 344 "Hong Kong" hong_kong []]
+    ["HU" "HUN" 348 "Hungary" hungary []]
+    ["IS" "ISL" 352 "Iceland" iceland []]
+    ["IN" "IND" 356 "India" india []]
+    ["ID" "IDN" 360 "Indonesia" indonesia []]
+    ["IR" "IRN" 364 "Iran" iran []]
+    ["IQ" "IRQ" 368 "Iraq" iraq []]
+    ["IE" "IRL" 372 "Ireland" ireland []]
+    ["IM" "IMN" 833 "Isle of Man" isle_of_man []]
+    ["IL" "ISR" 376 "Israel" israel []]
+    ["IT" "ITA" 380 "Italy" italy []]
+    ["JM" "JAM" 388 "Jamaica" jamaica []]
+    ["JP" "JPN" 392 "Japan" japan []]
+    ["JE" "JEY" 832 "Jersey" jersey []]
+    ["JO" "JOR" 400 "Jordan" jordan []]
+    ["KZ" "KAZ" 398 "Kazakhstan" kazakhstan []]
+    ["KE" "KEN" 404 "Kenya" kenya []]
+    ["KI" "KIR" 296 "Kiribati" kiribati []]
+    ["KP" "PRK" 408 "North Korea" north_korea []]
+    ["KR" "KOR" 410 "South Korea" south_korea []]
+    ["KW" "KWT" 414 "Kuwait" kuwait []]
+    ["KG" "KGZ" 417 "Kyrgyzstan" kyrgyzstan []]
+    ["LA" "LAO" 418 "Laos" laos []]
+    ["LV" "LVA" 428 "Latvia" latvia []]
+    ["LB" "LBN" 422 "Lebanon" lebanon []]
+    ["LS" "LSO" 426 "Lesotho" lesotho []]
+    ["LR" "LBR" 430 "Liberia" liberia []]
+    ["LY" "LBY" 434 "Libya" libya []]
+    ["LI" "LIE" 438 "Liechtenstein" liechtenstein []]
+    ["LT" "LTU" 440 "Lithuania" lithuania []]
+    ["LU" "LUX" 442 "Luxembourg" luxembourg []]
+    ["MO" "MAC" 446 "Macau" macau []]
+    ["MK" "MKD" 807 "Macedonia" macedonia []]
+    ["MG" "MDG" 450 "Madagascar" madagascar []]
+    ["MW" "MWI" 454 "Malawi" malawi []]
+    ["MY" "MYS" 458 "Malaysia" malaysia []]
+    ["MV" "MDV" 462 "Maldives" maldives []]
+    ["ML" "MLI" 466 "Mali" mali []]
+    ["MT" "MLT" 470 "Malta" malta []]
+    ["MH" "MHL" 584 "Marshall Islands" marshall_islands []]
+    ["MQ" "MTQ" 474 "Martinique" martinique []]
+    ["MR" "MRT" 478 "Mauritania" mauritania []]
+    ["MU" "MUS" 480 "Mauritius" mauritius []]
+    ["YT" "MYT" 175 "Mayotte" mayotte []]
+    ["MX" "MEX" 484 "Mexico" mexico []]
+    ["FM" "FSM" 583 "Micronesia" micronesia []]
+    ["MD" "MDA" 498 "Moldova" moldova []]
+    ["MC" "MCO" 492 "Monaco" monaco []]
+    ["MN" "MNG" 496 "Mongolia" mongolia []]
+    ["ME" "MNE" 499 "Montenegro" montenegro []]
+    ["MS" "MSR" 500 "Montserrat" montserrat []]
+    ["MA" "MAR" 504 "Morocco" morocco []]
+    ["MZ" "MOZ" 508 "Mozambique" mozambique []]
+    ["MM" "MMR" 104 "Myanmar" myanmar []]
+    ["NA" "NAM" 516 "Namibia" namibia []]
+    ["NR" "NRU" 520 "Nauru" nauru []]
+    ["NP" "NPL" 524 "Nepal" nepal []]
+    ["NL" "NLD" 528 "Netherlands" netherlands []]
+    ["NC" "NCL" 540 "New Caledonia" new_caledonia []]
+    ["NZ" "NZL" 554 "New Zealand" new_zealand []]
+    ["NI" "NIC" 558 "Nicaragua" nicaragua []]
+    ["NE" "NER" 562 "Niger" niger []]
+    ["NG" "NGA" 566 "Nigeria" nigeria []]
+    ["NU" "NIU" 570 "Niue" niue []]
+    ["NF" "NFK" 574 "Norfolk Island" norfolk_island []]
+    ["MP" "MNP" 580 "Northern Mariana Islands" northern_mariana_islands []]
+    ["NO" "NOR" 578 "Norway" norway []]
+    ["OM" "OMN" 512 "Oman" oman []]
+    ["PK" "PAK" 586 "Pakistan" pakistan []]
+    ["PW" "PLW" 585 "Palau" palau []]
+    ["PS" "PSE" 275 "Palestine" palestine []]
+    ["PA" "PAN" 591 "Panama" panama []]
+    ["PG" "PNG" 598 "Papua New Guinea" papua_new_guinea []]
+    ["PY" "PRY" 600 "Paraguay" paraguay []]
+    ["PE" "PER" 604 "Peru" peru []]
+    ["PH" "PHL" 608 "Philippines" philippines []]
+    ["PN" "PCN" 612 "Pitcairn Islands" pitcairn_islands []]
+    ["PL" "POL" 616 "Poland" poland []]
+    ["PT" "PRT" 620 "Portugal" portugal []]
+    ["PR" "PRI" 630 "Puerto Rico" puerto_rico []]
+    ["QA" "QAT" 634 "Qatar" qatar []]
+    ["RE" "REU" 638 "Reunion" reunion []]
+    ["RO" "ROU" 642 "Romania" romania []]
+    ["RU" "RUS" 643 "Russia" russia []]
+    ["RW" "RWA" 646 "Rwanda" rwanda []]
+    ["BL" "BLM" 652 "Saint Barthélemy" saint_barthelemy []]
+    ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint_helena [[ascension] [tristan_da_cunha]]]
+    ["KN" "KNA" 659 "Saint Kitts and Nevis" saint_kitts [[nevis]]]
+    ["LC" "LCA" 662 "Saint Lucia" saint_lucia []]
+    ["MF" "MAF" 663 "Saint Martin" saint_martin []]
+    ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint_pierre [[miquelon]]]
+    ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint_vincent [[the_grenadines]]]
+    ["WS" "WSM" 882 "Samoa" samoa []]
+    ["SM" "SMR" 674 "San Marino" san_marino []]
+    ["ST" "STP" 678 "Sao Tome and Principe" sao_tome [[principe]]]
+    ["SA" "SAU" 682 "Saudi Arabia" saudi_arabia []]
+    ["SN" "SEN" 686 "Senegal" senegal []]
+    ["RS" "SRB" 688 "Serbia" serbia []]
+    ["SC" "SYC" 690 "Seychelles" seychelles []]
+    ["SL" "SLE" 694 "Sierra Leone" sierra_leone []]
+    ["SG" "SGP" 702 "Singapore" singapore []]
+    ["SX" "SXM" 534 "Sint Maarten" sint_maarten []]
+    ["SK" "SVK" 703 "Slovakia" slovakia []]
+    ["SI" "SVN" 705 "Slovenia" slovenia []]
+    ["SB" "SLB" 090 "Solomon Islands" solomon_islands []]
+    ["SO" "SOM" 706 "Somalia" somalia []]
+    ["ZA" "ZAF" 710 "South Africa" south_africa []]
+    ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south_georgia [[south_sandwich_islands]]]
+    ["SS" "SSD" 728 "South Sudan" south_sudan []]
+    ["ES" "ESP" 724 "Spain" spain []]
+    ["LK" "LKA" 144 "Sri Lanka" sri_lanka []]
+    ["SD" "SDN" 729 "Sudan" sudan []]
+    ["SR" "SUR" 740 "Suriname" suriname []]
+    ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan_mayen]]]
+    ["SE" "SWE" 752 "Sweden" sweden []]
+    ["CH" "CHE" 756 "Switzerland" switzerland []]
+    ["SY" "SYR" 760 "Syria" syria []]
+    ["TW" "TWN" 158 "Taiwan" taiwan []]
+    ["TJ" "TJK" 762 "Tajikistan" tajikistan []]
+    ["TZ" "TZA" 834 "Tanzania" tanzania []]
+    ["TH" "THA" 764 "Thailand" thailand []]
+    ["TL" "TLS" 626 "East Timor" east_timor []]
+    ["TG" "TGO" 768 "Togo" togo []]
+    ["TK" "TKL" 772 "Tokelau" tokelau []]
+    ["TO" "TON" 776 "Tonga" tonga []]
+    ["TT" "TTO" 780 "Trinidad and Tobago" trinidad [[tobago]]]
+    ["TN" "TUN" 788 "Tunisia" tunisia []]
+    ["TR" "TUR" 792 "Turkey" turkey []]
+    ["TM" "TKM" 795 "Turkmenistan" turkmenistan []]
+    ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos_islands]]]
+    ["TV" "TUV" 798 "Tuvalu" tuvalu []]
+    ["UG" "UGA" 800 "Uganda" uganda []]
+    ["UA" "UKR" 804 "Ukraine" ukraine []]
+    ["AE" "ARE" 784 "United Arab Emirates" united_arab_emirates []]
+    ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united_kingdom [[northern_ireland]]]
+    ["US" "USA" 840 "United States of America" united_states_of_america []]
+    ["UM" "UMI" 581 "United States Minor Outlying Islands" united_states_minor_outlying_islands []]
+    ["UY" "URY" 858 "Uruguay" uruguay []]
+    ["UZ" "UZB" 860 "Uzbekistan" uzbekistan []]
+    ["VU" "VUT" 548 "Vanuatu" vanuatu []]
+    ["VE" "VEN" 862 "Venezuela" venezuela []]
+    ["VN" "VNM" 704 "Vietnam" vietnam []]
+    ["VG" "VGB" 092 "British Virgin Islands" british_virgin_islands []]
+    ["VI" "VIR" 850 "United States Virgin Islands" united_states_virgin_islands []]
+    ["WF" "WLF" 876 "Wallis and Futuna" wallis [[futuna]]]
+    ["EH" "ESH" 732 "Western Sahara" western_sahara []]
+    ["YE" "YEM" 887 "Yemen" yemen []]
+    ["ZM" "ZMB" 894 "Zambia" zambia []]
+    ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []]
+    )
+
+  (implementation: #export equivalence
+    (Equivalence Territory)
+    
+    (def: (= reference sample)
+      (is? reference sample)))
+
+  (implementation: #export hash
+    (Hash Territory)
+    
+    (def: &equivalence ..equivalence)
+    
+    (def: hash
+      (|>> :representation
+           (get@ #long)
+           (\ text.hash hash))))
+  )
diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux
new file mode 100644
index 000000000..c446dfa70
--- /dev/null
+++ b/stdlib/source/library/lux/macro.lux
@@ -0,0 +1,210 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." monad (#+ do)]]
+    [data
+     ["." text ("#\." monoid)]
+     ["." name ("#\." codec)]
+     [collection
+      ["." list ("#\." monoid monad)]]]
+    [macro
+     ["." code]]
+    [math
+     [number
+      ["." nat]
+      ["." int]]]]]
+  ["." // #_
+   ["#" meta
+    ["." location]]])
+
+(def: #export (expand_once syntax)
+  {#.doc (doc "Given code that requires applying a macro, does it once and returns the result."
+              "Otherwise, returns the code as-is.")}
+  (-> Code (Meta (List Code)))
+  (case syntax
+    [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
+    (do //.monad
+      [?macro (//.find_macro name)]
+      (case ?macro
+        (#.Some macro)
+        ((:as Macro' macro) args)
+        
+        #.None
+        (\ //.monad wrap (list syntax))))
+
+    _
+    (\ //.monad wrap (list syntax))))
+
+(def: #export (expand syntax)
+  {#.doc (doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left."
+              "Otherwise, returns the code as-is.")}
+  (-> Code (Meta (List Code)))
+  (case syntax
+    [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
+    (do //.monad
+      [?macro (//.find_macro name)]
+      (case ?macro
+        (#.Some macro)
+        (do //.monad
+          [expansion ((:as Macro' macro) args)
+           expansion' (monad.map //.monad expand expansion)]
+          (wrap (list\join expansion')))
+        
+        #.None
+        (\ //.monad wrap (list syntax))))
+
+    _
+    (\ //.monad wrap (list syntax))))
+
+(def: #export (expand_all syntax)
+  {#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."}
+  (-> Code (Meta (List Code)))
+  (case syntax
+    [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))]
+    (do //.monad
+      [?macro (//.find_macro name)]
+      (case ?macro
+        (#.Some macro)
+        (do //.monad
+          [expansion ((:as Macro' macro) args)
+           expansion' (monad.map //.monad expand_all expansion)]
+          (wrap (list\join expansion')))
+        
+        #.None
+        (do //.monad
+          [parts' (monad.map //.monad expand_all (list& (code.identifier name) args))]
+          (wrap (list (code.form (list\join parts')))))))
+
+    [_ (#.Form (#.Cons [harg targs]))]
+    (do //.monad
+      [harg+ (expand_all harg)
+       targs+ (monad.map //.monad expand_all targs)]
+      (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+)))))))
+
+    [_ (#.Tuple members)]
+    (do //.monad
+      [members' (monad.map //.monad expand_all members)]
+      (wrap (list (code.tuple (list\join members')))))
+
+    [_ (#.Record members)]
+    (|> members
+        (monad.map //.monad
+                   (function (_ [left right])
+                     (do //.monad
+                       [left (expand_all left)
+                        right (expand_all right)]
+                       (case [left right]
+                         [(#.Cons left #.Nil) (#.Cons right #.Nil)]
+                         (wrap [left right])
+
+                         _
+                         (//.fail "Record members must expand into singletons.")))))
+        (\ //.monad map (|>> code.record list)))
+
+    _
+    (\ //.monad wrap (list syntax))))
+
+(def: #export (gensym prefix)
+  {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)."
+              "A prefix can be given (or just be empty text) to better identify the code for debugging purposes.")}
+  (-> Text (Meta Code))
+  (do //.monad
+    [id //.count]
+    (wrap (|> id
+              (\ nat.decimal encode)
+              ($_ text\compose "__gensym__" prefix)
+              [""] code.identifier))))
+
+(def: (get_local_identifier ast)
+  (-> Code (Meta Text))
+  (case ast
+    [_ (#.Identifier [_ name])]
+    (\ //.monad wrap name)
+
+    _
+    (//.fail (text\compose "Code is not a local identifier: " (code.format ast)))))
+
+(def: #export wrong_syntax_error
+  (-> Name Text)
+  (|>> name\encode
+       (text\compose "Wrong syntax for ")))
+
+(macro: #export (with_gensyms tokens)
+  {#.doc (doc "Creates new identifiers 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 [_ (#.Tuple identifiers)] body))
+    (do {! //.monad}
+      [identifier_names (monad.map ! ..get_local_identifier identifiers)
+       #let [identifier_defs (list\join (list\map (: (-> Text (List Code))
+                                                     (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name)))))))
+                                                  identifier_names))]]
+      (wrap (list (` ((~! do) (~! //.monad)
+                      [(~+ identifier_defs)]
+                      (~ body))))))
+
+    _
+    (//.fail (..wrong_syntax_error (name_of ..with_gensyms)))))
+
+(def: #export (expand_1 token)
+  {#.doc "Works just like expand, except that it ensures that the output is a single Code token."}
+  (-> Code (Meta Code))
+  (do //.monad
+    [token+ (..expand token)]
+    (case token+
+      (^ (list token'))
+      (wrap token')
+
+      _
+      (//.fail "Macro expanded to more than 1 element."))))
+
+(template [ ]
+  [(macro: #export ( tokens)
+     {#.doc (doc "Performs a macro-expansion and logs the resulting code."
+                 "You can either use the resulting code, or omit them."
+                 "By omitting them, this macro produces nothing (just like the lux.comment macro)."
+                 ( #omit
+                          (def: (foo bar baz)
+                            (-> Int Int Int)
+                            (int.+ bar baz))))}
+     (let [[module _] (name_of .._)
+           [_ short] (name_of )
+           macro_name [module short]]
+       (case (: (Maybe [Bit Code])
+                (case tokens
+                  (^ (list [_ (#.Tag ["" "omit"])]
+                           token))
+                  (#.Some [#1 token])
+
+                  (^ (list token))
+                  (#.Some [#0 token])
+
+                  _
+                  #.None))
+         (#.Some [omit? token])
+         (do //.monad
+           [location //.location
+            output ( token)
+            #let [_ ("lux io log" ($_ text\compose (name\encode macro_name) " " (location.format location)))
+                  _ (list\map (|>> code.format "lux io log")
+                              output)
+                  _ ("lux io log" "")]]
+           (wrap (if omit?
+                   (list)
+                   output)))
+
+         #.None
+         (//.fail (..wrong_syntax_error macro_name)))))]
+
+  [log_expand_once! expand_once]
+  [log_expand!      expand]
+  [log_expand_all!  expand_all]
+  )
diff --git a/stdlib/source/library/lux/macro/code.lux b/stdlib/source/library/lux/macro/code.lux
new file mode 100644
index 000000000..ec99f68a4
--- /dev/null
+++ b/stdlib/source/library/lux/macro/code.lux
@@ -0,0 +1,161 @@
+(.module:
+  [library
+   [lux (#- nat int rev)
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." product]
+     ["." bit]
+     ["." name]
+     ["." text ("#\." monoid equivalence)]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [math
+     [number
+      ["." nat]
+      ["." int]
+      ["." rev]
+      ["." frac]]]
+    [meta
+     ["." location]]]])
+
+## (type: (Code' w)
+##   (#.Bit Bit)
+##   (#.Nat Nat)
+##   (#.Int Int)
+##   (#.Rev Rev)
+##   (#.Frac Frac)
+##   (#.Text Text)
+##   (#.Identifier Name)
+##   (#.Tag Name)
+##   (#.Form (List (w (Code' w))))
+##   (#.Tuple (List (w (Code' w))))
+##   (#.Record (List [(w (Code' w)) (w (Code' w))])))
+
+## (type: Code
+##   (Ann Location (Code' (Ann Location))))
+
+(template [  ]
+  [(def: #export ( x)
+     (->  Code)
+     [location.dummy ( x)])]
+  
+  [bit        Bit                #.Bit]
+  [nat        Nat                #.Nat]
+  [int        Int                #.Int]
+  [rev        Rev                #.Rev]
+  [frac       Frac               #.Frac]
+  [text       Text               #.Text]
+  [identifier Name               #.Identifier]
+  [tag        Name               #.Tag]
+  [form       (List Code)        #.Form]
+  [tuple      (List Code)        #.Tuple]
+  [record     (List [Code Code]) #.Record]
+  )
+
+(template [  ]
+  [(def: #export ( name)
+     {#.doc }
+     (-> Text Code)
+     [location.dummy ( ["" name])])]
+
+  [local_identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."]
+  [local_tag        #.Tag        "Produces a local tag (a tag with no module prefix)."])
+
+(implementation: #export equivalence
+  (Equivalence Code)
+  
+  (def: (= x y)
+    (case [x y]
+      (^template [ ]
+        [[[_ ( x')] [_ ( y')]]
+         (\  = x' y')])
+      ([#.Bit        bit.equivalence]
+       [#.Nat        nat.equivalence]
+       [#.Int        int.equivalence]
+       [#.Rev        rev.equivalence]
+       [#.Frac       frac.equivalence]
+       [#.Text       text.equivalence]
+       [#.Identifier name.equivalence]
+       [#.Tag        name.equivalence])
+
+      (^template []
+        [[[_ ( xs')] [_ ( ys')]]
+         (\ (list.equivalence =) = xs' ys')])
+      ([#.Form]
+       [#.Tuple])
+
+      [[_ (#.Record xs')] [_ (#.Record ys')]]
+      (\ (list.equivalence (product.equivalence = =))
+         = xs' ys')
+      
+      _
+      false)))
+
+(def: #export (format ast)
+  (-> Code Text)
+  (case ast
+    (^template [ ]
+      [[_ ( value)]
+       (\  encode value)])
+    ([#.Bit        bit.codec]
+     [#.Nat        nat.decimal]
+     [#.Int        int.decimal]
+     [#.Rev        rev.decimal]
+     [#.Frac       frac.decimal]
+     [#.Identifier name.codec])
+
+    [_ (#.Text value)]
+    (text.format value)
+
+    [_ (#.Tag name)]
+    (text\compose  "#" (\ name.codec encode name))
+
+    (^template [  ]
+      [[_ ( members)]
+       ($_ text\compose
+           
+           (list\fold (function (_ next prev)
+                        (let [next (format next)]
+                          (if (text\= "" prev)
+                            next
+                            ($_ text\compose prev " " next))))
+                      ""
+                      members)
+           )])
+    ([#.Form  "(" ")"]
+     [#.Tuple "[" "]"])
+
+    [_ (#.Record pairs)]
+    ($_ text\compose
+        "{"
+        (list\fold (function (_ [left right] prev)
+                     (let [next ($_ text\compose (format left) " " (format right))]
+                       (if (text\= "" prev)
+                         next
+                         ($_ text\compose prev " " next))))
+                   ""
+                   pairs)
+        "}")
+    ))
+
+(def: #export (replace original substitute ast)
+  {#.doc "Replaces all code that looks like the 'original' with the 'substitute'."}
+  (-> Code Code Code Code)
+  (if (\ ..equivalence = original ast)
+    substitute
+    (case ast
+      (^template []
+        [[location ( parts)]
+         [location ( (list\map (replace original substitute) parts))]])
+      ([#.Form]
+       [#.Tuple])
+
+      [location (#.Record parts)]
+      [location (#.Record (list\map (function (_ [left right])
+                                      [(replace original substitute left)
+                                       (replace original substitute right)])
+                                    parts))]
+
+      _
+      ast)))
diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux
new file mode 100644
index 000000000..4eb9c35c6
--- /dev/null
+++ b/stdlib/source/library/lux/macro/local.lux
@@ -0,0 +1,106 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]]
+    [data
+     ["." product]
+     ["." text]
+     [collection
+      ["." list ("#\." functor)]
+      [dictionary
+       ["." plist (#+ PList)]]]]]]
+  ["." //
+   ["#." code]])
+
+(exception: #export (unknown_module {module Text})
+  (exception.report
+   ["Module" (text.format module)]))
+
+(template []
+  [(exception: #export ( {module Text} {definition Text})
+     (exception.report
+      ["Module" (text.format module)]
+      ["Definition" (text.format definition)]))]
+
+  [cannot_shadow_definition]
+  [unknown_definition]
+  )
+
+(def: (with_module name body)
+  (All [a] (-> Text (-> Module (Try [Module a])) (Meta a)))
+  (function (_ compiler)
+    (case (|> compiler (get@ #.modules) (plist.get name))
+      (#.Some module)
+      (case (body module)
+        (#try.Success [module' output])
+        (#try.Success [(update@ #.modules (plist.put name module') compiler)
+                       output])
+        
+        (#try.Failure error)
+        (#try.Failure error))
+
+      #.None
+      (exception.throw ..unknown_module [name]))))
+
+(def: (push_one [name macro])
+  (-> [Name Macro] (Meta Any))
+  (do meta.monad
+    [[module_name definition_name] (meta.normalize name)
+     #let [definition (: Global (#.Definition [false .Macro (' {}) macro]))
+           add_macro! (: (-> (PList Global) (PList Global))
+                         (plist.put definition_name definition))]]
+    (..with_module module_name
+      (function (_ module)
+        (case (|> module (get@ #.definitions) (plist.get definition_name))
+          #.None
+          (#try.Success [(update@ #.definitions add_macro! module)
+                         []])
+          
+          (#.Some _)
+          (exception.throw ..cannot_shadow_definition [module_name definition_name]))))))
+
+(def: (pop_one name)
+  (-> Name (Meta Any))
+  (do meta.monad
+    [[module_name definition_name] (meta.normalize name)
+     #let [remove_macro! (: (-> (PList Global) (PList Global))
+                            (plist.remove definition_name))]]
+    (..with_module module_name
+      (function (_ module)
+        (case (|> module (get@ #.definitions) (plist.get definition_name))
+          (#.Some _)
+          (#try.Success [(update@ #.definitions remove_macro! module)
+                         []])
+
+          #.None
+          (exception.throw ..unknown_definition [module_name definition_name]))))))
+
+(def: (pop_all macros self)
+  (-> (List Name) Name Macro)
+  ("lux macro"
+   (function (_ _)
+     (do {! meta.monad}
+       [_ (monad.map ! ..pop_one macros)
+        _ (..pop_one self)
+        compiler meta.get_compiler]
+       (wrap (case (get@ #.expected compiler)
+               (#.Some _)
+               (list (' []))
+               
+               #.None
+               (list)))))))
+
+(def: #export (push macros)
+  (-> (List [Name Macro]) (Meta Code))
+  (do meta.monad
+    [_ (monad.map meta.monad ..push_one macros)
+     seed meta.count
+     g!pop (//.gensym "pop")
+     _ (let [g!pop (: Name ["" (//code.format g!pop)])]
+         (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))]
+    (wrap (` ((~ g!pop))))))
diff --git a/stdlib/source/library/lux/macro/poly.lux b/stdlib/source/library/lux/macro/poly.lux
new file mode 100644
index 000000000..5ce420e7a
--- /dev/null
+++ b/stdlib/source/library/lux/macro/poly.lux
@@ -0,0 +1,128 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    ["." type]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["p" parser
+      ["<.>" type (#+ Env)]
+      ["s" code]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text]
+     [collection
+      ["." list ("#\." fold functor)]
+      ["." dictionary]]]
+    [macro (#+ with_gensyms)
+     ["." code]
+     [syntax (#+ syntax:)
+      ["|.|" export]]]
+    [math
+     [number
+      ["n" nat]]]]])
+
+(syntax: #export (poly: {export |export|.parser}
+                   {name s.local_identifier}
+                   body)
+  (with_gensyms [g!_ g!type g!output]
+    (let [g!name (code.identifier ["" name])]
+      (wrap (.list (` ((~! syntax:) (~+ (|export|.format export)) ((~ g!name) {(~ g!type) (~! s.identifier)})
+                       ((~! do) (~! meta.monad)
+                        [(~ g!type) ((~! meta.find_type_def) (~ g!type))]
+                        (case (: (.Either .Text .Code)
+                                 ((~! .run) ((~! p.rec)
+                                                   (function ((~ g!_) (~ g!name))
+                                                     (~ body)))
+                                  (~ g!type)))
+                          (#.Left (~ g!output))
+                          ((~! meta.fail) (~ g!output))
+
+                          (#.Right (~ g!output))
+                          ((~' wrap) (.list (~ g!output))))))))))))
+
+(def: (common_poly_name? poly_func)
+  (-> Text Bit)
+  (text.contains? "?" poly_func))
+
+(def: (derivation_name poly args)
+  (-> Text (List Text) (Maybe Text))
+  (if (common_poly_name? poly)
+    (#.Some (list\fold (text.replace_once "?") poly args))
+    #.None))
+
+(syntax: #export (derived: {export |export|.parser}
+                   {?name (p.maybe s.local_identifier)}
+                   {[poly_func poly_args] (s.form (p.and s.identifier (p.many s.identifier)))}
+                   {?custom_impl (p.maybe s.any)})
+  (do {! meta.monad}
+    [poly_args (monad.map ! meta.normalize poly_args)
+     name (case ?name
+            (#.Some name)
+            (wrap name)
+
+            (^multi #.None
+                    [(derivation_name (product.right poly_func) (list\map product.right poly_args))
+                     (#.Some derived_name)])
+            (wrap derived_name)
+
+            _
+            (p.fail "derived: was given no explicit name, and cannot generate one from given information."))
+     #let [impl (case ?custom_impl
+                  (#.Some custom_impl)
+                  custom_impl
+
+                  #.None
+                  (` ((~ (code.identifier poly_func)) (~+ (list\map code.identifier poly_args)))))]]
+    (wrap (.list (` (def: (~+ (|export|.format export))
+                      (~ (code.identifier ["" name]))
+                      {#.implementation? #1}
+                      (~ impl)))))))
+
+(def: #export (to_code env type)
+  (-> Env Type Code)
+  (`` (case type
+        (#.Primitive name params)
+        (` (#.Primitive (~ (code.text name))
+                        (list (~+ (list\map (to_code env) params)))))
+
+        (^template []
+          [( idx)
+           (` ( (~ (code.nat idx))))])
+        ([#.Var] [#.Ex])
+
+        (#.Parameter idx)
+        (let [idx (.adjusted_idx env idx)]
+          (if (n.= 0 idx)
+            (|> (dictionary.get idx env) maybe.assume product.left (to_code env))
+            (` (.$ (~ (code.nat (dec idx)))))))
+
+        (#.Apply (#.Named [(~~ (static .prelude_module)) "Nothing"] _) (#.Parameter idx))
+        (let [idx (.adjusted_idx env idx)]
+          (if (n.= 0 idx)
+            (|> (dictionary.get idx env) maybe.assume product.left (to_code env))
+            (undefined)))
+        
+        (^template []
+          [( left right)
+           (` ( (~ (to_code env left))
+                     (~ (to_code env right))))])
+        ([#.Function] [#.Apply])
+
+        (^template [  ]
+          [( left right)
+           (` ( (~+ (list\map (to_code env) ( type)))))])
+        ([| #.Sum type.flatten_variant]
+         [& #.Product type.flatten_tuple])
+
+        (#.Named name sub_type)
+        (code.identifier name)
+
+        (^template []
+          [( scope body)
+           (` ( (list (~+ (list\map (to_code env) scope)))
+                     (~ (to_code env body))))])
+        ([#.UnivQ] [#.ExQ])
+        )))
diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux
new file mode 100644
index 000000000..c2ddeefe5
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax.lux
@@ -0,0 +1,129 @@
+(.module:
+  [library
+   [lux #*
+    ["." macro (#+ with_gensyms)]
+    ["." meta]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["." try]
+     ["<>" parser
+      ["" code (#+ Parser)]]]
+    [data
+     ["." maybe]
+     ["." text ("#\." monoid)]
+     [collection
+      ["." list ("#\." functor)]]]
+    [math
+     [number
+      ["." nat]
+      ["." int]
+      ["." rev]
+      ["." frac]]]]]
+  [//
+   ["." code]])
+
+(def: (self_documenting binding parser)
+  (All [a] (-> Code (Parser a) (Parser a)))
+  (function (_ tokens)
+    (case (parser tokens)
+      (#try.Success [tokens output])
+      (#try.Success [tokens output])
+      
+      (#try.Failure error)
+      (#try.Failure ($_ text\compose
+                        "Failed to parse: " (code.format binding) text.new_line
+                        error)))))
+
+(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'))))
+
+(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 Meta 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\compose "anon-class:"
+                                   (spaced (list (super_class_decl$ (maybe.default object_super_class super))
+                                                 (with_brackets (spaced (list\map super_class_decl$ interfaces)))
+                                                 (with_brackets (spaced (list\map constructor_arg$ constructor_args)))
+                                                 (with_brackets (spaced (list\map (method_def$ id) methods))))))]
+                  (wrap (list (` ((~ (code.text def_code)))))))))}
+  (let [[exported? tokens] (: [Bit (List Code)]
+                              (case tokens
+                                (^ (list& [_ (#.Tag ["" "export"])] tokens'))
+                                [#1 tokens']
+
+                                _
+                                [#0 tokens]))
+        ?parts (: (Maybe [Text (List Code) Code Code])
+                  (case tokens
+                    (^ (list [_ (#.Form (list& [_ (#.Identifier ["" name])] args))]
+                             body))
+                    (#.Some name args (` {}) body)
+
+                    (^ (list [_ (#.Form (list& [_ (#.Identifier ["" 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!error]
+        (do {! meta.monad}
+          [vars+parsers (monad.map !
+                                   (: (-> Code (Meta [Code Code]))
+                                      (function (_ arg)
+                                        (case arg
+                                          (^ [_ (#.Record (list [var parser]))])
+                                          (case var
+                                            [_ (#.Tag ["" "let"])]
+                                            (wrap [var parser])
+
+                                            _
+                                            (wrap [var
+                                                   (` ((~! ..self_documenting) (' (~ var))
+                                                       (~ parser)))]))
+
+                                          [_ (#.Identifier var_name)]
+                                          (wrap [arg
+                                                 (` ((~! ..self_documenting) (' (~ arg))
+                                                     (~! .any)))])
+
+                                          _
+                                          (meta.fail "Syntax pattern expects records or identifiers."))))
+                                   args)
+           this_module meta.current_module_name
+           #let [g!state (code.identifier ["" "*compiler*"])
+                 error_msg (code.text (macro.wrong_syntax_error [this_module name]))
+                 export_ast (: (List Code)
+                               (if exported?
+                                 (list (' #export))
+                                 (list)))]]
+          (wrap (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state))
+                           (~ meta)
+                           ({(#.Right (~ g!body))
+                             ((~ g!body) (~ g!state))
+
+                             (#.Left (~ g!error))
+                             (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))}
+                            ((~! .run)
+                             (: ((~! .Parser) (Meta (List Code)))
+                                ((~! do) (~! <>.monad)
+                                 [(~+ (..join_pairs vars+parsers))]
+                                 ((~' wrap) (~ body))))
+                             (~ g!tokens)))))))))
+      
+      _
+      (meta.fail (macro.wrong_syntax_error (name_of ..syntax:))))))
diff --git a/stdlib/source/library/lux/macro/syntax/annotations.lux b/stdlib/source/library/lux/macro/syntax/annotations.lux
new file mode 100644
index 000000000..28f5a233e
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/annotations.lux
@@ -0,0 +1,42 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["." function]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." name]
+     [collection
+      ["." list ("#\." functor)]]]
+    [macro
+     ["." code]]]])
+
+(type: #export Annotations
+  (List [Name Code]))
+
+(def: #export equivalence
+  (Equivalence Annotations)
+  (list.equivalence
+   (product.equivalence name.equivalence
+                        code.equivalence)))
+
+(def: #export empty
+  Annotations
+  (list))
+
+(def: #export format
+  (-> Annotations Code)
+  (let [entry (product.apply code.tag function.identity)]
+    (|>> (list\map entry)
+         code.record)))
+
+(def: #export parser
+  (Parser Annotations)
+  (.record
+   (<>.some
+    (<>.and .tag
+            .any))))
diff --git a/stdlib/source/library/lux/macro/syntax/check.lux b/stdlib/source/library/lux/macro/syntax/check.lux
new file mode 100644
index 000000000..bd4214eab
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/check.lux
@@ -0,0 +1,42 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [monad (#+ do)]]
+    [control
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]]
+    [macro
+     ["." code]]]])
+
+(def: extension
+  "lux check")
+
+(type: #export Check
+  {#type Code
+   #value Code})
+
+(def: #export equivalence
+  (Equivalence Check)
+  ($_ product.equivalence
+      code.equivalence
+      code.equivalence
+      ))
+
+(def: #export (format (^slots [#type #value]))
+  (-> Check Code)
+  (` ((~ (code.text ..extension))
+      (~ type)
+      (~ value))))
+
+(def: #export parser
+  (Parser Check)
+  (<| .form
+      (<>.after (.text! ..extension))
+      (<>.and .any
+              .any)))
diff --git a/stdlib/source/library/lux/macro/syntax/declaration.lux b/stdlib/source/library/lux/macro/syntax/declaration.lux
new file mode 100644
index 000000000..d1c7d94c6
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/declaration.lux
@@ -0,0 +1,47 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." text]
+     [collection
+      ["." list ("#\." functor)]]]
+    [macro
+     ["." code]]]])
+
+(type: #export Declaration
+  {#name Text
+   #arguments (List Text)})
+
+(def: #export equivalence
+  (Equivalence Declaration)
+  ($_ product.equivalence
+      text.equivalence
+      (list.equivalence text.equivalence)
+      ))
+
+(def: #export parser
+  {#.doc (doc "A parser for declaration syntax."
+              "Such as:"
+              quux
+              (foo bar baz))}
+  (Parser Declaration)
+  (<>.either (<>.and .local_identifier
+                     (<>\wrap (list)))
+             (.form (<>.and .local_identifier
+                                  (<>.some .local_identifier)))))
+
+(def: #export (format value)
+  (-> Declaration Code)
+  (let [g!name (code.local_identifier (get@ #name value))]
+    (case (get@ #arguments value)
+      #.Nil
+      g!name
+      
+      arguments
+      (` ((~ g!name) (~+ (list\map code.local_identifier arguments)))))))
diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux
new file mode 100644
index 000000000..1e309a306
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/definition.lux
@@ -0,0 +1,141 @@
+(.module:
+  [library
+   [lux (#- Definition)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [monad (#+ do)]]
+    [control
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." sum]
+     ["." product]
+     ["." bit]
+     ["." name]
+     ["." text
+      ["%" format]]
+     [collection
+      ["." list]]]
+    ["." macro
+     ["." code]]
+    ["." meta
+     ["." location]]]]
+  ["." //
+   ["#." annotations (#+ Annotations)]
+   ["#." check (#+ Check)]])
+
+(type: #export Definition
+  {#name Text
+   #value (Either Check
+                  Code)
+   #anns Annotations
+   #export? Bit})
+
+(def: #export equivalence
+  (Equivalence Definition)
+  ($_ product.equivalence
+      text.equivalence
+      ($_ sum.equivalence
+          //check.equivalence
+          code.equivalence
+          )
+      //annotations.equivalence
+      bit.equivalence
+      ))
+
+(def: extension
+  "lux def")
+
+(def: (format_tag [module short])
+  (-> Name Code)
+  (` [(~ (code.text module))
+      (~ (code.text short))]))
+
+(def: (format_annotations value)
+  (-> Annotations Code)
+  (case value
+    #.Nil
+    (` #.Nil)
+    
+    (#.Cons [name value] tail)
+    (` (#.Cons [(~ (..format_tag name))
+                (~ value)]
+               (~ (format_annotations tail))))))
+
+(def: dummy
+  Code
+  (` {#.module (~ (code.text (get@ #.module location.dummy)))
+      #.line   (~ (code.nat (get@ #.line location.dummy)))
+      #.column (~ (code.nat (get@ #.column location.dummy)))}))
+
+(def: #export (format (^slots [#name #value #anns #export?]))
+  (-> Definition Code)
+  (` ((~ (code.text ..extension))
+      (~ (code.local_identifier name))
+      (~ (case value
+           (#.Left check)
+           (//check.format check)
+
+           (#.Right value)
+           value))
+      [(~ ..dummy) (#.Record (~ (..format_annotations anns)))]
+      (~ (code.bit export?)))))
+
+(def: tag_parser
+  (Parser Name)
+  (.tuple (<>.and .text .text)))
+
+(def: annotations_parser
+  (Parser Annotations)
+  (<>.rec
+   (function (_ recur)
+     ($_ <>.or
+         (.tag! (name_of #.Nil))
+         (.form (do <>.monad
+                        [_ (.tag! (name_of #.Cons))
+                         [head tail] (<>.and (.tuple (<>.and tag_parser .any))
+                                             recur)]
+                        (wrap [head tail])))
+         ))))
+
+(def: #export (parser compiler)
+  {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
+  (-> Lux (Parser Definition))
+  (do {! <>.monad}
+    [raw .any
+     me_raw (|> raw
+                macro.expand_all
+                (meta.run compiler)
+                <>.lift)]
+    (<| (.local me_raw)
+        .form
+        (<>.after (.text! ..extension))
+        ($_ <>.and
+            .local_identifier
+            (<>.or //check.parser
+                   .any)
+            (<| .tuple
+                (<>.after .any)
+                .form
+                (<>.after (.this! (` #.Record)))
+                ..annotations_parser)
+            .bit
+            ))))
+
+(exception: #export (lacks_type! {definition Definition})
+  (exception.report
+   ["Definition" (%.code (..format definition))]))
+
+(def: #export (typed compiler)
+  {#.doc "Only works for typed definitions."}
+  (-> Lux (Parser Definition))
+  (do <>.monad
+    [definition (..parser compiler)
+     _ (case (get@ #value definition)
+         (#.Left _)
+         (wrap [])
+
+         (#.Right _)
+         (<>.lift (exception.throw ..lacks_type! [definition])))]
+    (wrap definition)))
diff --git a/stdlib/source/library/lux/macro/syntax/export.lux b/stdlib/source/library/lux/macro/syntax/export.lux
new file mode 100644
index 000000000..d76aa6fcc
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/export.lux
@@ -0,0 +1,21 @@
+(.module:
+  [library
+   [lux #*
+    [control
+     ["<>" parser ("#\." monad)
+      ["<.>" code (#+ Parser)]]]]])
+
+(def: token
+  (' #export))
+
+(def: #export (format exported?)
+  (-> Bit (List Code))
+  (if exported?
+    (list ..token)
+    (list)))
+
+(def: #export parser
+  (Parser Bit)
+  (<>.either (<>.after (.this! ..token)
+                       (<>\wrap true))
+             (<>\wrap false)))
diff --git a/stdlib/source/library/lux/macro/syntax/input.lux b/stdlib/source/library/lux/macro/syntax/input.lux
new file mode 100644
index 000000000..9307322d9
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/input.lux
@@ -0,0 +1,38 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]]
+    [macro
+     ["." code]]]])
+
+(type: #export Input
+  {#binding Code
+   #type Code})
+
+(def: #export equivalence
+  (Equivalence Input)
+  ($_ product.equivalence
+      code.equivalence
+      code.equivalence
+      ))
+
+(def: #export (format value)
+  (-> Input Code)
+  (code.record
+   (list [(get@ #binding value)
+          (get@ #type value)])))
+
+(def: #export parser
+  {#.doc "Parser for the common typed-argument syntax used by many macros."}
+  (Parser Input)
+  (.record
+   ($_ <>.and
+       .any
+       .any
+       )))
diff --git a/stdlib/source/library/lux/macro/syntax/type/variable.lux b/stdlib/source/library/lux/macro/syntax/type/variable.lux
new file mode 100644
index 000000000..e73020c42
--- /dev/null
+++ b/stdlib/source/library/lux/macro/syntax/type/variable.lux
@@ -0,0 +1,28 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [control
+     [parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." text]]
+    [macro
+     ["." code]]]])
+
+(type: #export Variable
+  Text)
+
+(def: #export equivalence
+  (Equivalence Variable)
+  text.equivalence)
+
+(def: #export format
+  (-> Variable Code)
+  code.local_identifier)
+
+(def: #export parser
+  {#.doc "Parser for the common type variable/parameter used by many macros."}
+  (Parser Variable)
+  .local_identifier)
diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux
new file mode 100644
index 000000000..c489703fc
--- /dev/null
+++ b/stdlib/source/library/lux/macro/template.lux
@@ -0,0 +1,185 @@
+(.module:
+  [library
+   [lux (#- let)
+    ["." meta]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["<>" parser ("#\." functor)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." bit ("#\." codec)]
+     ["." text]
+     [collection
+      ["." list ("#\." monad)]
+      ["." dictionary (#+ Dictionary)]]]
+    [math
+     [number
+      ["." nat ("#\." decimal)]
+      ["." int ("#\." decimal)]
+      ["." rev ("#\." decimal)]
+      ["." frac ("#\." decimal)]]]]]
+  ["." //
+   [syntax (#+ syntax:)]
+   ["." code]
+   ["." local]])
+
+(syntax: #export (splice {parts (.tuple (<>.some .any))})
+  (wrap parts))
+
+(syntax: #export (count {parts (.tuple (<>.some .any))})
+  (wrap (list (code.nat (list.size parts)))))
+
+(syntax: #export (with_locals {locals (.tuple (<>.some .local_identifier))}
+                   body)
+  (do {! meta.monad}
+    [g!locals (|> locals
+                  (list\map //.gensym)
+                  (monad.seq !))]
+    (wrap (list (` (.with_expansions [(~+ (|> (list.zip/2 locals g!locals)
+                                              (list\map (function (_ [name identifier])
+                                                          (list (code.local_identifier name) (as_is identifier))))
+                                              list\join))]
+                     (~ body)))))))
+
+(def: (name_side module_side? parser)
+  (-> Bit (Parser Name) (Parser Text))
+  (do <>.monad
+    [[module short] parser]
+    (wrap (if module_side?
+            (case module
+              "" short
+              _ module)
+            short))))
+
+(def: (snippet module_side?)
+  (-> Bit (Parser Text))
+  (.let [full_identifier (..name_side module_side? .identifier)
+         full_tag (..name_side module_side? .tag)]
+    ($_ <>.either
+        .text
+        (if module_side?
+          full_identifier
+          (<>.either .local_identifier
+                     full_identifier))
+        (if module_side?
+          full_tag
+          (<>.either .local_tag
+                     full_tag))
+        (<>\map bit\encode .bit)
+        (<>\map nat\encode .nat)
+        (<>\map int\encode .int)
+        (<>\map rev\encode .rev)
+        (<>\map frac\encode .frac)
+        )))
+
+(def: (part module_side?)
+  (-> Bit (Parser (List Text)))
+  (.tuple (<>.many (..snippet module_side?))))
+
+(syntax: #export (text {simple (..part false)})
+  (wrap (list (|> simple (text.join_with "") code.text))))
+
+(template [  ]
+  [(syntax: #export ( {name (<>.or (<>.and (..part true) (..part false))
+                                         (..part false))})
+     (case name
+       (#.Left [simple complex])
+       (wrap (list ( [(text.join_with "" simple)
+                               (text.join_with "" complex)])))
+       
+       (#.Right simple)
+       (wrap (list (|> simple (text.join_with "") )))))]
+
+  [identifier code.local_identifier code.identifier]
+  [tag code.local_tag code.tag]
+  )
+
+(type: Environment
+  (Dictionary Text Code))
+
+(def: (apply env template)
+  (-> Environment Code Code)
+  (case template
+    [_ (#.Identifier "" name)]
+    (case (dictionary.get name env)
+      (#.Some substitute)
+      substitute
+
+      #.None
+      template)
+
+    (^template []
+      [[meta ( elems)]
+       [meta ( (list\map (apply env) elems))]])
+    ([#.Tuple]
+     [#.Form])
+
+    [meta (#.Record members)]
+    [meta (#.Record (list\map (: (-> [Code Code] [Code Code])
+                                 (function (_ [key value])
+                                   [(apply env key)
+                                    (apply env value)]))
+                              members))]
+
+    _
+    template))
+
+(type: Local
+  {#name Text
+   #parameters (List Text)
+   #template (List Code)})
+
+(exception: #export (irregular_arguments {expected Nat} {actual Nat})
+  (exception.report
+   ["Expected" (\ nat.decimal encode expected)]
+   ["Actual" (\ nat.decimal encode actual)]))
+
+(def: (macro (^slots [#parameters #template]))
+  (-> Local Macro)
+  ("lux macro"
+   (function (_ inputs compiler)
+     (.let [parameters_count (list.size parameters)
+            inputs_count (list.size inputs)]
+       (if (nat.= parameters_count inputs_count)
+         (.let [environment (: Environment
+                               (|> (list.zip/2 parameters inputs)
+                                   (dictionary.from_list text.hash)))]
+           (#.Right [compiler (list\map (..apply environment) template)]))
+         (exception.throw ..irregular_arguments [parameters_count inputs_count]))))))
+
+(def: local
+  (Parser Local)
+  (do <>.monad
+    [[name parameters] (.form (<>.and .local_identifier
+                                            (<>.many .local_identifier)))
+     template (.tuple (<>.some .any))]
+    (wrap {#name name
+           #parameters parameters
+           #template template})))
+
+(syntax: #export (let {locals (.tuple (<>.some ..local))}
+                   body)
+  (do meta.monad
+    [here_name meta.current_module_name
+     expression? (: (Meta Bit)
+                    (function (_ lux)
+                      (#try.Success [lux (case (get@ #.expected lux)
+                                           #.None
+                                           false
+
+                                           (#.Some _)
+                                           true)])))
+     g!pop (local.push (list\map (function (_ local)
+                                   [[here_name (get@ #name local)]
+                                    (..macro local)])
+                                 locals))]
+    (if expression?
+      (//.with_gensyms [g!body]
+        (wrap (list (` (.let [(~ g!body) (~ body)]
+                         (exec (~ g!pop)
+                           (~ g!body)))))))
+      (wrap (list body
+                  g!pop)))))
diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux
new file mode 100644
index 000000000..0070bcfa3
--- /dev/null
+++ b/stdlib/source/library/lux/math.lux
@@ -0,0 +1,394 @@
+(.module: {#.doc "Common mathematical constants and functions."}
+  [library
+   [lux #*
+    ["@" target]
+    [math
+     [number
+      ["n" nat]
+      ["i" int]]]]])
+
+(template [  ]
+  [(def: #export 
+     {#.doc }
+     )]
+
+  [e   +2.7182818284590452354  "The base of the natural logarithm."]
+  [pi  +3.14159265358979323846 "The ratio of a circle's circumference to its diameter."]
+  [tau +6.28318530717958647692 "The ratio of a circle's circumference to its radius."]
+  )
+
+(for {@.old
+      (as_is (template [ ]
+               [(def: #export ( input)
+                  (-> Frac Frac)
+                  ( input))]
+
+               [cos   "jvm invokestatic:java.lang.Math:cos:double"]
+               [sin   "jvm invokestatic:java.lang.Math:sin:double"]
+               [tan   "jvm invokestatic:java.lang.Math:tan:double"]
+
+               [acos  "jvm invokestatic:java.lang.Math:acos:double"]
+               [asin  "jvm invokestatic:java.lang.Math:asin:double"]
+               [atan  "jvm invokestatic:java.lang.Math:atan:double"]
+               
+               [exp   "jvm invokestatic:java.lang.Math:exp:double"]
+               [log   "jvm invokestatic:java.lang.Math:log:double"]
+               
+               [ceil  "jvm invokestatic:java.lang.Math:ceil:double"]
+               [floor "jvm invokestatic:java.lang.Math:floor:double"]
+               )
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               ("jvm invokestatic:java.lang.Math:pow:double,double" subject param)))
+
+      @.jvm
+      (as_is (template: (!double value)
+               (|> value
+                   (:as (primitive "java.lang.Double"))
+                   "jvm object cast"))
+             
+             (template: (!frac value)
+               (|> value
+                   "jvm object cast"
+                   (: (primitive "java.lang.Double"))
+                   (:as Frac)))
+             
+             (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> !double
+                       ["D"]
+                       ("jvm member invoke static" [] "java.lang.Math"  [])
+                       !frac))]
+
+               [cos   "cos"]
+               [sin   "sin"]
+               [tan   "tan"]
+
+               [acos  "acos"]
+               [asin  "asin"]
+               [atan  "atan"]
+               
+               [exp   "exp"]
+               [log   "log"]
+               
+               [ceil  "ceil"]
+               [floor "floor"]
+               
+               [root/2 "sqrt"]
+               [root/3 "cbrt"]
+               )
+             
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (|> ("jvm member invoke static" [] "java.lang.Math" "pow" []
+                    ["D" (!double subject)] ["D" (!double param)])
+                   !frac)))
+
+      @.js
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("js apply" ("js constant" ))
+                       (:as Frac)))]
+
+               [cos   "Math.cos"]
+               [sin   "Math.sin"]
+               [tan   "Math.tan"]
+
+               [acos  "Math.acos"]
+               [asin  "Math.asin"]
+               [atan  "Math.atan"]
+               
+               [exp   "Math.exp"]
+               [log   "Math.log"]
+               
+               [ceil  "Math.ceil"]
+               [floor "Math.floor"]
+
+               [root/2 "Math.sqrt"]
+               [root/3 "Math.cbrt"]
+               )
+             
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (:as Frac ("js apply" ("js constant" "Math.pow") subject param))))
+
+      @.python
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("python object do"  ("python import" "math"))
+                       (:as Frac)))]
+
+               [cos   "cos"]
+               [sin   "sin"]
+               [tan   "tan"]
+
+               [acos  "acos"]
+               [asin  "asin"]
+               [atan  "atan"]
+               
+               [exp   "exp"]
+               [log   "log"]
+               
+               [ceil  "ceil"]
+               [floor "floor"]
+
+               [root/2 "sqrt"]
+               )
+             
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (:as Frac ("python object do" "pow" ("python import" "math") subject param)))
+
+             (def: #export root/3
+               (-> Frac Frac)
+               (..pow ("lux f64 /" +3.0 +1.0))))
+
+      @.lua
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("lua apply" ("lua constant" ))
+                       (:as Frac)))]
+
+               [cos   "math.cos"]
+               [sin   "math.sin"]
+               [tan   "math.tan"]
+
+               [acos  "math.acos"]
+               [asin  "math.asin"]
+               [atan  "math.atan"]
+               
+               [exp   "math.exp"]
+               [log   "math.log"]
+               
+               [ceil  "math.ceil"]
+               [floor "math.floor"]
+
+               [root/2 "math.sqrt"]
+               )
+             
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               ("lua power" param subject))
+
+             (def: #export root/3
+               (-> Frac Frac)
+               (..pow ("lux f64 /" +3.0 +1.0))))
+
+      @.ruby
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("ruby apply" ("ruby constant" ))
+                       (:as Frac)))]
+
+               [cos   "Math.cos"]
+               [sin   "Math.sin"]
+               [tan   "Math.tan"]
+
+               [acos  "Math.acos"]
+               [asin  "Math.asin"]
+               [atan  "Math.atan"]
+               
+               [exp   "Math.exp"]
+               [log   "Math.log"]
+               
+               [root/2 "Math.sqrt"]
+               [root/3 "Math.cbrt"]
+               )
+
+             (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("ruby object do" )
+                       (:as Int)
+                       ("lux i64 f64")))]
+
+               [ceil  "ceil"]
+               [floor "floor"]
+               )
+
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (:as Frac ("ruby object do" "**" subject param))))
+
+      @.php
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("php apply" ("php constant" ))
+                       (:as Frac)))]
+
+               [cos   "cos"]
+               [sin   "sin"]
+               [tan   "tan"]
+
+               [acos  "acos"]
+               [asin  "asin"]
+               [atan  "atan"]
+               
+               [exp   "exp"]
+               [log   "log"]
+
+               [ceil  "ceil"]
+               [floor "floor"]
+               
+               [root/2 "sqrt"]
+               )
+
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (:as Frac ("php apply" ("php constant" "pow") subject param)))
+
+             (def: #export root/3
+               (-> Frac Frac)
+               (..pow ("lux f64 /" +3.0 +1.0))))
+
+      @.scheme
+      (as_is (template [ ]
+               [(def: #export 
+                  (-> Frac Frac)
+                  (|>> ("scheme apply" ("scheme constant" ))
+                       (:as Frac)))]
+
+               [cos   "cos"]
+               [sin   "sin"]
+               [tan   "tan"]
+
+               [acos  "acos"]
+               [asin  "asin"]
+               [atan  "atan"]
+               
+               [exp   "exp"]
+               [log   "log"]
+
+               [ceil  "ceiling"]
+               [floor "floor"]
+               
+               [root/2 "sqrt"]
+               )
+
+             (def: #export (pow param subject)
+               (-> Frac Frac Frac)
+               (:as Frac ("scheme apply" ("scheme constant" "expt") subject param)))
+
+             (def: #export root/3
+               (-> Frac Frac)
+               (..pow ("lux f64 /" +3.0 +1.0))))
+      })
+
+(def: #export (round input)
+  (-> Frac Frac)
+  (let [floored (floor input)
+        diff ("lux f64 -" floored input)]
+    (cond ("lux f64 <" diff +0.5)
+          ("lux f64 +" +1.0 floored)
+          
+          ("lux f64 <" -0.5 diff)
+          ("lux f64 +" -1.0 floored)
+          
+          ## else
+          floored)))
+
+(def: #export (atan/2 x y)
+  (-> Frac Frac Frac)
+  (cond ("lux f64 <" x +0.0)
+        (..atan ("lux f64 /" x y))
+
+        ("lux f64 <" +0.0 x)
+        (if (or ("lux f64 <" y +0.0)
+                ("lux f64 =" +0.0 y))
+          (|> y ("lux f64 /" x) atan ("lux f64 +" pi))
+          (|> y ("lux f64 /" x) atan ("lux f64 -" pi)))
+
+        ## ("lux f64 =" +0.0 x)
+        (cond ("lux f64 <" y +0.0)
+              (|> pi ("lux f64 /" +2.0))
+              
+              ("lux f64 <" +0.0 y)
+              (|> pi ("lux f64 /" -2.0))
+              
+              ## ("lux f64 =" +0.0 y)
+              ("lux f64 /" +0.0 +0.0))))
+
+(def: #export (log' base input)
+  (-> Frac Frac Frac)
+  ("lux f64 /"
+   (..log base)
+   (..log input)))
+
+(def: #export (factorial n)
+  (-> Nat Nat)
+  (loop [acc 1
+         n n]
+    (if (n.<= 1 n)
+      acc
+      (recur (n.* n acc) (dec n)))))
+
+(def: #export (hypotenuse catA catB)
+  (-> Frac Frac Frac)
+  (..pow +0.5 ("lux f64 +"
+               (..pow +2.0 catA)
+               (..pow +2.0 catB))))
+
+## Hyperbolic functions
+## https://en.wikipedia.org/wiki/Hyperbolic_function#Definitions
+(template [  ]
+  [(def: #export ( x)
+     (-> Frac Frac)
+     (|> (..exp x) ( (..exp ("lux f64 *" -1.0 x))) ("lux f64 /" +2.0)))
+
+   (def: #export ( x)
+     (-> Frac Frac)
+     (|> +2.0 ("lux f64 /" (|> (..exp x) ( (..exp ("lux f64 *" -1.0 x)))))))]
+
+  [sinh "lux f64 -" csch]
+  [cosh "lux f64 +" sech]
+  )
+
+(template [  ]
+  [(def: #export ( x)
+     (-> Frac Frac)
+     (let [e+ (exp x)
+           e- (exp ("lux f64 *" -1.0 x))
+           sinh' (|> e+ ("lux f64 -" e-))
+           cosh' (|> e+ ("lux f64 +" e-))]
+       (|>  ("lux f64 /" ))))]
+
+  [tanh sinh' cosh']
+  [coth cosh' sinh']
+  )
+
+## https://en.wikipedia.org/wiki/Inverse_hyperbolic_functions#Definitions_in_terms_of_logarithms
+(template [ ]
+  [(def: #export ( x)
+     (-> Frac Frac)
+     (|> x (pow +2.0) ( +1.0) (pow +0.5) ("lux f64 +" x) log))]
+
+  [asinh "lux f64 +"]
+  [acosh "lux f64 -"]
+  )
+
+(template [  ]
+  [(def: #export ( x)
+     (-> Frac Frac)
+     (let [x+ (|>  ("lux f64 +" ))
+           x- (|>  ("lux f64 -" ))]
+       (|> x+ ("lux f64 /" x-) log ("lux f64 /" +2.0))))]
+
+  [atanh +1.0 x]
+  [acoth x +1.0]
+  )
+
+(template [ ]
+  [(def: #export ( x)
+     (-> Frac Frac)
+     (let [x^2 (|> x (pow +2.0))]
+       (|> +1.0 ( x^2) (pow +0.5) ("lux f64 +" +1.0) ("lux f64 /" x) log)))]
+
+  [asech "lux f64 -"]
+  [acsch "lux f64 +"]
+  )
diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux
new file mode 100644
index 000000000..a8fd881aa
--- /dev/null
+++ b/stdlib/source/library/lux/math/infix.lux
@@ -0,0 +1,96 @@
+(.module: {#.doc "Common mathematical constants and functions."}
+  [library
+   [lux #*
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["<>" parser ("#\." functor)
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     [collection
+      ["." list ("#\." fold)]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      ["n" nat]
+      ["i" int]]]]])
+
+(type: #rec Infix
+  (#Const Code)
+  (#Call (List Code))
+  (#Unary Code Infix)
+  (#Binary Infix Code Infix))
+
+(def: infix^
+  (Parser Infix)
+  (<| <>.rec (function (_ infix^))
+      ($_ <>.or
+          ($_ <>.either
+              (<>\map code.bit .bit)
+              (<>\map code.nat .nat)
+              (<>\map code.int .int)
+              (<>\map code.rev .rev)
+              (<>\map code.frac .frac)
+              (<>\map code.text .text)
+              (<>\map code.identifier .identifier)
+              (<>\map code.tag .tag))
+          (.form (<>.many .any))
+          (.tuple (<>.and .any infix^))
+          (.tuple ($_ <>.either
+                            (do <>.monad
+                              [_ (.this! (' #and))
+                               init_subject infix^
+                               init_op .any
+                               init_param infix^
+                               steps (<>.some (<>.and .any infix^))]
+                              (wrap (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]])
+                                                                [param [(#Binary _subject _op _param)
+                                                                        (` and)
+                                                                        (#Binary subject op param)]])
+                                                              [init_param [init_subject init_op init_param]]
+                                                              steps))))
+                            (do <>.monad
+                              [init_subject infix^
+                               init_op .any
+                               init_param infix^
+                               steps (<>.some (<>.and .any infix^))]
+                              (wrap (list\fold (function (_ [op param] [_subject _op _param])
+                                                 [(#Binary _subject _op _param) op param])
+                                               [init_subject init_op init_param]
+                                               steps)))
+                            ))
+          )))
+
+(def: (to_prefix infix)
+  (-> Infix Code)
+  (case infix
+    (#Const value)
+    value
+    
+    (#Call parts)
+    (code.form parts)
+
+    (#Unary op subject)
+    (` ((~ op) (~ (to_prefix subject))))
+    
+    (#Binary left op right)
+    (` ((~ op) (~ (to_prefix right)) (~ (to_prefix left))))
+    ))
+
+(syntax: #export (infix {expr infix^})
+  {#.doc (doc "Infix math syntax."
+              (infix [x i.* +10])
+              (infix [[x i.+ y] i.* [x i.- y]])
+              (infix [sin [x i.+ y]])
+              (infix [[x n.< y] and [y n.< z]])
+              (infix [#and x n.< y n.< z])
+              (infix [(n.* 3 9) gcd 450])
+
+              "The rules for infix syntax are simple."
+              "If you want your binary function to work well with it."
+              "Then take the argument to the right (y) as your first argument,"
+              "and take the argument to the left (x) as your second argument.")}
+  (wrap (list (..to_prefix expr))))
diff --git a/stdlib/source/library/lux/math/logic/continuous.lux b/stdlib/source/library/lux/math/logic/continuous.lux
new file mode 100644
index 000000000..631219671
--- /dev/null
+++ b/stdlib/source/library/lux/math/logic/continuous.lux
@@ -0,0 +1,40 @@
+(.module:
+  [library
+   [lux (#- false true or and not)
+    [abstract
+     [monoid (#+ Monoid)]]
+    [math
+     [number
+      ["r" rev ("#\." interval)]]]]])
+
+(def: #export false Rev r\bottom)
+(def: #export true  Rev r\top)
+
+(template [   ]
+  [(def: #export 
+     (-> Rev Rev Rev)
+     )
+
+   (implementation: #export 
+     (Monoid Rev)
+
+     (def: identity )
+     (def: compose ))]
+
+  [or  r.max disjunction ..false]
+  [and r.min conjunction ..true]
+  )
+
+(def: #export (not input)
+  (-> Rev Rev)
+  (r.- input ..true))
+
+(def: #export (implies consequent antecedent)
+  (-> Rev Rev Rev)
+  (or (not antecedent)
+      consequent))
+
+(def: #export (= left right)
+  (-> Rev Rev Rev)
+  (and (or (not left) right)
+       (or left (not right))))
diff --git a/stdlib/source/library/lux/math/logic/fuzzy.lux b/stdlib/source/library/lux/math/logic/fuzzy.lux
new file mode 100644
index 000000000..c1815f3db
--- /dev/null
+++ b/stdlib/source/library/lux/math/logic/fuzzy.lux
@@ -0,0 +1,132 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [predicate (#+ Predicate)]
+     [functor
+      ["." contravariant]]]
+    [data
+     [collection
+      ["." list]
+      ["." set (#+ Set)]]]
+    [math
+     [number
+      ["/" rev]]]]]
+  ["." // #_
+   ["#" continuous]])
+
+(type: #export (Fuzzy a)
+  (-> a Rev))
+
+(implementation: #export functor
+  (contravariant.Functor Fuzzy)
+  
+  (def: (map f fb)
+    (|>> f fb)))
+
+(template [ ]
+  [(def: #export 
+     Fuzzy
+     (function (_ _)
+       ))]
+
+  [empty //.false]
+  [full //.true]
+  )
+
+(def: #export (membership set elem)
+  (All [a] (-> (Fuzzy a) a Rev))
+  (set elem))
+
+(template [ ]
+  [(def: #export ( left right)
+     (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a)))
+     (function (_ elem)
+       ( (left elem)
+                                 (right elem))))]
+
+  [union //.or]
+  [intersection //.and]
+  )
+
+(def: #export (complement set)
+  (All [a] (-> (Fuzzy a) (Fuzzy a)))
+  (|>> set //.not))
+
+(def: #export (difference sub base)
+  (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a)))
+  (..intersection (..complement sub) base))
+
+(def: #export (from_predicate predicate)
+  (All [a] (-> (Predicate a) (Fuzzy a)))
+  (function (_ elem)
+    (if (predicate elem)
+      //.true
+      //.false)))
+
+(def: #export (to_predicate treshold set)
+  (All [a] (-> Rev (Fuzzy a) (Predicate a)))
+  (function (_ elem)
+    (/.> treshold (set elem))))
+
+(def: #export from_set
+  (All [a] (-> (Set a) (Fuzzy a)))
+  (|>> set.member? ..from_predicate))
+
+(def: (ascending from to)
+  (-> Rev Rev (Fuzzy Rev))
+  (let [measure (/.- from to)]
+    (function (_ elem)
+      (cond (/.< from elem)
+            ## below
+            //.false
+
+            (/.< to elem)
+            ## in the middle...
+            (|> elem
+                (/.- from)
+                (/./ measure))
+
+            ## above
+            //.true))))
+
+(def: (descending from to)
+  (-> Rev Rev (Fuzzy Rev))
+  (..complement (..ascending from to)))
+
+(def: #export (gradient from to)
+  (-> Rev Rev (Fuzzy Rev))
+  (if (/.< to from)
+    (..ascending from to)
+    (..descending from to)))
+
+(template: (!sort_2  )
+  (if (/.>  )
+    [ ]
+    [ ]))
+
+(def: #export (triangle bottom middle top)
+  (-> Rev Rev Rev (Fuzzy Rev))
+  (let [[low_0 high_0] (!sort_2 bottom middle)
+        [bottom' high_1] (!sort_2 low_0 top)
+        [middle' top'] (!sort_2 high_0 high_1)]
+    (..intersection (..ascending bottom' middle')
+                    (..descending middle' top'))))
+
+(def: #export (trapezoid bottom middle_bottom middle_top top)
+  (-> Rev Rev Rev Rev (Fuzzy Rev))
+  (let [[low_0 high_0] (!sort_2 bottom middle_bottom)
+        [low_1 high_1] (!sort_2 middle_top top)
+        [bottom' middle_0] (!sort_2 low_0 low_1)
+        [middle_1 top'] (!sort_2 high_0 high_1)
+        [middle_bottom' middle_top'] (!sort_2 middle_0 middle_1)]
+    (..intersection (..ascending bottom' middle_bottom')
+                    (..descending middle_top' top'))))
+
+(def: #export (cut treshold set)
+  (All [a] (-> Rev (Fuzzy a) (Fuzzy a)))
+  (function (_ elem)
+    (let [membership (set elem)]
+      (if (/.< treshold membership)
+        //.false
+        (|> membership (/.- treshold) (/.* //.true))))))
diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux
new file mode 100644
index 000000000..679666580
--- /dev/null
+++ b/stdlib/source/library/lux/math/modular.lux
@@ -0,0 +1,157 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]
+     [monoid (#+ Monoid)]
+     [codec (#+ Codec)]
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["<>" parser
+      ["<.>" text (#+ Parser)]
+      ["<.>" code]]]
+    [data
+     ["." product]
+     ["." text ("#\." monoid)]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      ["i" int ("#\." decimal)]]]
+    [type
+     abstract]]]
+  ["." // #_
+   ["#" modulus (#+ Modulus)]])
+
+(abstract: #export (Mod m)
+  {#modulus (Modulus m)
+   #value Int}
+
+  {#.doc "A number under a modulus."}
+
+  (def: #export (modular modulus value)
+    (All [%] (-> (Modulus %) Int (Mod %)))
+    (:abstraction {#modulus modulus
+                   #value (i.mod (//.divisor modulus) value)}))
+
+  (template [  ]
+    [(def: #export 
+       (All [%] (-> (Mod %) ))
+       (|>> :representation ))]
+
+    [modulus (Modulus %) product.left]
+    [value Int product.right]
+    )
+  
+  (exception: #export [%] (incorrect_modulus {modulus (Modulus %)}
+                                             {parsed Int})
+    (exception.report
+     ["Expected" (i\encode (//.divisor modulus))]
+     ["Actual" (i\encode parsed)]))
+
+  (def: separator
+    " mod ")
+
+  (def: intL
+    (Parser Int)
+    (<>.codec i.decimal
+              (.and (.one_of "-+") (.many .decimal))))
+
+  (implementation: #export (codec expected)
+    (All [%] (-> (Modulus %) (Codec Text (Mod %))))
+
+    (def: (encode modular)
+      (let [[_ value] (:representation modular)]
+        ($_ text\compose
+            (i\encode value)
+            ..separator
+            (i\encode (//.divisor expected)))))
+
+    (def: decode
+      (.run
+       (do <>.monad
+         [[value _ actual] ($_ <>.and intL (.this ..separator) intL)
+          _ (<>.assert (exception.construct ..incorrect_modulus [expected actual])
+                       (i.= (//.divisor expected) actual))]
+         (wrap (..modular expected value))))))
+
+  (template [ ]
+    [(def: #export ( reference subject)
+       (All [%] (-> (Mod %) (Mod %) Bit))
+       (let [[_ reference] (:representation reference)
+             [_ subject] (:representation subject)]
+         ( reference subject)))]
+
+    [= i.=]
+    [< i.<]
+    [<= i.<=]
+    [> i.>]
+    [>= i.>=]
+    )
+
+  (implementation: #export equivalence
+    (All [%] (Equivalence (Mod %)))
+
+    (def: = ..=))
+
+  (implementation: #export order
+    (All [%] (Order (Mod %)))
+
+    (def: &equivalence ..equivalence)
+    (def: < ..<))
+
+  (template [ ]
+    [(def: #export ( param subject)
+       (All [%] (-> (Mod %) (Mod %) (Mod %)))
+       (let [[modulus param] (:representation param)
+             [_ subject] (:representation subject)]
+         (:abstraction {#modulus modulus
+                        #value (|> subject
+                                   ( param)
+                                   (i.mod (//.divisor modulus)))})))]
+
+    [+ i.+]
+    [- i.-]
+    [* i.*]
+    )
+
+  (template [  ]
+    [(implementation: #export ( modulus)
+       (All [%] (-> (Modulus %) (Monoid (Mod %))))
+
+       (def: identity
+         (..modular modulus ))
+       (def: compose
+         ))]
+    
+    [..+ +0 addition]
+    [..* +1 multiplication]
+    )
+  
+  (def: #export (inverse modular)
+    (All [%] (-> (Mod %) (Maybe (Mod %))))
+    (let [[modulus value] (:representation modular)
+          [[vk mk] gcd] (i.extended_gcd value (//.divisor modulus))]
+      (case gcd
+        +1 (#.Some (..modular modulus vk))
+        _ #.None)))
+  )
+
+(exception: #export [r% s%] (moduli_are_not_equal {reference (Modulus r%)}
+                                                  {subject (Modulus s%)})
+  (exception.report
+   ["Reference" (i\encode (//.divisor reference))]
+   ["Subject" (i\encode (//.divisor subject))]))
+
+(def: #export (adapter reference subject)
+  (All [r% s%]
+    (-> (Modulus r%) (Modulus s%)
+        (Try (-> (Mod s%) (Mod r%)))))
+  (if (//.= reference subject)
+    (#try.Success (|>> ..value
+                       (..modular reference)))
+    (exception.throw ..moduli_are_not_equal [reference subject])))
diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux
new file mode 100644
index 000000000..fa654a408
--- /dev/null
+++ b/stdlib/source/library/lux/math/modulus.lux
@@ -0,0 +1,56 @@
+(.module:
+  [library
+   [lux #*
+    ["." meta]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     [parser
+      ["<.>" code]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      ["i" int]]]
+    [type
+     abstract]]])
+
+(exception: #export zero_cannot_be_a_modulus)
+
+(abstract: #export (Modulus m)
+  Int
+
+  {#.doc (doc "A number used as a modulus in modular arithmetic."
+              "It cannot be 0.")}
+
+  (def: #export (modulus value)
+    (Ex [m] (-> Int (Try (Modulus m))))
+    (if (i.= +0 value)
+      (exception.throw ..zero_cannot_be_a_modulus [])
+      (#try.Success (:abstraction value))))
+
+  (def: #export divisor
+    (All [m] (-> (Modulus m) Int))
+    (|>> :representation))
+
+  (def: #export (= reference subject)
+    (All [r s] (-> (Modulus r) (Modulus s) Bit))
+    (i.= (:representation reference)
+         (:representation subject)))
+
+  (def: #export (congruent? modulus reference subject)
+    (All [m] (-> (Modulus m) Int Int Bit))
+    (|> subject
+        (i.- reference)
+        (i.% (:representation modulus))
+        (i.= +0)))
+  )
+
+(syntax: #export (literal {divisor .int})
+  (meta.lift
+   (do try.monad
+     [_ (..modulus divisor)]
+     (wrap (list (` ((~! try.assume) (..modulus (~ (code.int divisor))))))))))
diff --git a/stdlib/source/library/lux/math/number.lux b/stdlib/source/library/lux/math/number.lux
new file mode 100644
index 000000000..506fde750
--- /dev/null
+++ b/stdlib/source/library/lux/math/number.lux
@@ -0,0 +1,87 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [codec (#+ Codec)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." text]]]]
+  ["." / #_
+   ["#." nat]
+   ["#." int]
+   ["#." rev]
+   ["#." frac]])
+
+(macro: (encoding_doc tokens state)
+  (case tokens
+    (^ (list [location (#.Text encoding)] example_1 example_2))
+    (let [encoding ($_ "lux text concat"
+                       "Given syntax for a "
+                       encoding
+                       " number, generates a Nat, an Int, a Rev or a Frac.")
+          separators "Allows for the presence of commas among the digits."
+          description [location (#.Text ($_ "lux text concat" encoding " " separators))]]
+      (#try.Success [state (list (` (doc (~ description)
+                                         (~ example_1)
+                                         (~ example_2))))]))
+
+    _
+    (#try.Failure "Wrong syntax for 'encoding_doc'.")))
+
+(def: separator
+  ",")
+
+(def: (separator_prefixed? number)
+  (-> Text Bit)
+  (case ("lux text index" 0 ..separator number)
+    (#.Some 0)
+    #1
+
+    _
+    #0))
+
+(def: clean_separators
+  (-> Text Text)
+  (text.replace_all ..separator ""))
+
+(template [      ]
+  [(macro: #export ( tokens state)
+     {#.doc }
+     (case tokens
+       (#.Cons [meta (#.Text repr')] #.Nil)
+       (if (..separator_prefixed? repr')
+         (#try.Failure )
+         (let [repr (..clean_separators repr')]
+           (case (\  decode repr)
+             (#try.Success value)
+             (#try.Success [state (list [meta (#.Nat value)])])
+
+             (^multi (#try.Failure _)
+                     [(\  decode repr) (#try.Success value)])
+             (#try.Success [state (list [meta (#.Int value)])])
+
+             (^multi (#try.Failure _)
+                     [(\  decode repr) (#try.Success value)])
+             (#try.Success [state (list [meta (#.Rev value)])])
+
+             (^multi (#try.Failure _)
+                     [(\  decode repr) (#try.Success value)])
+             (#try.Success [state (list [meta (#.Frac value)])])
+
+             _
+             (#try.Failure ))))
+
+       _
+       (#try.Failure )))]
+
+  [bin /nat.binary /int.binary /rev.binary /frac.binary
+   "Invalid binary syntax."
+   (encoding_doc "binary" (bin "11001001") (bin "11,00,10,01"))]
+  [oct /nat.octal  /int.octal  /rev.octal  /frac.octal
+   "Invalid octal syntax."
+   (encoding_doc "octal" (oct "615243") (oct "615,243"))]
+  [hex /nat.hex    /int.hex    /rev.hex    /frac.hex
+   "Invalid hexadecimal syntax."
+   (encoding_doc "hexadecimal" (hex "deadBEEF") (hex "dead,BEEF"))]
+  )
diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux
new file mode 100644
index 000000000..cc2c6a4f1
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/complex.lux
@@ -0,0 +1,316 @@
+(.module: {#.doc "Complex arithmetic."}
+  [library
+   [lux #*
+    ["." math]
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     ["M" monad (#+ Monad do)]]
+    [control
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." maybe]
+     [collection
+      ["." list ("#\." functor)]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     [number
+      ["n" nat]
+      ["f" frac]
+      ["." int]]]]])
+
+(type: #export Complex
+  {#real Frac
+   #imaginary Frac})
+
+(syntax: #export (complex real {?imaginary (<>.maybe .any)})
+  {#.doc (doc "Complex literals."
+              (complex real imaginary)
+              "The imaginary part can be omitted if it's 0."
+              (complex real))}
+  (wrap (list (` {#..real (~ real)
+                  #..imaginary (~ (maybe.default (' +0.0)
+                                                 ?imaginary))}))))
+
+(def: #export i
+  (..complex +0.0 +1.0))
+
+(def: #export +one
+  (..complex +1.0 +0.0))
+
+(def: #export -one
+  (..complex -1.0 +0.0))
+
+(def: #export zero
+  (..complex +0.0 +0.0))
+
+(def: #export (not_a_number? complex)
+  (or (f.not_a_number? (get@ #real complex))
+      (f.not_a_number? (get@ #imaginary complex))))
+
+(def: #export (= param input)
+  (-> Complex Complex Bit)
+  (and (f.= (get@ #real param)
+            (get@ #real input))
+       (f.= (get@ #imaginary param)
+            (get@ #imaginary input))))
+
+(template [ ]
+  [(def: #export ( param input)
+     (-> Complex Complex Complex)
+     {#real ( (get@ #real param)
+                  (get@ #real input))
+      #imaginary ( (get@ #imaginary param)
+                       (get@ #imaginary input))})]
+
+  [+ f.+]
+  [- f.-]
+  )
+
+(implementation: #export equivalence
+  (Equivalence Complex)
+  
+  (def: = ..=))
+
+(template [ ]
+  [(def: #export 
+     (-> Complex Complex)
+     (|>> (update@ #real )
+          (update@ #imaginary )))]
+
+  [negate f.negate]
+  [signum f.signum]
+  )
+
+(def: #export conjugate
+  (-> Complex Complex)
+  (update@ #imaginary f.negate))
+
+(def: #export (*' param input)
+  (-> Frac Complex Complex)
+  {#real (f.* param
+              (get@ #real input))
+   #imaginary (f.* param
+                   (get@ #imaginary input))})
+
+(def: #export (* param input)
+  (-> Complex Complex Complex)
+  {#real (f.- (f.* (get@ #imaginary param)
+                   (get@ #imaginary input))
+              (f.* (get@ #real param)
+                   (get@ #real input)))
+   #imaginary (f.+ (f.* (get@ #real param)
+                        (get@ #imaginary input))
+                   (f.* (get@ #imaginary param)
+                        (get@ #real input)))})
+
+(def: #export (/ param input)
+  (-> Complex Complex Complex)
+  (let [(^slots [#real #imaginary]) param]
+    (if (f.< (f.abs imaginary)
+             (f.abs real))
+      (let [quot (f./ imaginary real)
+            denom (|> real (f.* quot) (f.+ imaginary))]
+        {#real (|> (get@ #real input) (f.* quot) (f.+ (get@ #imaginary input)) (f./ denom))
+         #imaginary (|> (get@ #imaginary input) (f.* quot) (f.- (get@ #real input)) (f./ denom))})
+      (let [quot (f./ real imaginary)
+            denom (|> imaginary (f.* quot) (f.+ real))]
+        {#real (|> (get@ #imaginary input) (f.* quot) (f.+ (get@ #real input)) (f./ denom))
+         #imaginary (|> (get@ #imaginary input) (f.- (f.* quot (get@ #real input))) (f./ denom))}))))
+
+(def: #export (/' param subject)
+  (-> Frac Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (f./ param real)
+     #imaginary (f./ param imaginary)}))
+
+(def: #export (% param input)
+  (-> Complex Complex Complex)
+  (let [scaled (/ param input)
+        quotient (|> scaled
+                     (update@ #real math.floor)
+                     (update@ #imaginary math.floor))]
+    (- (* quotient param)
+       input)))
+
+(def: #export (cos subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (f.* (math.cosh imaginary)
+                (math.cos real))
+     #imaginary (f.negate (f.* (math.sinh imaginary)
+                               (math.sin real)))}))
+
+(def: #export (cosh subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (f.* (math.cos imaginary)
+                (math.cosh real))
+     #imaginary (f.* (math.sin imaginary)
+                     (math.sinh real))}))
+
+(def: #export (sin subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (f.* (math.cosh imaginary)
+                (math.sin real))
+     #imaginary (f.* (math.sinh imaginary)
+                     (math.cos real))}))
+
+(def: #export (sinh subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (f.* (math.cos imaginary)
+                (math.sinh real))
+     #imaginary (f.* (math.sin imaginary)
+                     (math.cosh real))}))
+
+(def: #export (tan subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject
+        r2 (f.* +2.0 real)
+        i2 (f.* +2.0 imaginary)
+        d (f.+ (math.cos r2) (math.cosh i2))]
+    {#real (f./ d (math.sin r2))
+     #imaginary (f./ d (math.sinh i2))}))
+
+(def: #export (tanh subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject
+        r2 (f.* +2.0 real)
+        i2 (f.* +2.0 imaginary)
+        d (f.+ (math.cosh r2) (math.cos i2))]
+    {#real (f./ d (math.sinh r2))
+     #imaginary (f./ d (math.sin i2))}))
+
+(def: #export (abs subject)
+  (-> Complex Frac)
+  (let [(^slots [#real #imaginary]) subject]
+    (if (f.< (f.abs imaginary)
+             (f.abs real))
+      (if (f.= +0.0 imaginary)
+        (f.abs real)
+        (let [q (f./ imaginary real)]
+          (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q)))
+               (f.abs imaginary))))
+      (if (f.= +0.0 real)
+        (f.abs imaginary)
+        (let [q (f./ real imaginary)]
+          (f.* (math.pow +0.5 (f.+ +1.0 (f.* q q)))
+               (f.abs real)))))))
+
+(def: #export (exp subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject
+        r_exp (math.exp real)]
+    {#real (f.* r_exp (math.cos imaginary))
+     #imaginary (f.* r_exp (math.sin imaginary))}))
+
+(def: #export (log subject)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) subject]
+    {#real (|> subject ..abs math.log)
+     #imaginary (math.atan/2 real imaginary)}))
+
+(template [  ]
+  [(def: #export ( param input)
+     (->  Complex Complex)
+     (|> input log ( param) exp))]
+
+  [pow  Complex ..*]
+  [pow' Frac    ..*']
+  )
+
+(def: (copy_sign sign magnitude)
+  (-> Frac Frac Frac)
+  (f.* (f.signum sign) magnitude))
+
+(def: #export (root/2 input)
+  (-> Complex Complex)
+  (let [(^slots [#real #imaginary]) input
+        t (|> input ..abs (f.+ (f.abs real)) (f./ +2.0) (math.pow +0.5))]
+    (if (f.>= +0.0 real)
+      {#real t
+       #imaginary (f./ (f.* +2.0 t)
+                       imaginary)}
+      {#real (f./ (f.* +2.0 t)
+                  (f.abs imaginary))
+       #imaginary (f.* t (..copy_sign imaginary +1.0))})))
+
+(def: (root/2-1z input)
+  (-> Complex Complex)
+  (|> (complex +1.0) (- (* input input)) ..root/2))
+
+(def: #export (reciprocal (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  (if (f.< (f.abs imaginary)
+           (f.abs real))
+    (let [q (f./ imaginary real)
+          scale (f./ (|> real (f.* q) (f.+ imaginary))
+                     +1.0)]
+      {#real (f.* q scale)
+       #imaginary (f.negate scale)})
+    (let [q (f./ real imaginary)
+          scale (f./ (|> imaginary (f.* q) (f.+ real))
+                     +1.0)]
+      {#real scale
+       #imaginary (|> scale f.negate (f.* q))})))
+
+(def: #export (acos input)
+  (-> Complex Complex)
+  (|> input
+      (..+ (|> input ..root/2-1z (..* ..i)))
+      ..log
+      (..* (..negate ..i))))
+
+(def: #export (asin input)
+  (-> Complex Complex)
+  (|> input
+      ..root/2-1z
+      (..+ (..* ..i input))
+      ..log
+      (..* (..negate ..i))))
+
+(def: #export (atan input)
+  (-> Complex Complex)
+  (|> input
+      (..+ ..i)
+      (../ (..- input ..i))
+      ..log
+      (..* (../ (..complex +2.0) ..i))))
+
+(def: #export (argument (^slots [#real #imaginary]))
+  (-> Complex Frac)
+  (math.atan/2 real imaginary))
+
+(def: #export (roots nth input)
+  (-> Nat Complex (List Complex))
+  (if (n.= 0 nth)
+    (list)
+    (let [r_nth (|> nth .int int.frac)
+          nth_root_of_abs (|> input ..abs (math.pow (f./ r_nth +1.0)))
+          nth_phi (|> input ..argument (f./ r_nth))
+          slice (|> math.pi (f.* +2.0) (f./ r_nth))]
+      (|> (list.indices nth)
+          (list\map (function (_ nth')
+                      (let [inner (|> nth' .int int.frac
+                                      (f.* slice)
+                                      (f.+ nth_phi))
+                            real (f.* nth_root_of_abs
+                                      (math.cos inner))
+                            imaginary (f.* nth_root_of_abs
+                                           (math.sin inner))]
+                        {#real real
+                         #imaginary imaginary})))))))
+
+(def: #export (approximately? margin_of_error standard value)
+  (-> Frac Complex Complex Bit)
+  (and (f.approximately? margin_of_error
+                         (get@ #..real standard)
+                         (get@ #..real value))
+       (f.approximately? margin_of_error
+                         (get@ #..imaginary standard)
+                         (get@ #..imaginary value))))
diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux
new file mode 100644
index 000000000..f6f01192e
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/frac.lux
@@ -0,0 +1,447 @@
+(.module:
+  [library
+   [lux (#- nat int rev)
+    ["@" target]
+    [abstract
+     [hash (#+ Hash)]
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     [predicate (#+ Predicate)]
+     [order (#+ Order)]
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." maybe]
+     ["." text]]]]
+  ["." // #_
+   ["#." i64]
+   ["#." nat]
+   ["#." int]
+   ["#." rev]
+   ["/#" //]])
+
+(def: #export (= reference sample)
+  {#.doc "Frac(tion) equivalence."}
+  (-> Frac Frac Bit)
+  ("lux f64 =" reference sample))
+
+(def: #export (< reference sample)
+  {#.doc "Frac(tion) less-than."}
+  (-> Frac Frac Bit)
+  ("lux f64 <" reference sample))
+
+(def: #export (<= reference sample)
+  {#.doc "Frac(tion) less-than or equal."}
+  (-> Frac Frac Bit)
+  (or ("lux f64 <" reference sample)
+      ("lux f64 =" reference sample)))
+
+(def: #export (> reference sample)
+  {#.doc "Frac(tion) greater-than."}
+  (-> Frac Frac Bit)
+  ("lux f64 <" sample reference))
+
+(def: #export (>= reference sample)
+  {#.doc "Frac(tion) greater-than or equal."}
+  (-> Frac Frac Bit)
+  (or ("lux f64 <" sample reference)
+      ("lux f64 =" sample reference)))
+
+(template [ ]
+  [(def: #export 
+     (Predicate Frac)
+     ( +0.0))]
+
+  [..> positive?]
+  [..< negative?]
+  [..= zero?]
+  )
+
+(template [  ]
+  [(def: #export ( param subject)
+     {#.doc }
+     (-> Frac Frac Frac)
+     ( param subject))]
+
+  [+ "lux f64 +" "Frac(tion) addition."]
+  [- "lux f64 -" "Frac(tion) substraction."]
+  [* "lux f64 *" "Frac(tion) multiplication."]
+  [/ "lux f64 /" "Frac(tion) division."]
+  [% "lux f64 %" "Frac(tion) remainder."]
+  )
+
+(def: #export (/% param subject)
+  (-> Frac Frac [Frac Frac])
+  [(../ param subject)
+   (..% param subject)])
+
+(def: #export negate
+  (-> Frac Frac)
+  (..* -1.0))
+
+(def: #export (abs x)
+  (-> Frac Frac)
+  (if (..< +0.0 x)
+    (..* -1.0 x)
+    x))
+
+(def: #export (signum x)
+  (-> Frac Frac)
+  (cond (..= +0.0 x) +0.0
+        (..< +0.0 x) -1.0
+        ## else
+        +1.0))
+
+(def: min_exponent -1022)
+(def: max_exponent (//int.frac +1023))
+
+(template [  ]
+  [(def: #export ( left right)
+     {#.doc }
+     (-> Frac Frac Frac)
+     (if ( right left)
+       left
+       right))]
+
+  [min ..< "Frac(tion) minimum."]
+  [max ..> "Frac(tion) minimum."]
+  )
+
+(def: #export nat
+  (-> Frac Nat)
+  (|>> "lux f64 i64" .nat))
+
+(def: #export int
+  (-> Frac Int)
+  (|>> "lux f64 i64"))
+
+(def: mantissa_size Nat 52)
+(def: exponent_size Nat 11)
+
+(def: frac_denominator
+  (|> -1
+      ("lux i64 right-shift" ..exponent_size)
+      "lux i64 f64"))
+
+(def: #export rev
+  (-> Frac Rev)
+  (|>> ..abs
+       (..% +1.0)
+       (..* ..frac_denominator)
+       "lux f64 i64"
+       ("lux i64 left-shift" ..exponent_size)))
+
+(implementation: #export equivalence
+  (Equivalence Frac)
+  
+  (def: = ..=))
+
+(implementation: #export order
+  (Order Frac)
+  
+  (def: &equivalence ..equivalence)
+  (def: < ..<))
+
+(def: #export smallest
+  Frac
+  (///.pow (//int.frac (//int.- (.int ..mantissa_size) ..min_exponent))
+           +2.0))
+
+(def: #export biggest
+  Frac
+  (let [f2^-52 (///.pow (//nat.frac (//nat.- ..mantissa_size 0)) +2.0)
+        f2^+1023 (///.pow ..max_exponent +2.0)]
+    (|> +2.0
+        (..- f2^-52)
+        (..* f2^+1023))))
+
+(template [  ]
+  [(implementation: #export 
+     (Monoid Frac)
+     
+     (def: identity )
+     (def: compose ))]
+
+  [addition       ..+   +0.0]
+  [multiplication ..*   +1.0]
+  [minimum        ..min ..biggest]
+  [maximum        ..max (..* -1.0 ..biggest)]
+  )
+
+(template [  ]
+  [(def: #export 
+     {#.doc }
+     Frac
+     (../ +0.0 ))]
+
+  [not_a_number      +0.0 "Not a number."]
+  [positive_infinity +1.0 "Positive infinity."]
+  )
+
+(def: #export negative_infinity
+  {#.doc "Negative infinity."}
+  Frac
+  (..* -1.0 ..positive_infinity))
+
+(def: #export (not_a_number? number)
+  {#.doc "Tests whether a frac is actually not-a-number."}
+  (-> Frac Bit)
+  (not (..= number number)))
+
+(def: #export (number? value)
+  (-> Frac Bit)
+  (not (or (..not_a_number? value)
+           (..= ..positive_infinity value)
+           (..= ..negative_infinity value))))
+
+(implementation: #export decimal
+  (Codec Text Frac)
+  
+  (def: (encode x)
+    (case x
+      -0.0 (let [output ("lux f64 encode" x)]
+             (if (text.starts_with? "-" output)
+               output
+               ("lux text concat" "+" output)))
+      _ (if (..< +0.0 x)
+          ("lux f64 encode" x)
+          ("lux text concat" "+" ("lux f64 encode" x)))))
+
+  (def: (decode input)
+    (case ("lux f64 decode" [input])
+      (#.Some value)
+      (#try.Success value)
+
+      #.None
+      (#try.Failure "Could not decode Frac"))))
+
+(def: log/2
+  (-> Frac Frac)
+  (|>> ///.log
+       (../ (///.log +2.0))))
+
+(def: double_bias Nat 1023)
+
+(def: exponent_mask (//i64.mask ..exponent_size))
+
+(def: exponent_offset ..mantissa_size)
+(def: sign_offset (//nat.+ ..exponent_size ..exponent_offset))
+
+(template [  ]
+  [(def:  (|>  (\ //nat.hex decode) try.assume ))]
+
+  [.i64 "FFF8000000000000" not_a_number_bits]
+  [.i64 "7FF0000000000000" positive_infinity_bits]
+  [.i64 "FFF0000000000000" negative_infinity_bits]
+  [.i64 "0000000000000000" positive_zero_bits]
+  [.i64 "8000000000000000" negative_zero_bits]
+  [.nat "7FF"              special_exponent_bits]
+  )
+
+(def: smallest_exponent
+  (..log/2 ..smallest))
+
+(def: #export (to_bits input)
+  (-> Frac I64)
+  (.i64 (cond (..not_a_number? input)
+              ..not_a_number_bits
+
+              (..= positive_infinity input)
+              ..positive_infinity_bits
+
+              (..= negative_infinity input)
+              ..negative_infinity_bits
+
+              (..= +0.0 input)
+              (let [reciprocal (../ input +1.0)]
+                (if (..= positive_infinity reciprocal)
+                  ## Positive zero
+                  ..positive_zero_bits
+                  ## Negative zero
+                  ..negative_zero_bits))
+
+              ## else
+              (let [sign_bit (if (..< -0.0 input)
+                               1
+                               0)
+                    input (..abs input)
+                    exponent (|> input
+                                 ..log/2
+                                 ///.floor
+                                 (..min ..max_exponent))
+                    min_gap (..- (//int.frac ..min_exponent) exponent)
+                    power (|> (//nat.frac ..mantissa_size)
+                              (..+ (..min +0.0 min_gap))
+                              (..- exponent))
+                    max_gap (..- ..max_exponent power)
+                    mantissa (|> input
+                                 (..* (///.pow (..min ..max_exponent power) +2.0))
+                                 (..* (if (..> +0.0 max_gap)
+                                        (///.pow max_gap +2.0)
+                                        +1.0)))
+                    exponent_bits (|> (if (..< +0.0 min_gap)
+                                        (|> (..int exponent)
+                                            (//int.- (..int min_gap))
+                                            dec)
+                                        (..int exponent))
+                                      (//int.+ (.int ..double_bias))
+                                      (//i64.and ..exponent_mask))
+                    mantissa_bits (..int mantissa)]
+                ($_ //i64.or
+                    (//i64.left_shift ..sign_offset sign_bit)
+                    (//i64.left_shift ..exponent_offset exponent_bits)
+                    (//i64.clear ..mantissa_size mantissa_bits)))
+              )))
+
+(template [  ]
+  [(def: 
+     (-> (I64 Any) I64)
+     (let [mask (|> 1 (//i64.left_shift ) dec (//i64.left_shift ))]
+       (|>> (//i64.and mask) (//i64.right_shift ) .i64)))]
+
+  [mantissa ..mantissa_size 0]
+  [exponent ..exponent_size ..mantissa_size]
+  [sign     1               ..sign_offset]
+  )
+
+(def: #export (from_bits input)
+  (-> I64 Frac)
+  (case [(: Nat (..exponent input))
+         (: Nat (..mantissa input))
+         (: Nat (..sign input))]
+    (^ [(static ..special_exponent_bits) 0 0])
+    ..positive_infinity
+
+    (^ [(static ..special_exponent_bits) 0 1])
+    ..negative_infinity
+
+    (^ [(static ..special_exponent_bits) _ _])
+    ..not_a_number
+
+    ## Positive zero
+    [0 0 0] +0.0
+    ## Negative zero
+    [0 0 1] (..* -1.0 +0.0)
+
+    [E M S]
+    (let [sign (if (//nat.= 0 S)
+                 +1.0
+                 -1.0)
+          [mantissa power] (if (//nat.< ..mantissa_size E)
+                             [(if (//nat.= 0 E)
+                                M
+                                (//i64.set ..mantissa_size M))
+                              (|> E
+                                  (//nat.- ..double_bias)
+                                  .int
+                                  (//int.max ..min_exponent)
+                                  (//int.- (.int ..mantissa_size)))]
+                             [(//i64.set ..mantissa_size M)
+                              (|> E (//nat.- ..double_bias) (//nat.- ..mantissa_size) .int)])
+          exponent (///.pow (//int.frac power) +2.0)]
+      (|> (//nat.frac mantissa)
+          (..* exponent)
+          (..* sign)))))
+
+(def: (split_exponent codec representation)
+  (-> (Codec Text Nat) Text (Try [Text Int]))
+  (case [("lux text index" 0 "e+" representation)
+         ("lux text index" 0 "E+" representation)
+         ("lux text index" 0 "e-" representation)
+         ("lux text index" 0 "E-" representation)]
+    (^template [ ]
+      [
+       (do try.monad
+         [#let [after_offset (//nat.+ 2 split_index)
+                after_length (//nat.- after_offset ("lux text size" representation))]
+          exponent (|> representation
+                       ("lux text clip" after_offset after_length)
+                       (\ codec decode))]
+         (wrap [("lux text clip" 0 split_index representation)
+                (//int.*  (.int exponent))]))])
+    ([+1 (^or [(#.Some split_index) #.None #.None #.None]
+              [#.None (#.Some split_index) #.None #.None])]
+     [-1 (^or [#.None #.None (#.Some split_index) #.None]
+              [#.None #.None #.None (#.Some split_index)])])
+    
+    _
+    (#try.Success [representation +0])))
+
+(template [   ]
+  [(implementation: #export 
+     (Codec Text Frac)
+     
+     (def: (encode value)
+       (let [bits (..to_bits value)
+             mantissa (..mantissa bits)
+             exponent (//int.- (.int ..double_bias) (..exponent bits))
+             sign (..sign bits)]
+         ($_ "lux text concat"
+             (case (.nat sign)
+               1 "-"
+               0 "+"
+               _ (undefined))
+             (\  encode (.nat mantissa))
+             ".0E"
+             (\  encode exponent))))
+
+     (def: (decode representation)
+       (let [negative? (text.starts_with? "-" representation)
+             positive? (text.starts_with? "+" representation)]
+         (if (or negative? positive?)
+           (do {! try.monad}
+             [[mantissa exponent] (..split_exponent  representation)
+              [whole decimal] (case ("lux text index" 0 "." mantissa)
+                                (#.Some split_index)
+                                (do !
+                                  [#let [after_offset (inc split_index)
+                                         after_length (//nat.- after_offset ("lux text size" mantissa))]
+                                   decimal (|> mantissa
+                                               ("lux text clip" after_offset after_length)
+                                               (\  decode))]
+                                  (wrap [("lux text clip" 0 split_index mantissa)
+                                         decimal]))
+
+                                #.None
+                                (#try.Failure ("lux text concat"  representation)))
+              #let [whole ("lux text clip" 1 (dec ("lux text size" whole)) whole)]
+              mantissa (\  decode (case decimal
+                                         0 whole
+                                         _ ("lux text concat" whole (\  encode decimal))))
+              #let [sign (if negative? 1 0)]]
+             (wrap (..from_bits
+                    ($_ //i64.or
+                        (//i64.left_shift ..sign_offset (.i64 sign))
+                        (//i64.left_shift ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent)))
+                        (//i64.clear ..mantissa_size (.i64 mantissa))))))
+           (#try.Failure ("lux text concat"  representation))))))]
+
+  [binary //nat.binary //int.binary "Invalid binary syntax: "]
+  [octal //nat.octal //int.octal "Invalid octaladecimal syntax: "]
+  [hex //nat.hex //int.hex "Invalid hexadecimal syntax: "]
+  )
+
+(implementation: #export hash
+  (Hash Frac)
+  
+  (def: &equivalence ..equivalence)
+  (def: hash ..to_bits))
+
+(def: #export (approximately? margin_of_error standard value)
+  (-> Frac Frac Frac Bit)
+  (|> value
+      (..- standard)
+      ..abs
+      (..< margin_of_error)))
+
+(def: #export (mod divisor dividend)
+  (All [m] (-> Frac Frac Frac))
+  (let [remainder (..% divisor dividend)]
+    (if (or (and (..< +0.0 divisor)
+                 (..> +0.0 remainder))
+            (and (..> +0.0 divisor)
+                 (..< +0.0 remainder)))
+      (..+ divisor remainder)
+      remainder)))
diff --git a/stdlib/source/library/lux/math/number/i16.lux b/stdlib/source/library/lux/math/number/i16.lux
new file mode 100644
index 000000000..a35300c11
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/i16.lux
@@ -0,0 +1,24 @@
+(.module:
+  [library
+   [lux (#- i64)
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." maybe]]
+    [type (#+ :by_example)]]]
+  [//
+   ["." i64 (#+ Sub)]])
+
+(def: sub (maybe.assume (i64.sub 16)))
+
+(def: #export I16
+  (:by_example [size]
+               (Sub size)
+               ..sub
+               
+               (I64 size)))
+
+(def: #export equivalence (Equivalence I16) (\ ..sub &equivalence))
+(def: #export width Nat (\ ..sub width))
+(def: #export i16 (-> I64 I16) (\ ..sub narrow))
+(def: #export i64 (-> I16 I64) (\ ..sub widen))
diff --git a/stdlib/source/library/lux/math/number/i32.lux b/stdlib/source/library/lux/math/number/i32.lux
new file mode 100644
index 000000000..a0ecfabc2
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/i32.lux
@@ -0,0 +1,24 @@
+(.module:
+  [library
+   [lux (#- i64)
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." maybe]]
+    [type (#+ :by_example)]]]
+  [//
+   ["." i64 (#+ Sub)]])
+
+(def: sub (maybe.assume (i64.sub 32)))
+
+(def: #export I32
+  (:by_example [size]
+               (Sub size)
+               ..sub
+               
+               (I64 size)))
+
+(def: #export equivalence (Equivalence I32) (\ ..sub &equivalence))
+(def: #export width Nat (\ ..sub width))
+(def: #export i32 (-> I64 I32) (\ ..sub narrow))
+(def: #export i64 (-> I32 I64) (\ ..sub widen))
diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux
new file mode 100644
index 000000000..357b36557
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/i64.lux
@@ -0,0 +1,214 @@
+(.module:
+  [library
+   [lux (#- and or not false true)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]
+     [monoid (#+ Monoid)]]
+    [control
+     ["." try]]]]
+  [//
+   ["n" nat]])
+
+(def: #export bits_per_byte
+  8)
+
+(def: #export bytes_per_i64
+  8)
+
+(def: #export width
+  Nat
+  (n.* ..bits_per_byte
+       ..bytes_per_i64))
+
+(template [   ]
+  [(def: #export ( parameter subject)
+     {#.doc }
+     (All [s] (->  (I64 s) (I64 s)))
+     ( parameter subject))]
+
+  [(I64 Any) or          "lux i64 or"          "Bitwise or."]
+  [(I64 Any) xor         "lux i64 xor"         "Bitwise xor."]
+  [(I64 Any) and         "lux i64 and"         "Bitwise and."]
+  
+  [Nat       left_shift  "lux i64 left-shift"  "Bitwise left-shift."]
+  [Nat       right_shift "lux i64 right-shift" "Unsigned/logic bitwise right-shift."]
+  )
+
+(type: #export Mask
+  I64)
+
+(def: #export (bit position)
+  (-> Nat Mask)
+  (|> 1 .i64 (..left_shift (n.% ..width position))))
+
+(def: #export sign
+  Mask
+  (..bit (dec ..width)))
+
+(def: #export not
+  {#.doc "Bitwise negation."}
+  (All [s] (-> (I64 s) (I64 s)))
+  (..xor (.i64 (dec 0))))
+
+(def: #export false
+  Mask
+  (.i64 0))
+
+(def: #export true
+  Mask
+  (..not ..false))
+
+(def: #export (mask amount_of_bits)
+  (-> Nat Mask)
+  (case amount_of_bits
+    0 ..false
+    bits (case (n.% ..width bits)
+           0 ..true
+           bits (|> 1 .i64 (..left_shift (n.% ..width bits)) .dec))))
+
+(def: (add_shift shift value)
+  (-> Nat Nat Nat)
+  (|> value (right_shift shift) (n.+ value)))
+
+(def: #export (count subject)
+  {#.doc "Count the number of 1s in a bit-map."}
+  (-> (I64 Any) Nat)
+  (let [count' (n.- (|> subject (right_shift 1) (..and 6148914691236517205) i64)
+                    (i64 subject))]
+    (|> count'
+        (right_shift 2) (..and 3689348814741910323) (n.+ (..and 3689348814741910323 count'))
+        (add_shift 4) (..and 1085102592571150095)
+        (add_shift 8)
+        (add_shift 16)
+        (add_shift 32)
+        (..and 127))))
+
+(def: #export (clear idx input)
+  {#.doc "Clear bit at given index."}
+  (All [s] (-> Nat (I64 s) (I64 s)))
+  (|> idx ..bit ..not (..and input)))
+
+(template [  ]
+  [(def: #export ( idx input)
+     {#.doc }
+     (All [s] (-> Nat (I64 s) (I64 s)))
+     (|> idx ..bit ( input)))]
+
+  [set  ..or  "Set bit at given index."]
+  [flip ..xor "Flip bit at given index."]
+  )
+
+(def: #export (set? idx input)
+  (-> Nat (I64 Any) Bit)
+  (|> input (:as I64) (..and (..bit idx)) (n.= 0) .not))
+
+(def: #export (clear? idx input)
+  (-> Nat (I64 Any) Bit)
+  (.not (..set? idx input)))
+
+(template [  ]
+  [(def: #export ( distance input)
+     (All [s] (-> Nat (I64 s) (I64 s)))
+     (..or ( distance input)
+           ( (n.- (n.% ..width distance) ..width) input)))]
+
+  [rotate_left  ..left_shift        ..right_shift]
+  [rotate_right ..right_shift ..left_shift]
+  )
+
+(def: #export (region size offset)
+  (-> Nat Nat Mask)
+  (..left_shift offset (..mask size)))
+
+(implementation: #export equivalence
+  (All [a] (Equivalence (I64 a)))
+
+  (def: (= reference sample)
+    ("lux i64 =" reference sample)))
+
+(implementation: #export hash
+  (All [a] (Hash (I64 a)))
+
+  (def: &equivalence ..equivalence)
+
+  (def: hash .nat))
+
+(template [  ]
+  [(implementation: #export 
+     (All [a] (Monoid (I64 a)))
+
+     (def: identity )
+     (def: compose ))]
+
+  [disjunction ..false ..or]
+  [conjunction ..true ..and]
+  )
+
+(def: #export reverse
+  (All [a] (-> (I64 a) (I64 a)))
+  (let [swapper (: (-> Nat (All [a] (-> (I64 a) (I64 a))))
+                   (function (_ power)
+                     (let [size (..left_shift power 1)
+                           repetitions (: (-> Nat Text Text)
+                                          (function (_ times char)
+                                            (loop [iterations 1
+                                                   output char]
+                                              (if (n.< times iterations)
+                                                (recur (inc iterations)
+                                                       ("lux text concat" char output))
+                                                output))))
+                           pattern (repetitions (n./ (n.+ size size) ..width)
+                                                ("lux text concat"
+                                                 (repetitions size "1")
+                                                 (repetitions size "0")))
+
+                           high (try.assume (\ n.binary decode pattern))
+                           low (..rotate_right size high)]
+                       (function (_ value)
+                         (..or (..right_shift size (..and high value))
+                               (..left_shift size (..and low value)))))))
+        
+        swap/01 (swapper 0)
+        swap/02 (swapper 1)
+        swap/04 (swapper 2)
+        swap/08 (swapper 3)
+        swap/16 (swapper 4)
+        swap/32 (swapper 5)]
+    (|>> swap/32
+         swap/16
+         swap/08
+         swap/04
+         swap/02
+         swap/01)))
+
+(interface: #export (Sub size)
+  (: (Equivalence (I64 size))
+     &equivalence)
+  (: Nat
+     width)
+  (: (-> I64 (I64 size))
+     narrow)
+  (: (-> (I64 size) I64)
+     widen))
+
+(def: #export (sub width)
+  (Ex [size] (-> Nat (Maybe (Sub size))))
+  (if (.and (n.> 0 width)
+            (n.< ..width width))
+    (let [sign_shift (n.- width ..width)
+          sign (..bit (dec width))
+          mantissa (..mask (dec width))
+          co_mantissa (..xor (.i64 -1) mantissa)]
+      (#.Some (: Sub
+                 (implementation
+                  (def: &equivalence ..equivalence)
+                  (def: width width)
+                  (def: (narrow value)
+                    (..or (|> value (..and ..sign) (..right_shift sign_shift))
+                          (|> value (..and mantissa))))
+                  (def: (widen value)
+                    (.i64 (case (.nat (..and sign value))
+                            0 value
+                            _ (..or co_mantissa value))))))))
+    #.None))
diff --git a/stdlib/source/library/lux/math/number/i8.lux b/stdlib/source/library/lux/math/number/i8.lux
new file mode 100644
index 000000000..2e8fc0cf1
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/i8.lux
@@ -0,0 +1,24 @@
+(.module:
+  [library
+   [lux (#- i64)
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." maybe]]
+    [type (#+ :by_example)]]]
+  [//
+   ["." i64 (#+ Sub)]])
+
+(def: sub (maybe.assume (i64.sub 8)))
+
+(def: #export I8
+  (:by_example [size]
+               (Sub size)
+               ..sub
+               
+               (I64 size)))
+
+(def: #export equivalence (Equivalence I8) (\ ..sub &equivalence))
+(def: #export width Nat (\ ..sub width))
+(def: #export i8 (-> I64 I8) (\ ..sub narrow))
+(def: #export i64 (-> I8 I64) (\ ..sub widen))
diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux
new file mode 100644
index 000000000..c72c31e16
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/int.lux
@@ -0,0 +1,260 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [hash (#+ Hash)]
+     [enum (#+ Enum)]
+     [interval (#+ Interval)]
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     [predicate (#+ Predicate)]
+     ["." order (#+ Order)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     [text (#+ Char)]
+     ["." maybe]]]]
+  ["." // #_
+   ["#." nat]
+   ["#." i64]])
+
+(def: #export (= reference sample)
+  {#.doc "Int(eger) equivalence."}
+  (-> Int Int Bit)
+  ("lux i64 =" reference sample))
+
+(def: #export (< reference sample)
+  {#.doc "Int(eger) less-than."}
+  (-> Int Int Bit)
+  ("lux i64 <" reference sample))
+
+(def: #export (<= reference sample)
+  {#.doc "Int(eger) less-than or equal."}
+  (-> Int Int Bit)
+  (if ("lux i64 <" reference sample)
+    #1
+    ("lux i64 =" reference sample)))
+
+(def: #export (> reference sample)
+  {#.doc "Int(eger) greater-than."}
+  (-> Int Int Bit)
+  ("lux i64 <" sample reference))
+
+(def: #export (>= reference sample)
+  {#.doc "Int(eger) greater-than or equal."}
+  (-> Int Int Bit)
+  (if ("lux i64 <" sample reference)
+    #1
+    ("lux i64 =" reference sample)))
+
+(template [ ]
+  [(def: #export 
+     (Predicate Int)
+     ( +0))]
+
+  [..> positive?]
+  [..< negative?]
+  [..= zero?]
+  )
+
+(template [  ]
+  [(def: #export ( left right)
+     {#.doc }
+     (-> Int Int Int)
+     (if ( right left)
+       left
+       right))]
+
+  [min ..< "Int(eger) minimum."]
+  [max ..> "Int(eger) maximum."]
+  )
+
+(template [  ]
+  [(def: #export ( param subject)
+     {#.doc }
+     (-> Int Int Int)
+     ( param subject))]
+
+  [+ "lux i64 +" "Int(eger) addition."]
+  [- "lux i64 -" "Int(eger) substraction."]
+  [* "lux i64 *" "Int(eger) multiplication."]
+  [/ "lux i64 /" "Int(eger) division."]
+  [% "lux i64 %" "Int(eger) remainder."]
+  )
+
+(def: #export (/% param subject)
+  (-> Int Int [Int Int])
+  [(../ param subject)
+   (..% param subject)])
+
+(def: #export (negate value)
+  (-> Int Int)
+  (..- value +0))
+
+(def: #export (abs x)
+  (-> Int Int)
+  (if (..< +0 x)
+    (..* -1 x)
+    x))
+
+(def: #export (signum x)
+  (-> Int Int)
+  (cond (..= +0 x) +0
+        (..< +0 x) -1
+        ## else
+        +1))
+
+## https://rob.conery.io/2018/08/21/mod-and-remainder-are-not-the-same/
+(def: #export (mod divisor dividend)
+  (All [m] (-> Int Int Int))
+  (let [remainder (..% divisor dividend)]
+    (if (or (and (..< +0 divisor)
+                 (..> +0 remainder))
+            (and (..> +0 divisor)
+                 (..< +0 remainder)))
+      (..+ divisor remainder)
+      remainder)))
+
+(def: #export even?
+  (-> Int Bit)
+  (|>> (..% +2) ("lux i64 =" +0)))
+
+(def: #export odd?
+  (-> Int Bit)
+  (|>> ..even? not))
+
+(def: #export (gcd a b)
+  {#.doc "Greatest Common Divisor."}
+  (-> Int Int Int)
+  (case b
+    +0 a
+    _ (gcd b (..% b a))))
+
+(def: #export (co-prime? a b)
+  (-> Int Int Bit)
+  (..= +1 (..gcd a b)))
+
+## https://en.wikipedia.org/wiki/Extended_Euclidean_algorithm
+(def: #export (extended_gcd a b)
+  {#.doc "Extended euclidean algorithm."}
+  (-> Int Int [[Int Int] Int])
+  (loop [x +1 x1 +0
+         y +0 y1 +1
+         a1 a b1 b]
+    (case b1
+      +0 [[x y] a1]
+      _ (let [q (/ b1 a1)]
+          (recur x1 (- (* q x1) x)
+                 y1 (- (* q y1) y)
+                 b1 (- (* q b1) a1))))))
+
+(def: #export (lcm a b)
+  {#.doc "Least Common Multiple."}
+  (-> Int Int Int)
+  (case [a b]
+    (^or [_ +0] [+0 _])
+    +0
+
+    _
+    (|> a (/ (gcd a b)) (* b))
+    ))
+
+(def: #export frac
+  (-> Int Frac)
+  (|>> "lux i64 f64"))
+
+(implementation: #export equivalence
+  (Equivalence Int)
+  
+  (def: = ..=))
+
+(implementation: #export order
+  (Order Int)
+  
+  (def: &equivalence ..equivalence)
+  (def: < ..<))
+
+(implementation: #export enum
+  (Enum Int)
+  
+  (def: &order ..order)
+  (def: succ inc)
+  (def: pred dec))
+
+## TODO: Find out why the numeric literals fail during JS compilation.
+(implementation: #export interval
+  (Interval Int)
+  
+  (def: &enum ..enum)
+  (def: top
+    ## +9,223,372,036,854,775,807
+    (let [half (//i64.left_shift 62 +1)]
+      (+ half
+         (dec half))))
+  (def: bottom
+    ## -9,223,372,036,854,775,808
+    (//i64.left_shift 63 +1)))
+
+(template [  ]
+  [(implementation: #export 
+     (Monoid Int)
+     
+     (def: identity )
+     (def: compose ))]
+
+  [addition       ..+   +0]
+  [multiplication ..*   +1]
+  [maximum        ..max (\ ..interval bottom)]
+  [minimum        ..min (\ ..interval top)]
+  )
+
+(def: -sign "-")
+(def: +sign "+")
+
+(template [  ]
+  [(implementation: #export 
+     (Codec Text Int)
+     
+     (def: (encode value)
+       (if (..< +0 value)
+         (|> value inc ..negate .nat inc (\  encode) ("lux text concat" ..-sign))
+         (|> value .nat (\  encode) ("lux text concat" ..+sign))))
+
+     (def: (decode repr)
+       (let [input_size ("lux text size" repr)]
+         (if (//nat.> 1 input_size)
+           (case ("lux text clip" 0 1 repr)
+             (^ (static ..+sign))
+             (|> repr
+                 ("lux text clip" 1 (dec input_size))
+                 (\  decode)
+                 (\ try.functor map .int))
+             
+             (^ (static ..-sign))
+             (|> repr
+                 ("lux text clip" 1 (dec input_size))
+                 (\  decode)
+                 (\ try.functor map (|>> dec .int ..negate dec)))
+             
+             _
+             (#try.Failure ))
+           (#try.Failure )))))]
+
+  [binary  //nat.binary  "Invalid binary syntax for Int: "]
+  [octal   //nat.octal   "Invalid octal syntax for Int: "]
+  [decimal //nat.decimal "Invalid syntax for Int: "]
+  [hex     //nat.hex     "Invalid hexadecimal syntax for Int: "]
+  )
+
+(implementation: #export hash
+  (Hash Int)
+  
+  (def: &equivalence ..equivalence)
+  (def: hash .nat))
+
+(def: #export (right_shift parameter subject)
+  {#.doc "Signed/arithmetic bitwise right-shift."}
+  (-> Nat Int Int)
+  (//i64.or (//i64.and //i64.sign subject)
+            (//i64.right_shift parameter subject)))
diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux
new file mode 100644
index 000000000..52e252c84
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/nat.lux
@@ -0,0 +1,380 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [hash (#+ Hash)]
+     [enum (#+ Enum)]
+     [interval (#+ Interval)]
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     ["." order (#+ Order)]]
+    [control
+     ["." function]
+     ["." try (#+ Try)]]
+    [data
+     ["." maybe]]]])
+
+(template [   ]
+  [(def: #export ( parameter subject)
+     {#.doc }
+     (-> Nat Nat )
+     ( parameter subject))]
+
+  ["lux i64 =" Bit = "Nat(ural) equivalence."]
+  ["lux i64 +" Nat + "Nat(ural) addition."]
+  ["lux i64 -" Nat - "Nat(ural) substraction."]
+  )
+
+(def: high
+  (-> (I64 Any) I64)
+  (|>> ("lux i64 right-shift" 32)))
+
+(def: low
+  (-> (I64 Any) I64)
+  (let [mask (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))]
+    (|>> ("lux i64 and" mask))))
+
+(def: #export (< reference sample)
+  {#.doc "Nat(ural) less-than."}
+  (-> Nat Nat Bit)
+  (let [referenceH (..high reference)
+        sampleH (..high sample)]
+    (if ("lux i64 <" referenceH sampleH)
+      #1
+      (if ("lux i64 =" referenceH sampleH)
+        ("lux i64 <"
+         (..low reference)
+         (..low sample))
+        #0))))
+
+(def: #export (<= reference sample)
+  {#.doc "Nat(ural) less-than or equal."}
+  (-> Nat Nat Bit)
+  (if (..< reference sample)
+    #1
+    ("lux i64 =" reference sample)))
+
+(def: #export (> reference sample)
+  {#.doc "Nat(ural) greater-than."}
+  (-> Nat Nat Bit)
+  (..< sample reference))
+
+(def: #export (>= reference sample)
+  {#.doc "Nat(ural) greater-than or equal."}
+  (-> Nat Nat Bit)
+  (if (..< sample reference)
+    #1
+    ("lux i64 =" reference sample)))
+
+(template [  ]
+  [(def: #export ( left right)
+     {#.doc }
+     (-> Nat Nat Nat)
+     (if ( right left)
+       left
+       right))]
+
+  [min ..< "Nat(ural) minimum."]
+  [max ..> "Nat(ural) maximum."]
+  )
+
+(def: #export (* parameter subject)
+  {#.doc "Nat(ural) multiplication."}
+  (-> Nat Nat Nat)
+  (:as Nat
+       ("lux i64 *"
+        (:as Int parameter)
+        (:as Int subject))))
+
+(def: #export (/ parameter subject)
+  {#.doc "Nat(ural) division."}
+  (-> Nat Nat Nat)
+  (if ("lux i64 <" +0 (:as Int parameter))
+    (if (..< parameter subject)
+      0
+      1)
+    (let [quotient (|> subject
+                       ("lux i64 right-shift" 1)
+                       ("lux i64 /" (:as Int parameter))
+                       ("lux i64 left-shift" 1))
+          flat ("lux i64 *"
+                (:as Int parameter)
+                (:as Int quotient))
+          remainder ("lux i64 -" flat subject)]
+      (if (..< parameter remainder)
+        quotient
+        ("lux i64 +" 1 quotient)))))
+
+(def: #export (/% parameter subject)
+  {#.doc "Nat(ural) [division remainder]."}
+  (-> Nat Nat [Nat Nat])
+  (let [quotient (../ parameter subject)
+        flat ("lux i64 *"
+              (:as Int parameter)
+              (:as Int quotient))]
+    [quotient ("lux i64 -" flat subject)]))
+
+(def: #export (% parameter subject)
+  {#.doc "Nat(ural) remainder."}
+  (-> Nat Nat Nat)
+  (let [flat ("lux i64 *"
+              (:as Int parameter)
+              (:as Int (../ parameter subject)))]
+    ("lux i64 -" flat subject)))
+
+(def: #export (gcd a b)
+  {#.doc "Greatest Common Divisor."}
+  (-> Nat Nat Nat)
+  (case b
+    0 a
+    _ (gcd b (..% b a))))
+
+(def: #export (co-prime? a b)
+  (-> Nat Nat Bit)
+  (..= 1 (..gcd a b)))
+
+(def: #export (lcm a b)
+  {#.doc "Least Common Multiple."}
+  (-> Nat Nat Nat)
+  (case [a b]
+    (^or [_ 0] [0 _])
+    0
+
+    _
+    (|> a (../ (..gcd a b)) (..* b))))
+
+(def: #export even?
+  (-> Nat Bit)
+  (|>> (..% 2) ("lux i64 =" 0)))
+
+(def: #export odd?
+  (-> Nat Bit)
+  (|>> ..even? not))
+
+(def: #export frac
+  (-> Nat Frac)
+  (|>> .int "lux i64 f64"))
+
+(implementation: #export equivalence
+  (Equivalence Nat)
+  
+  (def: = ..=))
+
+(implementation: #export order
+  (Order Nat)
+  
+  (def: &equivalence ..equivalence)
+  (def: < ..<))
+
+(implementation: #export enum
+  (Enum Nat)
+  
+  (def: &order ..order)
+  (def: succ inc)
+  (def: pred dec))
+
+(implementation: #export interval
+  (Interval Nat)
+
+  (def: &enum ..enum)
+  (def: top (dec 0))
+  (def: bottom 0))
+
+(template [  ]
+  [(implementation: #export 
+     (Monoid Nat)
+     
+     (def: identity )
+     (def: compose ))]
+
+  [addition       ..+   0]
+  [multiplication ..*   1]
+  [minimum        ..min (\ ..interval top)]
+  [maximum        ..max (\ ..interval bottom)]
+  )
+
+(def: (binary-character value)
+  (-> Nat Text)
+  (case value
+    0 "0"
+    1 "1"
+    _ (undefined)))
+
+(def: (binary-value digit)
+  (-> Nat (Maybe Nat))
+  (case digit
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    _ #.None))
+
+(def: (octal-character value)
+  (-> Nat Text)
+  (case value
+    0 "0"
+    1 "1"
+    2 "2"
+    3 "3"
+    4 "4"
+    5 "5"
+    6 "6"
+    7 "7"
+    _ (undefined)))
+
+(def: (octal-value digit)
+  (-> Nat (Maybe Nat))
+  (case digit
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    (^ (char "2")) (#.Some 2)
+    (^ (char "3")) (#.Some 3)
+    (^ (char "4")) (#.Some 4)
+    (^ (char "5")) (#.Some 5)
+    (^ (char "6")) (#.Some 6)
+    (^ (char "7")) (#.Some 7)
+    _ #.None))
+
+(def: (decimal-character value)
+  (-> Nat Text)
+  (case value
+    0 "0"
+    1 "1"
+    2 "2"
+    3 "3"
+    4 "4"
+    5 "5"
+    6 "6"
+    7 "7"
+    8 "8"
+    9 "9"
+    _ (undefined)))
+
+(def: (decimal-value digit)
+  (-> Nat (Maybe Nat))
+  (case digit
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    (^ (char "2")) (#.Some 2)
+    (^ (char "3")) (#.Some 3)
+    (^ (char "4")) (#.Some 4)
+    (^ (char "5")) (#.Some 5)
+    (^ (char "6")) (#.Some 6)
+    (^ (char "7")) (#.Some 7)
+    (^ (char "8")) (#.Some 8)
+    (^ (char "9")) (#.Some 9)
+    _ #.None))
+
+(def: (hexadecimal-character value)
+  (-> Nat Text)
+  (case value
+    0 "0"
+    1 "1"
+    2 "2"
+    3 "3"
+    4 "4"
+    5 "5"
+    6 "6"
+    7 "7"
+    8 "8"
+    9 "9"
+    10 "A"
+    11 "B"
+    12 "C"
+    13 "D"
+    14 "E"
+    15 "F"
+    _ (undefined)))
+
+(def: (hexadecimal-value digit)
+  (-> Nat (Maybe Nat))
+  (case digit
+    (^template [ ]
+      [(^ (char )) (#.Some )])
+    (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4]
+     ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9])
+
+    (^template [  ]
+      [(^or (^ (char )) (^ (char ))) (#.Some )])
+    (["a" "A" 10] ["b" "B" 11] ["c" "C" 12]
+     ["d" "D" 13] ["e" "E" 14] ["f" "F" 15])
+    _ #.None))
+
+(template [    ]
+  [(implementation: #export 
+     (Codec Text Nat)
+     
+     (def: encode
+       (let [mask (|> 1 ("lux i64 left-shift" ) dec)]
+         (function (_ value)
+           (loop [input value
+                  output ""]
+             (let [output' ("lux text concat"
+                            ( ("lux i64 and" mask input))
+                            output)]
+               (case (: Nat ("lux i64 right-shift"  input))
+                 0
+                 output'
+
+                 input'
+                 (recur input' output')))))))
+
+     (def: (decode repr)
+       (let [input-size ("lux text size" repr)]
+         (if (..> 0 input-size)
+           (loop [idx 0
+                  output 0]
+             (if (..< input-size idx)
+               (case ( ("lux text char" idx repr))
+                 (#.Some digit-value)
+                 (recur (inc idx)
+                        (|> output
+                            ("lux i64 left-shift" )
+                            ("lux i64 or" digit-value)))
+
+                 _
+                 (#try.Failure ("lux text concat"  repr)))
+               (#try.Success output)))
+           (#try.Failure ("lux text concat"  repr))))))]
+
+  [1 binary binary-character      binary-value      "Invalid binary syntax for Nat: "]
+  [3 octal  octal-character       octal-value       "Invalid octal syntax for Nat: "]
+  [4 hex    hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
+  )
+
+(implementation: #export decimal
+  (Codec Text Nat)
+  
+  (def: (encode value)
+    (loop [input value
+           output ""]
+      (let [digit (decimal-character (..% 10 input))
+            output' ("lux text concat" digit output)]
+        (case (../ 10 input)
+          0
+          output'
+
+          input'
+          (recur input' output')))))
+
+  (def: (decode repr)
+    (let [input-size ("lux text size" repr)]
+      (with_expansions [ (#try.Failure ("lux text concat" "Invalid decimal syntax for Nat: " repr))]
+        (if (..> 0 input-size)
+          (loop [idx 0
+                 output 0]
+            (if (..< input-size idx)
+              (case (decimal-value ("lux text char" idx repr))
+                #.None
+                
+
+                (#.Some digit-value)
+                (recur (inc idx)
+                       (|> output (..* 10) (..+ digit-value))))
+              (#try.Success output)))
+          )))))
+
+(implementation: #export hash
+  (Hash Nat)
+  
+  (def: &equivalence ..equivalence)
+  (def: hash function.identity))
diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux
new file mode 100644
index 000000000..ecfdf30a0
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/ratio.lux
@@ -0,0 +1,162 @@
+(.module:
+  {#.doc "Rational numbers."}
+  [library
+   [lux (#- nat)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]
+     [monoid (#+ Monoid)]
+     [codec (#+ Codec)]
+     [monad (#+ do)]]
+    [control
+     ["." function]
+     ["." try]
+     ["<>" parser
+      ["<.>" code (#+ Parser)]]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text ("#\." monoid)]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]]]
+  [//
+   ["n" nat ("#\." decimal)]])
+
+(type: #export Ratio
+  {#numerator Nat
+   #denominator Nat})
+
+(def: #export (nat value)
+  (-> Ratio (Maybe Nat))
+  (case (get@ #denominator value)
+    1 (#.Some (get@ #numerator value))
+    _ #.None))
+
+(def: (normalize (^slots [#numerator #denominator]))
+  (-> Ratio Ratio)
+  (let [common (n.gcd numerator denominator)]
+    {#numerator (n./ common numerator)
+     #denominator (n./ common denominator)}))
+
+(syntax: #export (ratio numerator {?denominator (<>.maybe .any)})
+  {#.doc (doc "Rational literals."
+              (ratio numerator denominator)
+              "The denominator can be omitted if it's 1."
+              (ratio numerator))}
+  (wrap (list (` ((~! ..normalize) {#..numerator (~ numerator)
+                                    #..denominator (~ (maybe.default (' 1)
+                                                                     ?denominator))})))))
+
+(def: #export (= parameter subject)
+  (-> Ratio Ratio Bit)
+  (and (n.= (get@ #numerator parameter)
+            (get@ #numerator subject))
+       (n.= (get@ #denominator parameter)
+            (get@ #denominator subject))))
+
+(implementation: #export equivalence
+  (Equivalence Ratio)
+  
+  (def: = ..=))
+
+(def: (equalize parameter subject)
+  (-> Ratio Ratio [Nat Nat])
+  [(n.* (get@ #denominator subject)
+        (get@ #numerator parameter))
+   (n.* (get@ #denominator parameter)
+        (get@ #numerator subject))])
+
+(def: #export (< parameter subject)
+  (-> Ratio Ratio Bit)
+  (let [[parameter' subject'] (..equalize parameter subject)]
+    (n.< parameter' subject')))
+
+(def: #export (<= parameter subject)
+  (-> Ratio Ratio Bit)
+  (or (< parameter subject)
+      (= parameter subject)))
+
+(def: #export (> parameter subject)
+  (-> Ratio Ratio Bit)
+  (..< subject parameter))
+
+(def: #export (>= parameter subject)
+  (-> Ratio Ratio Bit)
+  (or (> parameter subject)
+      (= parameter subject)))
+
+(implementation: #export order
+  (Order Ratio)
+  
+  (def: &equivalence ..equivalence)
+  (def: < ..<))
+
+(def: #export (+ parameter subject)
+  (-> Ratio Ratio Ratio)
+  (let [[parameter' subject'] (..equalize parameter subject)]
+    (normalize [(n.+ parameter' subject')
+                (n.* (get@ #denominator parameter)
+                     (get@ #denominator subject))])))
+
+(def: #export (- parameter subject)
+  (-> Ratio Ratio Ratio)
+  (let [[parameter' subject'] (..equalize parameter subject)]
+    (normalize [(n.- parameter' subject')
+                (n.* (get@ #denominator parameter)
+                     (get@ #denominator subject))])))
+
+(def: #export (* parameter subject)
+  (-> Ratio Ratio Ratio)
+  (normalize [(n.* (get@ #numerator parameter)
+                   (get@ #numerator subject))
+              (n.* (get@ #denominator parameter)
+                   (get@ #denominator subject))]))
+
+(def: #export (/ parameter subject)
+  (-> Ratio Ratio Ratio)
+  (let [[parameter' subject'] (..equalize parameter subject)]
+    (normalize [subject' parameter'])))
+
+(def: #export (% parameter subject)
+  (-> Ratio Ratio Ratio)
+  (let [[parameter' subject'] (..equalize parameter subject)
+        quot (n./ parameter' subject')]
+    (..- (update@ #numerator (n.* quot) parameter)
+         subject)))
+
+(def: #export (reciprocal (^slots [#numerator #denominator]))
+  (-> Ratio Ratio)
+  {#numerator denominator
+   #denominator numerator})
+
+(def: separator ":")
+
+(implementation: #export codec
+  (Codec Text Ratio)
+  
+  (def: (encode (^slots [#numerator #denominator]))
+    ($_ text\compose (n\encode numerator) ..separator (n\encode denominator)))
+
+  (def: (decode input)
+    (case (text.split_with ..separator input)
+      (#.Some [num denom])
+      (do try.monad
+        [numerator (n\decode num)
+         denominator (n\decode denom)]
+        (wrap (normalize {#numerator numerator
+                          #denominator denominator})))
+      
+      #.None
+      (#.Left (text\compose "Invalid syntax for ratio: " input)))))
+
+(template [  ]
+  [(implementation: #export 
+     (Monoid Ratio)
+
+     (def: identity (..ratio ))
+     (def: compose ))]
+  
+  [0 ..+ addition]
+  [1 ..* multiplication]
+  )
diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux
new file mode 100644
index 000000000..431f44ed1
--- /dev/null
+++ b/stdlib/source/library/lux/math/number/rev.lux
@@ -0,0 +1,463 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [hash (#+ Hash)]
+     [enum (#+ Enum)]
+     [interval (#+ Interval)]
+     [monoid (#+ Monoid)]
+     [equivalence (#+ Equivalence)]
+     [codec (#+ Codec)]
+     [order (#+ Order)]]
+    [control
+     ["." try]]
+    [data
+     ["." maybe]
+     [collection
+      ["." array (#+ Array)]]]]]
+  ["." // #_
+   ["#." i64]
+   ["#." nat]
+   ["#." int]])
+
+(template [ ]
+  [(def: #export 
+     Rev
+     (.rev (//i64.left_shift (//nat.-  //i64.width) 1)))]
+
+  [01 /2]
+  [02 /4]
+  [03 /8]
+  [04 /16]
+  [05 /32]
+  [06 /64]
+  [07 /128]
+  [08 /256]
+  [09 /512]
+  [10 /1024]
+  [11 /2048]
+  [12 /4096]
+  )
+
+(def: #export (= reference sample)
+  {#.doc "Rev(olution) equivalence."}
+  (-> Rev Rev Bit)
+  ("lux i64 =" reference sample))
+
+(def: #export (< reference sample)
+  {#.doc "Rev(olution) less-than."}
+  (-> Rev Rev Bit)
+  (//nat.< (.nat reference) (.nat sample)))
+
+(def: #export (<= reference sample)
+  {#.doc "Rev(olution) less-than or equal."}
+  (-> Rev Rev Bit)
+  (if (//nat.< (.nat reference) (.nat sample))
+    true
+    ("lux i64 =" reference sample)))
+
+(def: #export (> reference sample)
+  {#.doc "Rev(olution) greater-than."}
+  (-> Rev Rev Bit)
+  (..< sample reference))
+
+(def: #export (>= reference sample)
+  {#.doc "Rev(olution) greater-than or equal."}
+  (-> Rev Rev Bit)
+  (if (..< sample reference)
+    true
+    ("lux i64 =" reference sample)))
+
+(template [  ]
+  [(def: #export ( left right)
+     {#.doc }
+     (-> Rev Rev Rev)
+     (if ( right left)
+       left
+       right))]
+
+  [min ..< "Rev(olution) minimum."]
+  [max ..> "Rev(olution) maximum."]
+  )
+
+(template [  ]
+  [(def: #export ( param subject)
+     {#.doc }
+     (-> Rev Rev Rev)
+     ( param subject))]
+
+  [+ "lux i64 +" "Rev(olution) addition."]
+  [- "lux i64 -" "Rev(olution) substraction."]
+  )
+
+(def: high
+  (-> (I64 Any) I64)
+  (|>> ("lux i64 right-shift" 32)))
+
+(def: low
+  (-> (I64 Any) I64)
+  (let [mask (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))]
+    (|>> ("lux i64 and" mask))))
+
+(def: #export (* param subject)
+  {#.doc "Rev(olution) multiplication."}
+  (-> Rev Rev Rev)
+  (let [subjectH (..high subject)
+        subjectL (..low subject)
+        paramH (..high param)
+        paramL (..low param)
+        bottom (|> subjectL
+                   ("lux i64 *" paramL)
+                   ("lux i64 right-shift" 32))
+        middle ("lux i64 +"
+                ("lux i64 *" paramL subjectH)
+                ("lux i64 *" paramH subjectL))
+        top ("lux i64 *" subjectH paramH)]
+    (|> bottom
+        ("lux i64 +" middle)
+        ..high
+        ("lux i64 +" top))))
+
+(def: even_one (//i64.rotate_right 1 1))
+(def: odd_one (dec 0))
+
+(def: (even_reciprocal numerator)
+  (-> Nat Nat)
+  (//nat./ (//i64.right_shift 1 numerator)
+           ..even_one))
+
+(def: (odd_reciprocal numerator)
+  (-> Nat Nat)
+  (//nat./ numerator ..odd_one))
+
+(with_expansions [ 1]
+  (def: #export (reciprocal numerator)
+    {#.doc "Rev(olution) reciprocal of a Nat(ural)."}
+    (-> Nat Rev)
+    (.rev (case (: Nat ("lux i64 and"  numerator))
+            0 (..even_reciprocal numerator)
+            _ (..odd_reciprocal numerator))))
+  
+  (def: #export (/ param subject)
+    {#.doc "Rev(olution) division."}
+    (-> Rev Rev Rev)
+    (if ("lux i64 =" +0 param)
+      (error! "Cannot divide Rev by zero!")
+      (let [reciprocal (case (: Nat ("lux i64 and"  param))
+                         0 (..even_reciprocal (.nat param))
+                         _ (..odd_reciprocal (.nat param)))]
+        (.rev (//nat.* reciprocal (.nat subject)))))))
+
+(template [    ]
+  [(def: #export ( param subject)
+     {#.doc }
+     (-> Rev Rev )
+     ( ( (.nat param) (.nat subject))))]
+
+  [//nat.% % .rev Rev "Rev(olution) remainder."]
+  [//nat./ ratio |> Nat "Ratio between two rev(olution)s."]
+  )
+
+(template [ ]
+  [(def: #export ( scale subject)
+     (-> Nat Rev Rev)
+     (.rev ( (.nat scale) (.nat subject))))]
+
+  [//nat.* up]
+  [//nat./ down]
+  )
+
+(def: #export (/% param subject)
+  (-> Rev Rev [Rev Rev])
+  [(../ param subject)
+   (..% param subject)])
+
+(def: mantissa
+  (-> (I64 Any) Frac)
+  (|>> ("lux i64 right-shift" 11)
+       "lux i64 f64"))
+
+(def: frac_denominator
+  (..mantissa -1))
+
+(def: #export frac
+  (-> Rev Frac)
+  (|>> ..mantissa ("lux f64 /" ..frac_denominator)))
+
+(implementation: #export equivalence
+  (Equivalence Rev)
+  
+  (def: = ..=))
+
+(implementation: #export hash
+  (Hash Rev)
+  
+  (def: &equivalence ..equivalence)
+  (def: hash .nat))
+
+(implementation: #export order
+  (Order Rev)
+  
+  (def: &equivalence ..equivalence)
+  (def: < ..<))
+
+(implementation: #export enum
+  (Enum Rev)
+  
+  (def: &order ..order)
+  (def: succ inc)
+  (def: pred dec))
+
+(implementation: #export interval
+  (Interval Rev)
+  
+  (def: &enum ..enum)
+  (def: top (.rev -1))
+  (def: bottom (.rev 0)))
+
+(template [  ]
+  [(implementation: #export 
+     (Monoid Rev)
+     
+     (def: identity (\ interval ))
+     (def: compose ))]
+
+  [addition ..+   bottom]
+  [maximum  ..max bottom]
+  [minimum  ..min top]
+  )
+
+(def: (de_prefix input)
+  (-> Text Text)
+  ("lux text clip" 1 (dec ("lux text size" input)) input))
+
+(template [   ]
+  [(with_expansions [ (as_is (#try.Failure ("lux text concat"  repr)))]
+     (implementation: #export 
+       (Codec Text Rev)
+       
+       (def: (encode value)
+         (let [raw_output (\  encode (.nat value))
+               max_num_chars (//nat.+ (//nat./  //i64.width)
+                                      (case (//nat.%  //i64.width)
+                                        0 0
+                                        _ 1))
+               raw_size ("lux text size" raw_output)
+               zero_padding (: Text
+                               (loop [zeroes_left (: Nat (//nat.- raw_size max_num_chars))
+                                      output (: Text "")]
+                                 (if (//nat.= 0 zeroes_left)
+                                   output
+                                   (recur (dec zeroes_left)
+                                          ("lux text concat" "0" output)))))]
+           (|> raw_output
+               ("lux text concat" zero_padding)
+               ("lux text concat" "."))))
+
+       (def: (decode repr)
+         (let [repr_size ("lux text size" repr)]
+           (if (//nat.> 1 repr_size)
+             (case ("lux text char" 0 repr)
+               (^ (char "."))
+               (case (\  decode (de_prefix repr))
+                 (#try.Success output)
+                 (#try.Success (.rev output))
+
+                 _
+                 )
+               
+               _
+               )
+             )))))]
+
+  [binary //nat.binary 1 "Invalid binary syntax: "]
+  [octal  //nat.octal  3 "Invalid octal syntax: "]
+  [hex    //nat.hex    4 "Invalid hexadecimal syntax: "]
+  )
+
+## The following code allows one to encode/decode Rev numbers as text.
+## This is not a simple algorithm, and it requires subverting the Rev
+## abstraction a bit.
+## It takes into account the fact that Rev numbers are represented by
+## Lux as 64-bit integers.
+## A valid way to model them is as Lux's Nat type.
+## This is a somewhat hackish way to do things, but it allows one to
+## write the encoding/decoding algorithm once, in pure Lux, rather
+## than having to implement it on the compiler for every platform
+## targeted by Lux.
+(type: Digits (Array Nat))
+
+(def: (digits::new _)
+  (-> Any Digits)
+  (array.new //i64.width))
+
+(def: (digits::get idx digits)
+  (-> Nat Digits Nat)
+  (|> digits (array.read idx) (maybe.default 0)))
+
+(def: digits::put
+  (-> Nat Nat Digits Digits)
+  array.write!)
+
+(def: (prepend left right)
+  (-> Text Text Text)
+  ("lux text concat" left right))
+
+(def: (digits::times_5! idx output)
+  (-> Nat Digits Digits)
+  (loop [idx idx
+         carry 0
+         output output]
+    (if (//int.>= +0 (.int idx))
+      (let [raw (|> (digits::get idx output)
+                    (//nat.* 5)
+                    (//nat.+ carry))]
+        (recur (dec idx)
+               (//nat./ 10 raw)
+               (digits::put idx (//nat.% 10 raw) output)))
+      output)))
+
+(def: (digits::power power)
+  (-> Nat Digits)
+  (loop [times power
+         output (|> (digits::new [])
+                    (digits::put power 1))]
+    (if (//int.>= +0 (.int times))
+      (recur (dec times)
+             (digits::times_5! power output))
+      output)))
+
+(def: (digits::format digits)
+  (-> Digits Text)
+  (loop [idx (dec //i64.width)
+         all_zeroes? true
+         output ""]
+    (if (//int.>= +0 (.int idx))
+      (let [digit (digits::get idx digits)]
+        (if (and (//nat.= 0 digit)
+                 all_zeroes?)
+          (recur (dec idx) true output)
+          (recur (dec idx)
+                 false
+                 ("lux text concat"
+                  (\ //nat.decimal encode digit)
+                  output))))
+      (if all_zeroes?
+        "0"
+        output))))
+
+(def: (digits::+ param subject)
+  (-> Digits Digits Digits)
+  (loop [idx (dec //i64.width)
+         carry 0
+         output (digits::new [])]
+    (if (//int.>= +0 (.int idx))
+      (let [raw ($_ //nat.+
+                    carry
+                    (digits::get idx param)
+                    (digits::get idx subject))]
+        (recur (dec idx)
+               (//nat./ 10 raw)
+               (digits::put idx (//nat.% 10 raw) output)))
+      output)))
+
+(def: (text_to_digits input)
+  (-> Text (Maybe Digits))
+  (let [length ("lux text size" input)]
+    (if (//nat.<= //i64.width length)
+      (loop [idx 0
+             output (digits::new [])]
+        (if (//nat.< length idx)
+          (case ("lux text index" 0 ("lux text clip" idx 1 input) "0123456789")
+            #.None
+            #.None
+
+            (#.Some digit)
+            (recur (inc idx)
+                   (digits::put idx digit output)))
+          (#.Some output)))
+      #.None)))
+
+(def: (digits::< param subject)
+  (-> Digits Digits Bit)
+  (loop [idx 0]
+    (and (//nat.< //i64.width idx)
+         (let [pd (digits::get idx param)
+               sd (digits::get idx subject)]
+           (if (//nat.= pd sd)
+             (recur (inc idx))
+             (//nat.< pd sd))))))
+
+(def: (digits::-!' idx param subject)
+  (-> Nat Nat Digits Digits)
+  (let [sd (digits::get idx subject)]
+    (if (//nat.>= param sd)
+      (digits::put idx (//nat.- param sd) subject)
+      (let [diff (|> sd
+                     (//nat.+ 10)
+                     (//nat.- param))]
+        (|> subject
+            (digits::put idx diff)
+            (digits::-!' (dec idx) 1))))))
+
+(def: (digits::-! param subject)
+  (-> Digits Digits Digits)
+  (loop [idx (dec //i64.width)
+         output subject]
+    (if (//int.>= +0 (.int idx))
+      (recur (dec idx)
+             (digits::-!' idx (digits::get idx param) output))
+      output)))
+
+(implementation: #export decimal
+  (Codec Text Rev)
+  
+  (def: (encode input)
+    (case (.nat input)
+      0
+      ".0"
+
+      input
+      (let [last_idx (dec //i64.width)]
+        (loop [idx last_idx
+               digits (digits::new [])]
+          (if (//int.>= +0 (.int idx))
+            (if (//i64.set? idx input)
+              (let [digits' (digits::+ (digits::power (//nat.- idx last_idx))
+                                       digits)]
+                (recur (dec idx)
+                       digits'))
+              (recur (dec idx)
+                     digits))
+            ("lux text concat" "." (digits::format digits))
+            )))))
+
+  (def: (decode input)
+    (let [dotted? (case ("lux text index" 0 "." input)
+                    (#.Some 0)
+                    true
+
+                    _
+                    false)
+          within_limits? (//nat.<= (inc //i64.width)
+                                   ("lux text size" input))]
+      (if (and dotted? within_limits?)
+        (case (text_to_digits (de_prefix input))
+          (#.Some digits)
+          (loop [digits digits
+                 idx 0
+                 output 0]
+            (if (//nat.< //i64.width idx)
+              (let [power (digits::power idx)]
+                (if (digits::< power digits)
+                  ## Skip power
+                  (recur digits (inc idx) output)
+                  (recur (digits::-! power digits)
+                         (inc idx)
+                         (//i64.set (//nat.- idx (dec //i64.width)) output))))
+              (#try.Success (.rev output))))
+
+          #.None
+          (#try.Failure ("lux text concat" "Wrong syntax for Rev: " input)))
+        (#try.Failure ("lux text concat" "Wrong syntax for Rev: " input))))
+    ))
diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux
new file mode 100644
index 000000000..8b555e21d
--- /dev/null
+++ b/stdlib/source/library/lux/math/random.lux
@@ -0,0 +1,400 @@
+(.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."}
+  [library
+   [lux (#- or and list i64 nat int rev char)
+    [abstract
+     [hash (#+ Hash)]
+     [functor (#+ Functor)]
+     [apply (#+ Apply)]
+     ["." monad (#+ Monad do)]]
+    [data
+     ["." text (#+ Char) ("#\." monoid)
+      ["." unicode #_
+       ["#" set]]]
+     [collection
+      ["." list ("#\." fold)]
+      ["." array (#+ Array)]
+      ["." dictionary (#+ Dictionary)]
+      ["." queue (#+ Queue)]
+      ["." set (#+ Set)]
+      ["." stack (#+ Stack)]
+      ["." row (#+ Row)]
+      [tree
+       ["." finger (#+ Tree)]]]]
+    [math
+     [number (#+ hex)
+      ["n" nat]
+      ["i" int]
+      ["f" frac]
+      ["r" ratio]
+      ["c" complex]
+      ["." i64]]]
+    ["." time (#+ Time)
+     ["." instant (#+ Instant)]
+     ["." date (#+ Date)]
+     ["." duration (#+ Duration)]
+     ["." month (#+ Month)]
+     ["." day (#+ Day)]]
+    [type
+     [refinement (#+ Refiner Refined)]]]])
+
+(type: #export #rec PRNG
+  {#.doc "An abstract way to represent any PRNG."}
+  (-> Any [PRNG I64]))
+
+(type: #export (Random a)
+  {#.doc "A producer of random values based on a PRNG."}
+  (-> PRNG [PRNG a]))
+
+(implementation: #export functor
+  (Functor Random)
+  
+  (def: (map f fa)
+    (function (_ state)
+      (let [[state' a] (fa state)]
+        [state' (f a)]))))
+
+(implementation: #export apply
+  (Apply Random)
+  
+  (def: &functor ..functor)
+
+  (def: (apply ff fa)
+    (function (_ state)
+      (let [[state' f] (ff state)
+            [state'' a] (fa state')]
+        [state'' (f a)]))))
+
+(implementation: #export monad
+  (Monad Random)
+  
+  (def: &functor ..functor)
+
+  (def: (wrap a)
+    (function (_ state)
+      [state a]))
+
+  (def: (join ffa)
+    (function (_ state)
+      (let [[state' fa] (ffa state)]
+        (fa state')))))
+
+(def: #export (filter pred gen)
+  {#.doc "Retries the generator until the output satisfies a predicate."}
+  (All [a] (-> (-> a Bit) (Random a) (Random a)))
+  (do ..monad
+    [sample gen]
+    (if (pred sample)
+      (wrap sample)
+      (filter pred gen))))
+
+(def: #export (one check random)
+  (All [a b]
+    (-> (-> a (Maybe b)) (Random a) (Random b)))
+  (do ..monad
+    [sample random]
+    (case (check sample)
+      (#.Some output)
+      (wrap output)
+
+      #.None
+      (one check random))))
+
+(def: #export (refine refiner gen)
+  {#.doc "Retries the generator until the output can be refined."}
+  (All [t r] (-> (Refiner t r) (Random t) (Random (Refined t r))))
+  (do ..monad
+    [sample gen]
+    (case (refiner sample)
+      (#.Some refined)
+      (wrap refined)
+
+      #.None
+      (refine refiner gen))))
+
+(def: #export bit
+  (Random Bit)
+  (function (_ prng)
+    (let [[prng output] (prng [])]
+      [prng (|> output (i64.and 1) (n.= 1))])))
+
+(def: #export i64
+  (Random I64)
+  (function (_ prng)
+    (let [[prng left] (prng [])
+          [prng right] (prng [])]
+      [prng (|> left
+                (i64.left_shift 32)
+                ("lux i64 +" right))])))
+
+(template [  ]
+  [(def: #export 
+     (Random )
+     (\ ..monad map  ..i64))]
+
+  [nat Nat .nat]
+  [int Int .int]
+  [rev Rev .rev]
+  )
+
+(def: #export frac
+  (Random Frac)
+  (\ ..monad map (|>> .i64 f.from_bits) ..nat))
+
+(def: #export safe_frac
+  (Random Frac)
+  (let [mantissa_range (.int (i64.left_shift 53 1))
+        mantissa_max (i.frac (dec mantissa_range))]
+    (\ ..monad map
+       (|>> (i.% mantissa_range)
+            i.frac
+            (f./ mantissa_max))
+       ..int)))
+
+(def: #export (char set)
+  (-> unicode.Set (Random Char))
+  (let [[start end] (unicode.range set)
+        size (n.- start end)
+        in_range (: (-> Char Char)
+                    (|>> (n.% size) (n.+ start)))]
+    (|> ..nat
+        (\ ..monad map in_range)
+        (..filter (unicode.member? set)))))
+
+(def: #export (text char_gen size)
+  (-> (Random Char) Nat (Random Text))
+  (if (n.= 0 size)
+    (\ ..monad wrap "")
+    (do ..monad
+      [x char_gen
+       xs (text char_gen (dec size))]
+      (wrap (text\compose (text.from_code x) xs)))))
+
+(template [ ]
+  [(def: #export 
+     (-> Nat (Random Text))
+     (..text (..char )))]
+
+  [unicode         unicode.character]
+  [ascii           unicode.ascii]
+  [ascii/alpha     unicode.ascii/alpha]
+  [ascii/alpha_num unicode.ascii/alpha_num]
+  [ascii/numeric   unicode.ascii/numeric]
+  [ascii/upper     unicode.ascii/upper]
+  [ascii/lower     unicode.ascii/lower]
+  )
+
+(template [   ]
+  [(def: #export 
+     (Random )
+     (do ..monad
+       [left 
+        right ]
+       (wrap ( left right))))]
+
+  [ratio   r.Ratio   r.ratio   ..nat]
+  [complex c.Complex c.complex ..safe_frac]
+  )
+
+(def: #export (and left right)
+  {#.doc "Sequencing combinator."}
+  (All [a b] (-> (Random a) (Random b) (Random [a b])))
+  (do ..monad
+    [=left left
+     =right right]
+    (wrap [=left =right])))
+
+(def: #export (or left right)
+  {#.doc "Heterogeneous alternative combinator."}
+  (All [a b] (-> (Random a) (Random b) (Random (| a b))))
+  (do {! ..monad}
+    [? bit]
+    (if ?
+      (do !
+        [=left left]
+        (wrap (0 #0 =left)))
+      (do !
+        [=right right]
+        (wrap (0 #1 =right))))))
+
+(def: #export (either left right)
+  {#.doc "Homogeneous alternative combinator."}
+  (All [a] (-> (Random a) (Random a) (Random a)))
+  (do ..monad
+    [? bit]
+    (if ?
+      left
+      right)))
+
+(def: #export (rec gen)
+  {#.doc "A combinator for producing recursive random generators."}
+  (All [a] (-> (-> (Random a) (Random a)) (Random a)))
+  (function (_ state)
+    (let [gen' (gen (rec gen))]
+      (gen' state))))
+
+(def: #export (maybe value_gen)
+  (All [a] (-> (Random a) (Random (Maybe a))))
+  (do {! ..monad}
+    [some? bit]
+    (if some?
+      (do !
+        [value value_gen]
+        (wrap (#.Some value)))
+      (wrap #.None))))
+
+(template [   ]
+  [(def: #export ( size value_gen)
+     (All [a] (-> Nat (Random a) (Random ( a))))
+     (if (n.> 0 size)
+       (do ..monad
+         [x value_gen
+          xs ( (dec size) value_gen)]
+         (wrap ( x xs)))
+       (\ ..monad wrap )))]
+
+  [list List (.list)   #.Cons]
+  [row  Row  row.empty row.add]
+  )
+
+(template [  ]
+  [(def: #export ( size value_gen)
+     (All [a] (-> Nat (Random a) (Random ( a))))
+     (do ..monad
+       [values (list size value_gen)]
+       (wrap (|> values ))))]
+
+  [array Array array.from_list]
+  [queue Queue queue.from_list]
+  [stack Stack (list\fold stack.push stack.empty)]
+  )
+
+(def: #export (set Hash size value_gen)
+  (All [a] (-> (Hash a) Nat (Random a) (Random (Set a))))
+  (if (n.> 0 size)
+    (do {! ..monad}
+      [xs (set Hash (dec size) value_gen)]
+      (loop [_ []]
+        (do !
+          [x value_gen
+           #let [xs+ (set.add x xs)]]
+          (if (n.= size (set.size xs+))
+            (wrap xs+)
+            (recur [])))))
+    (\ ..monad wrap (set.new Hash))))
+
+(def: #export (dictionary Hash size key_gen value_gen)
+  (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v))))
+  (if (n.> 0 size)
+    (do {! ..monad}
+      [kv (dictionary Hash (dec size) key_gen value_gen)]
+      (loop [_ []]
+        (do !
+          [k key_gen
+           v value_gen
+           #let [kv+ (dictionary.put k v kv)]]
+          (if (n.= size (dictionary.size kv+))
+            (wrap kv+)
+            (recur [])))))
+    (\ ..monad wrap (dictionary.new Hash))))
+
+(def: #export instant
+  (Random Instant)
+  (\ ..monad map instant.from_millis ..int))
+
+(def: #export date
+  (Random Date)
+  (\ ..monad map instant.date ..instant))
+
+(def: #export time
+  (Random Time)
+  (\ ..monad map instant.time ..instant))
+
+(def: #export duration
+  (Random Duration)
+  (\ ..monad map duration.from_millis ..int))
+
+(def: #export month
+  (Random Month)
+  (let [(^open "\.") ..monad]
+    (..either (..either (..either (\wrap #month.January)
+                                  (..either (\wrap #month.February)
+                                            (\wrap #month.March)))
+                        (..either (\wrap #month.April)
+                                  (..either (\wrap #month.May)
+                                            (\wrap #month.June))))
+              (..either (..either (\wrap #month.July)
+                                  (..either (\wrap #month.August)
+                                            (\wrap #month.September)))
+                        (..either (\wrap #month.October)
+                                  (..either (\wrap #month.November)
+                                            (\wrap #month.December)))))))
+
+(def: #export day
+  (Random Day)
+  (let [(^open "\.") ..monad]
+    (..either (..either (\wrap #day.Sunday)
+                        (..either (\wrap #day.Monday)
+                                  (\wrap #day.Tuesday)))
+              (..either (..either (\wrap #day.Wednesday)
+                                  (\wrap #day.Thursday))
+                        (..either (\wrap #day.Friday)
+                                  (\wrap #day.Saturday))))))
+
+(def: #export (run prng calc)
+  (All [a] (-> PRNG (Random a) [PRNG a]))
+  (calc prng))
+
+(def: #export (prng update return)
+  (All [a] (-> (-> a a) (-> a I64) (-> a PRNG)))
+  (function (recur state)
+    (function (_ _)
+      [(recur (update state))
+       (return state)])))
+
+(def: #export (pcg32 [increase seed])
+  {#.doc (doc "An implementation of the PCG32 algorithm."
+              "For more information, please see: http://www.pcg-random.org/")}
+  (-> [(I64 Any) (I64 Any)] PRNG)
+  (let [magic 6364136223846793005]
+    (function (_ _)
+      [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg32)
+       (let [rot (|> seed .i64 (i64.right_shift 59))]
+         (|> seed
+             (i64.right_shift 18)
+             (i64.xor seed)
+             (i64.right_shift 27)
+             (i64.rotate_right rot)
+             .i64))])))
+
+(def: #export (xoroshiro_128+ [s0 s1])
+  {#.doc (doc "An implementation of the Xoroshiro128+ algorithm."
+              "For more information, please see: http://xoroshiro.di.unimi.it/")}
+  (-> [(I64 Any) (I64 Any)] PRNG)
+  (function (_ _)
+    [(let [s01 (i64.xor s0 s1)]
+       (xoroshiro_128+ [(|> s0
+                            (i64.rotate_left 55)
+                            (i64.xor s01)
+                            (i64.xor (i64.left_shift 14 s01)))
+                        (i64.rotate_left 36 s01)]))
+     ("lux i64 +" s0 s1)]))
+
+## https://en.wikipedia.org/wiki/Xorshift#Initialization
+## http://xorshift.di.unimi.it/splitmix64.c
+(def: #export split_mix_64
+  {#.doc (doc "An implementation of the SplitMix64 algorithm.")}
+  (-> Nat PRNG)
+  (let [twist (: (-> Nat Nat Nat)
+                 (function (_ shift value)
+                   (i64.xor (i64.right_shift shift value)
+                            value)))
+        mix n.*]
+    (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15"))
+            (|>> (twist 30)
+                 (mix (hex "BF,58,47,6D,1C,E4,E5,B9"))
+
+                 (twist 27)
+                 (mix (hex "94,D0,49,BB,13,31,11,EB"))
+
+                 (twist 31)
+                 .i64))))
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
new file mode 100644
index 000000000..b86100325
--- /dev/null
+++ b/stdlib/source/library/lux/meta.lux
@@ -0,0 +1,568 @@
+(.module: {#.doc "Functions for extracting information from the state of the compiler."}
+  [library
+   [lux #*
+    [abstract
+     [functor (#+ Functor)]
+     [apply (#+ Apply)]
+     ["." monad (#+ Monad do)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." product]
+     ["." maybe]
+     ["." text ("#\." monoid equivalence)]
+     ["." name ("#\." codec equivalence)]
+     [collection
+      ["." list ("#\." monoid monad)]
+      [dictionary
+       ["." plist]]]]
+    [macro
+     ["." code]]
+    [math
+     [number
+      ["n" nat]
+      ["i" int]]]]]
+  [/
+   ["." location]])
+
+## (type: (Meta a)
+##   (-> Lux (Try [Lux a])))
+
+(implementation: #export functor
+  (Functor Meta)
+  
+  (def: (map f fa)
+    (function (_ compiler)
+      (case (fa compiler)
+        (#try.Failure msg)
+        (#try.Failure msg)
+
+        (#try.Success [compiler' a])
+        (#try.Success [compiler' (f a)])))))
+
+(implementation: #export apply
+  (Apply Meta)
+  
+  (def: &functor ..functor)
+
+  (def: (apply ff fa)
+    (function (_ compiler)
+      (case (ff compiler)
+        (#try.Success [compiler' f])
+        (case (fa compiler')
+          (#try.Success [compiler'' a])
+          (#try.Success [compiler'' (f a)])
+
+          (#try.Failure msg)
+          (#try.Failure msg))
+
+        (#try.Failure msg)
+        (#try.Failure msg)))))
+
+(implementation: #export monad
+  (Monad Meta)
+  
+  (def: &functor ..functor)
+
+  (def: (wrap x)
+    (function (_ compiler)
+      (#try.Success [compiler x])))
+  
+  (def: (join mma)
+    (function (_ compiler)
+      (case (mma compiler)
+        (#try.Failure msg)
+        (#try.Failure msg)
+
+        (#try.Success [compiler' ma])
+        (ma compiler')))))
+
+(def: #export (run' compiler action)
+  (All [a] (-> Lux (Meta a) (Try [Lux a])))
+  (action compiler))
+
+(def: #export (run compiler action)
+  (All [a] (-> Lux (Meta a) (Try a)))
+  (case (action compiler)
+    (#try.Failure error)
+    (#try.Failure error)
+
+    (#try.Success [_ output])
+    (#try.Success output)))
+
+(def: #export (either left right)
+  {#.doc "Pick whichever computation succeeds."}
+  (All [a] (-> (Meta a) (Meta a) (Meta a)))
+  (function (_ compiler)
+    (case (left compiler)
+      (#try.Failure error)
+      (right compiler)
+
+      (#try.Success [compiler' output])
+      (#try.Success [compiler' output]))))
+
+(def: #export (assert message test)
+  {#.doc "Fails with the given message if the test is #0."}
+  (-> Text Bit (Meta Any))
+  (function (_ compiler)
+    (if test
+      (#try.Success [compiler []])
+      (#try.Failure message))))
+
+(def: #export (fail error)
+  {#.doc "Fails with the given error message."}
+  (All [a]
+    (-> Text (Meta a)))
+  (function (_ state)
+    (#try.Failure (location.with (get@ #.location state) error))))
+
+(def: #export (find_module name)
+  (-> Text (Meta Module))
+  (function (_ compiler)
+    (case (plist.get name (get@ #.modules compiler))
+      (#.Some module)
+      (#try.Success [compiler module])
+
+      _
+      (#try.Failure ($_ text\compose "Unknown module: " name)))))
+
+(def: #export current_module_name
+  (Meta Text)
+  (function (_ compiler)
+    (case (get@ #.current_module compiler)
+      (#.Some current_module)
+      (#try.Success [compiler current_module])
+
+      _
+      (#try.Failure "No current module."))))
+
+(def: #export current_module
+  (Meta Module)
+  (let [(^open "\.") ..monad]
+    (|> ..current_module_name
+        (\map ..find_module)
+        \join)))
+
+(def: (macro_type? type)
+  (-> Type Bit)
+  (`` (case type
+        (#.Named [(~~ (static .prelude_module)) "Macro"] (#.Primitive "#Macro" #.Nil))
+        true
+
+        _
+        false)))
+
+(def: #export (normalize name)
+  {#.doc (doc "If given a name without a module prefix, gives it the current module's name as prefix."
+              "Otherwise, returns the name as-is.")}
+  (-> Name (Meta Name))
+  (case name
+    ["" name]
+    (do ..monad
+      [module_name ..current_module_name]
+      (wrap [module_name name]))
+
+    _
+    (\ ..monad wrap name)))
+
+(def: (find_macro' modules this_module module name)
+  (-> (List [Text Module]) Text Text Text
+      (Maybe Macro))
+  (do maybe.monad
+    [$module (plist.get module modules)
+     definition (: (Maybe Global)
+                   (|> (: Module $module)
+                       (get@ #.definitions)
+                       (plist.get name)))]
+    (case definition
+      (#.Alias [r_module r_name])
+      (find_macro' modules this_module r_module r_name)
+      
+      (#.Definition [exported? def_type def_anns def_value])
+      (if (macro_type? def_type)
+        (#.Some (:as Macro def_value))
+        #.None))))
+
+(def: #export (find_macro full_name)
+  (-> Name (Meta (Maybe Macro)))
+  (do ..monad
+    [[module name] (normalize full_name)]
+    (: (Meta (Maybe Macro))
+       (function (_ compiler)
+         (let [macro (case (..current_module_name compiler)
+                       (#try.Failure error)
+                       #.None
+
+                       (#try.Success [_ this_module])
+                       (find_macro' (get@ #.modules compiler) this_module module name))]
+           (#try.Success [compiler macro]))))))
+
+(def: #export count
+  (Meta Nat)
+  (function (_ compiler)
+    (#try.Success [(update@ #.seed inc compiler)
+                   (get@ #.seed compiler)])))
+
+(def: #export (module_exists? module)
+  (-> Text (Meta Bit))
+  (function (_ compiler)
+    (#try.Success [compiler (case (plist.get module (get@ #.modules compiler))
+                              (#.Some _)
+                              #1
+                              
+                              #.None
+                              #0)])))
+
+(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_type_var idx bindings)
+  (-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
+  (case bindings
+    #.Nil
+    #.None
+    
+    (#.Cons [var bound] bindings')
+    (if (n.= idx var)
+      bound
+      (find_type_var idx bindings'))))
+
+(def: (clean_type type)
+  (-> Type (Meta Type))
+  (case type
+    (#.Var var)
+    (function (_ compiler)
+      (case (|> compiler
+                (get@ [#.type_context #.var_bindings])
+                (find_type_var var))
+        (^or #.None (#.Some (#.Var _)))
+        (#try.Success [compiler type])
+
+        (#.Some type')
+        (#try.Success [compiler type'])))
+
+    _
+    (\ ..monad wrap type)))
+
+(def: #export (find_var_type name)
+  {#.doc "Looks-up the type of a local variable somewhere in the environment."}
+  (-> Text (Meta Type))
+  (function (_ compiler)
+    (let [test (: (-> [Text [Type Any]] Bit)
+                  (|>> product.left (text\= name)))]
+      (case (do maybe.monad
+              [scope (list.find (function (_ env)
+                                  (or (list.any? test (: (List [Text [Type Any]])
+                                                         (get@ [#.locals #.mappings] env)))
+                                      (list.any? test (: (List [Text [Type Any]])
+                                                         (get@ [#.captured #.mappings] env)))))
+                                (get@ #.scopes compiler))
+               [_ [type _]] (try_both (list.find test)
+                                      (: (List [Text [Type Any]])
+                                         (get@ [#.locals #.mappings] scope))
+                                      (: (List [Text [Type Any]])
+                                         (get@ [#.captured #.mappings] scope)))]
+              (wrap type))
+        (#.Some var_type)
+        ((clean_type var_type) compiler)
+
+        #.None
+        (#try.Failure ($_ text\compose "Unknown variable: " name))))))
+
+(def: #export (find_def name)
+  {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."}
+  (-> Name (Meta Global))
+  (do ..monad
+    [name (normalize name)
+     #let [[normal_module normal_short] name]]
+    (function (_ compiler)
+      (case (: (Maybe Global)
+               (do maybe.monad
+                 [(^slots [#.definitions]) (|> compiler
+                                               (get@ #.modules)
+                                               (plist.get normal_module))]
+                 (plist.get normal_short definitions)))
+        (#.Some definition)
+        (#try.Success [compiler definition])
+
+        _
+        (let [current_module (|> compiler (get@ #.current_module) (maybe.default "???"))
+              separator ($_ text\compose text.new_line "                    ")]
+          (#try.Failure ($_ text\compose
+                            "Unknown definition: " (name\encode name) text.new_line
+                            "    Current module: " current_module text.new_line
+                            (case (plist.get current_module (get@ #.modules compiler))
+                              (#.Some this_module)
+                              (let [candidates (|> compiler
+                                                   (get@ #.modules)
+                                                   (list\map (function (_ [module_name module])
+                                                               (|> module
+                                                                   (get@ #.definitions)
+                                                                   (list.all (function (_ [def_name global])
+                                                                               (case global
+                                                                                 (#.Definition [exported? _ _ _])
+                                                                                 (if (and exported?
+                                                                                          (text\= normal_short def_name))
+                                                                                   (#.Some (name\encode [module_name def_name]))
+                                                                                   #.None)
+
+                                                                                 (#.Alias _)
+                                                                                 #.None))))))
+                                                   list.concat
+                                                   (text.join_with separator))
+                                    imports (|> this_module
+                                                (get@ #.imports)
+                                                (text.join_with separator))
+                                    aliases (|> this_module
+                                                (get@ #.module_aliases)
+                                                (list\map (function (_ [alias real]) ($_ text\compose alias " => " real)))
+                                                (text.join_with separator))]
+                                ($_ text\compose
+                                    "        Candidates: " candidates text.new_line
+                                    "           Imports: " imports text.new_line
+                                    "           Aliases: " aliases text.new_line))
+
+                              _
+                              "")
+                            " All known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line)))))))
+
+(def: #export (find_export name)
+  {#.doc "Looks-up a definition's type in the available modules (including the current one)."}
+  (-> Name (Meta Definition))
+  (do ..monad
+    [definition (..find_def name)]
+    (case definition
+      (#.Left de_aliased)
+      (fail ($_ text\compose
+                "Aliases are not considered exports: "
+                (name\encode name)))
+      
+      (#.Right definition)
+      (let [[exported? def_type def_data def_value] definition]
+        (if exported?
+          (wrap definition)
+          (fail ($_ text\compose "Definition is not an export: " (name\encode name))))))))
+
+(def: #export (find_def_type name)
+  {#.doc "Looks-up a definition's type in the available modules (including the current one)."}
+  (-> Name (Meta Type))
+  (do ..monad
+    [definition (find_def name)]
+    (case definition
+      (#.Left de_aliased)
+      (find_def_type de_aliased)
+      
+      (#.Right [exported? def_type def_data def_value])
+      (clean_type def_type))))
+
+(def: #export (find_type name)
+  {#.doc "Looks-up the type of either a local variable or a definition."}
+  (-> Name (Meta Type))
+  (do ..monad
+    [#let [[_ _name] name]]
+    (case name
+      ["" _name]
+      (either (find_var_type _name)
+              (find_def_type name))
+
+      _
+      (find_def_type name))))
+
+(def: #export (find_type_def name)
+  {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."}
+  (-> Name (Meta Type))
+  (do ..monad
+    [definition (find_def name)]
+    (case definition
+      (#.Left de_aliased)
+      (find_type_def de_aliased)
+      
+      (#.Right [exported? def_type def_data def_value])
+      (let [type_to_code (`` ("lux in-module" (~~ (static .prelude_module)) .type_to_code))]
+        (if (or (is? .Type def_type)
+                (\ code.equivalence =
+                   (type_to_code .Type)
+                   (type_to_code def_type)))
+          (wrap (:as Type def_value))
+          (..fail ($_ text\compose "Definition is not a type: " (name\encode name))))))))
+
+(def: #export (globals module)
+  {#.doc "The entire list of globals in a module (including the non-exported/private ones)."}
+  (-> Text (Meta (List [Text Global])))
+  (function (_ compiler)
+    (case (plist.get module (get@ #.modules compiler))
+      #.None
+      (#try.Failure ($_ text\compose "Unknown module: " module))
+      
+      (#.Some module)
+      (#try.Success [compiler (get@ #.definitions module)]))))
+
+(def: #export (definitions module)
+  {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."}
+  (-> Text (Meta (List [Text Definition])))
+  (\ ..monad map
+     (list.all (function (_ [name global])
+                 (case global
+                   (#.Left de_aliased)
+                   #.None
+                   
+                   (#.Right definition)
+                   (#.Some [name definition]))))
+     (..globals module)))
+
+(def: #export (exports module_name)
+  {#.doc "All the exported definitions in a module."}
+  (-> Text (Meta (List [Text Definition])))
+  (do ..monad
+    [constants (..definitions module_name)]
+    (wrap (do list.monad
+            [[name [exported? def_type def_data def_value]] constants]
+            (if exported?
+              (wrap [name [exported? def_type def_data def_value]])
+              (list))))))
+
+(def: #export modules
+  {#.doc "All the available modules (including the current one)."}
+  (Meta (List [Text Module]))
+  (function (_ compiler)
+    (|> compiler
+        (get@ #.modules)
+        [compiler]
+        #try.Success)))
+
+(def: #export (tags_of type_name)
+  {#.doc "All the tags associated with a type definition."}
+  (-> Name (Meta (Maybe (List Name))))
+  (do ..monad
+    [#let [[module name] type_name]
+     module (find_module module)]
+    (case (plist.get name (get@ #.types module))
+      (#.Some [tags _])
+      (wrap (#.Some tags))
+
+      _
+      (wrap #.None))))
+
+(def: #export location
+  {#.doc "The location of the current expression being analyzed."}
+  (Meta Location)
+  (function (_ compiler)
+    (#try.Success [compiler (get@ #.location compiler)])))
+
+(def: #export expected_type
+  {#.doc "The expected type of the current expression being analyzed."}
+  (Meta Type)
+  (function (_ compiler)
+    (case (get@ #.expected compiler)
+      (#.Some type)
+      (#try.Success [compiler type])
+
+      #.None
+      (#try.Failure "Not expecting any type."))))
+
+(def: #export (imported_modules module_name)
+  {#.doc "All the modules imported by a specified module."}
+  (-> Text (Meta (List Text)))
+  (do ..monad
+    [(^slots [#.imports]) (..find_module module_name)]
+    (wrap imports)))
+
+(def: #export (imported_by? import module)
+  (-> Text Text (Meta Bit))
+  (do ..monad
+    [(^slots [#.imports]) (..find_module module)]
+    (wrap (list.any? (text\= import) imports))))
+
+(def: #export (imported? import)
+  (-> Text (Meta Bit))
+  (\ ..functor map
+     (|>> (get@ #.imports) (list.any? (text\= import)))
+     ..current_module))
+
+(def: #export (resolve_tag tag)
+  {#.doc "Given a tag, finds out what is its index, its related tag-list and its associated type."}
+  (-> Name (Meta [Nat (List Name) Type]))
+  (do ..monad
+    [#let [[module name] tag]
+     =module (..find_module module)
+     this_module_name ..current_module_name
+     imported! (..imported? module)]
+    (case (plist.get name (get@ #.tags =module))
+      (#.Some [idx tag_list exported? type])
+      (if (or (text\= this_module_name module)
+              (and imported! exported?))
+        (wrap [idx tag_list type])
+        (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name)))
+
+      _
+      (..fail ($_ text\compose
+                  "Unknown tag: " (name\encode tag) text.new_line
+                  " Known tags: " (|> =module
+                                      (get@ #.tags)
+                                      (list\map (|>> product.left [module] name\encode (text.prefix text.new_line)))
+                                      (text.join_with ""))
+                  )))))
+
+(def: #export (tag_lists module)
+  {#.doc "All the tag-lists defined in a module, with their associated types."}
+  (-> Text (Meta (List [(List Name) Type])))
+  (do ..monad
+    [=module (..find_module module)
+     this_module_name ..current_module_name]
+    (wrap (|> (get@ #.types =module)
+              (list.filter (function (_ [type_name [tag_list exported? type]])
+                             (or exported?
+                                 (text\= this_module_name module))))
+              (list\map (function (_ [type_name [tag_list exported? type]])
+                          [tag_list type]))))))
+
+(def: #export locals
+  {#.doc "All the local variables currently in scope, separated in different scopes."}
+  (Meta (List (List [Text Type])))
+  (function (_ compiler)
+    (case (list.inits (get@ #.scopes compiler))
+      #.None
+      (#try.Failure "No local environment")
+
+      (#.Some scopes)
+      (#try.Success [compiler
+                     (list\map (|>> (get@ [#.locals #.mappings])
+                                    (list\map (function (_ [name [type _]])
+                                                [name type])))
+                               scopes)]))))
+
+(def: #export (un_alias def_name)
+  {#.doc "Given an aliased definition's name, returns the original definition being referenced."}
+  (-> Name (Meta Name))
+  (do ..monad
+    [constant (..find_def def_name)]
+    (wrap (case constant
+            (#.Left real_def_name)
+            real_def_name
+
+            (#.Right _)
+            def_name))))
+
+(def: #export get_compiler
+  {#.doc "Obtains the current state of the compiler."}
+  (Meta Lux)
+  (function (_ compiler)
+    (#try.Success [compiler compiler])))
+
+(def: #export type_context
+  (Meta Type_Context)
+  (function (_ compiler)
+    (#try.Success [compiler (get@ #.type_context compiler)])))
+
+(def: #export (lift result)
+  (All [a] (-> (Try a) (Meta a)))
+  (case result
+    (#try.Success output)
+    (\ ..monad wrap output)
+
+    (#try.Failure error)
+    (..fail error)))
diff --git a/stdlib/source/library/lux/meta/annotation.lux b/stdlib/source/library/lux/meta/annotation.lux
new file mode 100644
index 000000000..1b7ee480b
--- /dev/null
+++ b/stdlib/source/library/lux/meta/annotation.lux
@@ -0,0 +1,95 @@
+(.module:
+  [library
+   [lux (#- nat int rev)
+    [abstract
+     ["." monad (#+ do)]]
+    [data
+     ["." maybe]
+     ["." name ("#\." equivalence)]]]])
+
+(type: #export Annotation
+  Code)
+
+(def: #export (value tag ann)
+  (-> Name Annotation (Maybe Code))
+  (case ann
+    [_ (#.Record ann)]
+    (loop [ann ann]
+      (case ann
+        (#.Cons [key value] ann')
+        (case key
+          [_ (#.Tag tag')]
+          (if (name\= tag tag')
+            (#.Some value)
+            (recur ann'))
+
+          _
+          (recur ann'))
+        
+        #.Nil
+        #.None))
+
+    _
+    #.None))
+
+(template [  ]
+  [(def: #export ( tag ann)
+     (-> Name Annotation (Maybe ))
+     (case (..value tag ann)
+       (#.Some [_ ( value)])
+       (#.Some value)
+
+       _
+       #.None))]
+
+  [bit        #.Bit        Bit]
+  [nat        #.Nat        Nat]
+  [int        #.Int        Int]
+  [rev        #.Rev        Rev]
+  [frac       #.Frac       Frac]
+  [text       #.Text       Text]
+  [identifier #.Identifier Name]
+  [tag        #.Tag        Name]
+  [form       #.Form       (List Code)]
+  [tuple      #.Tuple      (List Code)]
+  [record     #.Record     (List [Code Code])]
+  )
+
+(def: #export documentation
+  (-> Annotation (Maybe Text))
+  (..text (name_of #.doc)))
+
+(def: #export (flagged? flag)
+  (-> Name Annotation Bit)
+  (|>> (..bit flag) (maybe.default false)))
+
+(template [ ]
+  [(def: #export 
+     (-> Annotation Bit)
+     (..flagged? (name_of )))]
+
+  [implementation? #.implementation?]
+  [recursive_type? #.type-rec?]
+  [signature?      #.sig?]
+  )
+
+(def: (parse_text input)
+  (-> Code (Maybe Text))
+  (case input
+    [_ (#.Text actual_value)]
+    (#.Some actual_value)
+
+    _
+    #.None))
+
+(template [ ]
+  [(def: #export ( ann)
+     (-> Annotation (List Text))
+     (maybe.default (list)
+                    (do {! maybe.monad}
+                      [args (..tuple (name_of ) ann)]
+                      (monad.map ! ..parse_text args))))]
+
+  [function_arguments #.func-args]
+  [type_arguments     #.type-args]
+  )
diff --git a/stdlib/source/library/lux/meta/location.lux b/stdlib/source/library/lux/meta/location.lux
new file mode 100644
index 000000000..ddc40b147
--- /dev/null
+++ b/stdlib/source/library/lux/meta/location.lux
@@ -0,0 +1,49 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]]])
+
+(implementation: #export equivalence
+  (Equivalence Location)
+
+  (def: (= reference subject)
+    (and ("lux text =" (get@ #.module reference) (get@ #.module subject))
+         ("lux i64 =" (get@ #.line reference) (get@ #.line subject))
+         ("lux i64 =" (get@ #.column reference) (get@ #.column subject)))))
+
+(def: #export dummy
+  Location
+  {#.module ""
+   #.line   0
+   #.column 0})
+
+(macro: #export (here tokens compiler)
+  (case tokens
+    #.Nil
+    (let [location (get@ #.location compiler)]
+      (#.Right [compiler
+                (list (` [(~ [..dummy (#.Text (get@ #.module location))])
+                          (~ [..dummy (#.Nat (get@ #.line location))])
+                          (~ [..dummy (#.Nat (get@ #.column location))])]))]))
+
+    _
+    (#.Left (`` (("lux in-module" (~~ (static .prelude_module)) wrong_syntax_error) (name_of ..here))))))
+
+(def: #export (format value)
+  (-> Location Text)
+  (let [separator ","
+        [file line column] value]
+    ($_ "lux text concat"
+        "@"
+        (`` (("lux in-module" (~~ (static .prelude_module)) .text\encode) file)) separator
+        (`` (("lux in-module" (~~ (static .prelude_module)) .nat\encode) line)) separator
+        (`` (("lux in-module" (~~ (static .prelude_module)) .nat\encode) column)))))
+
+(def: \n
+  ("lux i64 char" +10))
+
+(def: #export (with location error)
+  (-> Location Text Text)
+  ($_ "lux text concat" (..format location) \n
+      error))
diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux
new file mode 100644
index 000000000..bd486796b
--- /dev/null
+++ b/stdlib/source/library/lux/program.lux
@@ -0,0 +1,83 @@
+(.module:
+  [library
+   [lux #*
+    ["@" target]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." io]
+     [concurrency
+      ["." thread]]
+     ["<>" parser
+      ["<.>" code]
+      ["<.>" cli]]]
+    [data
+     ["." text]
+     [collection
+      ["." list ("#\." monad)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]]]])
+
+(type: Arguments
+  (#Raw Text)
+  (#Parsed (List [Code Code])))
+
+(def: arguments^
+  (.Parser Arguments)
+  (<>.or .local_identifier
+         (.tuple (<>.some (<>.either (do <>.monad
+                                             [name .local_identifier]
+                                             (wrap [(code.identifier ["" name]) (` (~! .any))]))
+                                           (.record (<>.and .any .any)))))))
+
+(syntax: #export (program:
+                   {args ..arguments^}
+                   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/control/parser/cli module."
+              (program: all_args
+                (do io.monad
+                  [foo init_program
+                   bar (do_something all_args)]
+                  (wrap [])))
+
+              (program: [name]
+                (io (log! (\ text.monoid compose "Hello, " name))))
+
+              (program: [{config configuration_parser}]
+                (do io.monad
+                  [data (init_program config)]
+                  (do_something data))))}
+  (with_gensyms [g!program g!args g!_ g!output g!message]
+    (let [initialization+event_loop
+          (` ((~! do) (~! io.monad)
+              [(~ g!output) (~ body)
+               (~+ (for {@.old (list)
+                         @.jvm (list)
+                         @.js (list)
+                         @.python (list)}
+                        (list g!_ (` (~! thread.run!)))))]
+              ((~' wrap) (~ g!output))))]
+      (wrap (list (` ("lux def program"
+                      (~ (case args
+                           (#Raw args)
+                           (` (.function ((~ g!program) (~ (code.identifier ["" args])))
+                                (~ initialization+event_loop)))
+                           
+                           (#Parsed args)
+                           (` (.function ((~ g!program) (~ g!args))
+                                (case ((~! .run) (: (~! (.Parser (io.IO .Any)))
+                                                         ((~! do) (~! <>.monad)
+                                                          [(~+ (|> args
+                                                                   (list\map (function (_ [binding parser])
+                                                                               (list binding parser)))
+                                                                   list\join))]
+                                                          ((~' wrap) (~ initialization+event_loop))))
+                                       (~ g!args))
+                                  (#.Right (~ g!output))
+                                  (~ g!output)
+
+                                  (#.Left (~ g!message))
+                                  (.error! (~ g!message))))))))))))))
diff --git a/stdlib/source/library/lux/target.lux b/stdlib/source/library/lux/target.lux
new file mode 100644
index 000000000..323cf812b
--- /dev/null
+++ b/stdlib/source/library/lux/target.lux
@@ -0,0 +1,26 @@
+(.module:
+  [library
+   lux])
+
+(type: #export Target
+  Text)
+
+(template [ ]
+  [(def: #export 
+     Target
+     )]
+
+  ## TODO: Delete ASAP.
+  [old "{old}"]
+  ## Available.
+  [js          "JavaScript"]
+  [jvm         "JVM"]
+  [lua         "Lua"]
+  [python      "Python"]
+  [ruby        "Ruby"]
+  ## Not available yet.
+  [common_lisp "Common Lisp"]
+  [php         "PHP"]
+  [r           "R"]
+  [scheme      "Scheme"]
+  )
diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux
new file mode 100644
index 000000000..2ec6746c2
--- /dev/null
+++ b/stdlib/source/library/lux/target/common_lisp.lux
@@ -0,0 +1,469 @@
+(.module:
+  [library
+   [lux (#- Code int if cond or and comment let)
+    [control
+     [pipe (#+ case> cond> new>)]]
+    [data
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." monad fold monoid)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["f" frac]]]
+    [type
+     abstract]]])
+
+(def: as_form
+  (-> Text Text)
+  (text.enclose ["(" ")"]))
+
+(abstract: #export (Code brand)
+  Text
+
+  (def: #export manual
+    (-> Text Code)
+    (|>> :abstraction))
+
+  (def: #export code
+    (-> (Code Any) Text)
+    (|>> :representation))
+
+  (template [ ]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (`` (abstract: #export ( brand) Any))
+       (`` (type: #export ( brand)
+             ( ( brand)))))]
+
+    [Expression Code]
+    [Computation Expression]
+    [Access Computation]
+    [Var Access]
+
+    [Input Code]
+    )
+
+  (template [ ]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (`` (abstract: #export  Any))
+       (`` (type: #export  ( ))))]
+
+    [Label Code]
+    [Tag Expression]
+    [Literal Expression]
+    [Var/1 Var]
+    [Var/* Input]
+    )
+
+  (type: #export Lambda
+    {#input Var/*
+     #output (Expression Any)})
+
+  (def: #export nil
+    Literal
+    (:abstraction "()"))
+
+  (template [ ]
+    [(def: #export 
+       (-> Text Literal)
+       (|>> (format ) :abstraction))]
+    
+    ["'" symbol]
+    [":" keyword])
+
+  (def: #export bool
+    (-> Bit Literal)
+    (|>> (case> #0 ..nil
+                #1 (..symbol "t"))))
+
+  (def: #export int
+    (-> Int Literal)
+    (|>> %.int :abstraction))
+
+  (def: #export float
+    (-> Frac Literal)
+    (|>> (cond> [(f.= f.positive_infinity)]
+                [(new> "(/ 1.0 0.0)" [])]
+                
+                [(f.= f.negative_infinity)]
+                [(new> "(/ -1.0 0.0)" [])]
+                
+                [f.not_a_number?]
+                [(new> "(/ 0.0 0.0)" [])]
+                
+                ## else
+                [%.frac])
+         :abstraction))
+
+  (def: #export (double value)
+    (-> Frac Literal)
+    (:abstraction
+     (.cond (f.= f.positive_infinity value)
+            "(/ 1.0d0 0.0d0)"
+            
+            (f.= f.negative_infinity value)
+            "(/ -1.0d0 0.0d0)"
+            
+            (f.not_a_number? value)
+            "(/ 0.0d0 0.0d0)"
+            
+            ## else
+            (.let [raw (%.frac value)]
+              (.if (text.contains? "E" raw)
+                (text.replace_once "E" "d" raw)
+                (format raw "d0"))))))
+
+  (def: sanitize
+    (-> Text Text)
+    (`` (|>> (~~ (template [ ]
+                   [(text.replace_all  )]
+
+                   ["\" "\\"]
+                   [text.tab "\t"]
+                   [text.vertical_tab "\v"]
+                   [text.null "\0"]
+                   [text.back_space "\b"]
+                   [text.form_feed "\f"]
+                   [text.new_line "\n"]
+                   [text.carriage_return "\r"]
+                   [text.double_quote (format "\" text.double_quote)]
+                   ))
+             )))
+
+  (def: #export string
+    (-> Text Literal)
+    (|>> ..sanitize
+         (text.enclose' text.double_quote)
+         :abstraction))
+
+  (def: #export var
+    (-> Text Var/1)
+    (|>> :abstraction))
+
+  (def: #export args
+    (-> (List Var/1) Var/*)
+    (|>> (list\map ..code)
+         (text.join_with " ")
+         ..as_form
+         :abstraction))
+
+  (def: #export (args& singles rest)
+    (-> (List Var/1) Var/1 Var/*)
+    (|> (case singles
+          #.Nil
+          ""
+          
+          (#.Cons _)
+          (|> singles
+              (list\map ..code)
+              (text.join_with " ")
+              (text.suffix " ")))
+        (format "&rest " (:representation rest))
+        ..as_form
+        :abstraction))
+
+  (def: form
+    (-> (List (Expression Any)) Expression)
+    (|>> (list\map ..code)
+         (text.join_with " ")
+         ..as_form
+         :abstraction))
+
+  (def: #export (call/* func)
+    (-> (Expression Any) (-> (List (Expression Any)) (Computation Any)))
+    (|>> (#.Cons func) ..form))
+  
+  (template [ ]
+    [(def: #export 
+       (-> (List (Expression Any)) (Computation Any))
+       (..call/* (..var )))]
+
+    [vector/* "vector"]
+    [list/*   "list"]
+    )
+
+  (def: #export (labels definitions body)
+    (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any))
+    (..form (list (..var "labels")
+                  (..form (list\map (function (_ [def_name [def_args def_body]])
+                                      (..form (list def_name (:transmutation def_args) def_body)))
+                                    definitions))
+                  body)))
+
+  (def: #export (destructuring-bind [bindings expression] body)
+    (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any))
+    (..form (list& (..var "destructuring-bind")
+                   (:transmutation bindings) expression
+                   body)))
+
+  (template [ + + +]
+    [(`` (def: #export ( [(~~ (template.splice +))] function)
+           (-> [(~~ (template.splice +))] (Expression Any) (Computation Any))
+           (..call/* function (list (~~ (template.splice +))))))
+
+     (`` (template [ ]
+           [(def: #export ( args)
+              (-> [(~~ (template.splice +))] (Computation Any))
+              ( args (..var )))]
+           
+           (~~ (template.splice +))))]
+
+    [call/0 [] []
+     [[get-universal-time/0 "get-universal-time"]
+      [make-hash-table/0 "make-hash-table"]]]
+    [call/1 [in0] [(Expression Any)]
+     [[length/1 "length"]
+      [function/1 "function"]
+      [copy-seq/1 "copy-seq"]
+      [null/1 "null"]
+      [error/1 "error"]
+      [not/1 "not"]
+      [floor/1 "floor"]
+      [type-of/1 "type-of"]
+      [write-to-string/1 "write-to-string"]
+      [read-from-string/1 "read-from-string"]
+      [print/1 "print"]
+      [reverse/1 "reverse"]
+      [sxhash/1 "sxhash"]
+      [string-upcase/1 "string-upcase"]
+      [string-downcase/1 "string-downcase"]
+      [char-int/1 "char-int"]
+      [text/1 "text"]
+      [hash-table-size/1 "hash-table-size"]
+      [hash-table-rehash-size/1 "hash-table-rehash-size"]
+      [code-char/1 "code-char"]
+      [char-code/1 "char-code"]
+      [string/1 "string"]
+      [write-line/1 "write-line"]
+      [pprint/1 "pprint"]
+      [identity/1 "identity"]]]
+    [call/2 [in0 in1] [(Expression Any) (Expression Any)]
+     [[apply/2 "apply"]
+      [append/2 "append"]
+      [cons/2 "cons"]
+      [char/2 "char"]
+      [nth/2 "nth"]
+      [nthcdr/2 "nthcdr"]
+      [coerce/2 "coerce"]
+      [eq/2 "eq"]
+      [equal/2 "equal"]
+      [string=/2 "string="]
+      [=/2   "="]
+      [+/2   "+"]
+      [*/2   "*"]]]
+    [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)]
+     [[subseq/3 "subseq"]
+      [map/3 "map"]
+      [concatenate/3 "concatenate"]
+      [format/3 "format"]]]
+    )
+
+  (template [ + +]
+    [(`` (template [ ]
+           [(def: #export ( args)
+              (-> [(~~ (template.splice +))] (Access Any))
+              (:transmutation ( args (..var ))))]
+           
+           (~~ (template.splice +))))]
+
+    [call/1 [(Expression Any)]
+     [[car/1 "car"]
+      [cdr/1 "cdr"]
+      [cadr/1 "cadr"]
+      [cddr/1 "cddr"]]]
+    [call/2 [(Expression Any) (Expression Any)]
+     [[svref/2 "svref"]
+      [elt/2 "elt"]
+      [gethash/2 "gethash"]]]
+    )
+
+  (def: #export (make-hash-table/with_size size)
+    (-> (Expression Any) (Computation Any))
+    (..call/* (..var "make-hash-table")
+              (list (..keyword "size")
+                    size)))
+
+  (def: #export (funcall/+ [func args])
+    (-> [(Expression Any) (List (Expression Any))] (Computation Any))
+    (..call/* (..var "funcall") (list& func args)))
+
+  (def: #export (search/3 [reference space start])
+    (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any))
+    (..call/* (..var "search")
+              (list reference
+                    space
+                    (..keyword "start2") start)))
+
+  (def: #export (concatenate/2|string [left right])
+    (-> [(Expression Any) (Expression Any)] (Computation Any))
+    (concatenate/3 [(..symbol "string") left right]))
+
+  (template [ ]
+    [(def: #export ( left right)
+       (-> (Expression Any) (Expression Any) (Computation Any))
+       (..form (list (..var ) left right)))]
+
+    [or "or"]
+    [and "and"]
+    )
+
+  (template [ ]
+    [(def: #export ( [param subject])
+       (-> [(Expression Any) (Expression Any)] (Computation Any))
+       (..form (list (..var ) subject param)))]
+
+    [/2   ">"]
+    [>=/2  ">="]
+    [string (Expression Any) (Expression Any) (Expression Any) (Computation Any))
+    (..form (list (..var "if") test then else)))
+
+  (def: #export (when test then)
+    (-> (Expression Any) (Expression Any) (Computation Any))
+    (..form (list (..var "when") test then)))
+
+  (def: #export (lambda input body)
+    (-> Var/* (Expression Any) Literal)
+    (..form (list (..var "lambda") (:transmutation input) body)))
+
+  (template [ ]
+    [(def: #export ( bindings body)
+       (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any))
+       (..form (list& (..var )
+                      (|> bindings
+                          (list\map (function (_ [name value])
+                                      (..form (list name value))))
+                          ..form)
+                      body)))]
+
+    [let  "let"]
+    [let* "let*"]
+    )
+
+  (def: #export (defparameter name body)
+    (-> Var/1 (Expression Any) (Expression Any))
+    (..form (list (..var "defparameter") name body)))
+
+  (def: #export (defun name inputs body)
+    (-> Var/1 Var/* (Expression Any) (Expression Any))
+    (..form (list (..var "defun") name (:transmutation inputs) body)))
+
+  (template [ ]
+    [(def: #export 
+       (-> (List (Expression Any)) (Computation Any))
+       (|>> (list& (..var )) ..form))]
+
+    [progn "progn"]
+    [tagbody "tagbody"]
+    [values/* "values"]
+    )
+
+  (def: #export (setq name value)
+    (-> Var/1 (Expression Any) (Expression Any))
+    (..form (list (..var "setq") name value)))
+
+  (def: #export (setf access value)
+    (-> (Access Any) (Expression Any) (Expression Any))
+    (..form (list (..var "setf") access value)))
+
+  (type: #export Handler
+    {#condition_type (Expression Any)
+     #condition Var/1
+     #body (Expression Any)})
+  
+  (def: #export (handler-case handlers body)
+    (-> (List Handler) (Expression Any) (Computation Any))
+    (..form (list& (..var "handler-case")
+                   body
+                   (list\map (function (_ [type condition handler])
+                               (..form (list type
+                                             (:transmutation (..args (list condition)))
+                                             handler)))
+                             handlers))))
+
+  (template [ ]
+    [(def: #export ( conditions expression)
+       (-> (List Text) (Expression Any) (Expression Any))
+       (case conditions
+         #.Nil
+         expression
+         
+         (#.Cons single #.Nil)
+         (:abstraction
+          (format  single " " (:representation expression)))
+         
+         _
+         (:abstraction
+          (format  (|> conditions (list\map ..symbol)
+                               (list& (..symbol "or")) ..form
+                               :representation)
+                  " " (:representation expression)))))]
+
+    [conditional+ "#+"]
+    [conditional- "#-"])
+
+  (def: #export label
+    (-> Text Label)
+    (|>> :abstraction))
+
+  (def: #export (block name body)
+    (-> Label (List (Expression Any)) (Computation Any))
+    (..form (list& (..var "block") (:transmutation name) body)))
+
+  (def: #export (return-from target value)
+    (-> Label (Expression Any) (Computation Any))
+    (..form (list (..var "return-from") (:transmutation target) value)))
+
+  (def: #export (return value)
+    (-> (Expression Any) (Computation Any))
+    (..form (list (..var "return") value)))
+
+  (def: #export (cond clauses else)
+    (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any))
+    (..form (list& (..var "cond")
+                   (list\compose (list\map (function (_ [test then])
+                                             (..form (list test then)))
+                                           clauses)
+                                 (list (..form (list (..bool true) else)))))))
+
+  (def: #export tag
+    (-> Text Tag)
+    (|>> :abstraction))
+
+  (def: #export go
+    (-> Tag (Expression Any))
+    (|>> (list (..var "go"))
+         ..form))
+
+  (def: #export values-list/1
+    (-> (Expression Any) (Expression Any))
+    (|>> (list (..var "values-list"))
+         ..form))
+
+  (def: #export (multiple-value-setq bindings values)
+    (-> Var/* (Expression Any) (Expression Any))
+    (..form (list (..var "multiple-value-setq")
+                  (:transmutation bindings)
+                  values)))
+  )
+
+(def: #export (while condition body)
+  (-> (Expression Any) (Expression Any) (Computation Any))
+  (..form (list (..var "loop") (..var "while") condition
+                (..var "do") body)))
diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux
new file mode 100644
index 000000000..d7b42280c
--- /dev/null
+++ b/stdlib/source/library/lux/target/js.lux
@@ -0,0 +1,449 @@
+(.module:
+  [library
+   [lux (#- Location Code or and function if cond undefined for comment not int try)
+    [control
+     [pipe (#+ case>)]]
+    [data
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["i" int]
+      ["f" frac]]]
+    [type
+     abstract]]])
+
+(def: expression (text.enclose ["(" ")"]))
+(def: element (text.enclose ["[" "]"]))
+
+(def: nest
+  (-> Text Text)
+  (|>> (format text.new_line)
+       (text.replace_all text.new_line (format text.new_line text.tab))))
+
+(abstract: #export (Code brand)
+  Text
+
+  (def: #export code
+    (-> (Code Any) Text)
+    (|>> :representation))
+
+  (template [ +]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (abstract: ( brand) Any)
+       (`` (type: #export  (|> Any  (~~ (template.splice +))))))]
+    
+    [Expression [Code]]
+    [Computation [Expression' Code]]
+    [Location [Computation' Expression' Code]]
+    [Statement [Code]]
+    )
+
+  (template [ +]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (abstract: #export  Any)
+       (`` (type: #export  (|>  (~~ (template.splice +))))))]
+
+    [Var [Location' Computation' Expression' Code]]
+    [Access [Location' Computation' Expression' Code]]
+    [Literal [Computation' Expression' Code]]
+    [Loop [Statement' Code]]
+    [Label [Code]]
+    )
+
+  (template [ ]
+    [(def: #export  Literal (:abstraction ))]
+
+    [null "null"]
+    [undefined "undefined"]
+    )
+
+  (def: #export boolean
+    (-> Bit Literal)
+    (|>> (case>
+          #0 "false"
+          #1 "true")
+         :abstraction))
+
+  (def: #export (number value)
+    (-> Frac Literal)
+    (:abstraction
+     (.cond (f.not_a_number? value)
+            "NaN"
+
+            (f.= f.positive_infinity value)
+            "Infinity"
+            
+            (f.= f.negative_infinity value)
+            "-Infinity"
+
+            ## else
+            (|> value %.frac ..expression))))
+
+  (def: sanitize
+    (-> Text Text)
+    (`` (|>> (~~ (template [ ]
+                   [(text.replace_all  )]
+
+                   ["\\" "\"]
+                   ["\t" text.tab]
+                   ["\v" text.vertical_tab]
+                   ["\0" text.null]
+                   ["\b" text.back_space]
+                   ["\f" text.form_feed]
+                   ["\n" text.new_line]
+                   ["\r" text.carriage_return]
+                   [(format "\" text.double_quote)
+                    text.double_quote]
+                   ))
+             )))
+
+  (def: #export string
+    (-> Text Literal)
+    (|>> ..sanitize
+         (text.enclose [text.double_quote text.double_quote])
+         :abstraction))
+
+  (def: argument_separator ", ")
+  (def: field_separator ": ")
+  (def: statement_suffix ";")
+
+  (def: #export array
+    (-> (List Expression) Computation)
+    (|>> (list\map ..code)
+         (text.join_with ..argument_separator)
+         ..element
+         :abstraction))
+
+  (def: #export var
+    (-> Text Var)
+    (|>> :abstraction))
+
+  (def: #export (at index array_or_object)
+    (-> Expression Expression Access)
+    (:abstraction (format (:representation array_or_object) (..element (:representation index)))))
+
+  (def: #export (the field object)
+    (-> Text Expression Access)
+    (:abstraction (format (:representation object) "." field)))
+
+  (def: #export (apply/* function inputs)
+    (-> Expression (List Expression) Computation)
+    (|> inputs
+        (list\map ..code)
+        (text.join_with ..argument_separator)
+        ..expression
+        (format (:representation function))
+        :abstraction))
+
+  (def: #export (do method inputs object)
+    (-> Text (List Expression) Expression Computation)
+    (apply/* (..the method object) inputs))
+
+  (def: #export object
+    (-> (List [Text Expression]) Computation)
+    (|>> (list\map (.function (_ [key val])
+                     (format (:representation (..string key)) ..field_separator (:representation val))))
+         (text.join_with ..argument_separator)
+         (text.enclose ["{" "}"])
+         ..expression
+         :abstraction))
+
+  (def: #export (, pre post)
+    (-> Expression Expression Computation)
+    (|> (format (:representation pre) ..argument_separator (:representation post))
+        ..expression
+        :abstraction))
+
+  (def: #export (then pre post)
+    (-> Statement Statement Statement)
+    (:abstraction (format (:representation pre)
+                          text.new_line
+                          (:representation post))))
+
+  (def: block
+    (-> Statement Text)
+    (let [close (format text.new_line "}")]
+      (|>> :representation
+           ..nest
+           (text.enclose ["{"
+                          close]))))
+
+  (def: #export (function! name inputs body)
+    (-> Var (List Var) Statement Statement)
+    (|> body
+        ..block
+        (format "function " (:representation name)
+                (|> inputs
+                    (list\map ..code)
+                    (text.join_with ..argument_separator)
+                    ..expression)
+                " ")
+        :abstraction))
+
+  (def: #export (function name inputs body)
+    (-> Var (List Var) Statement Computation)
+    (|> (..function! name inputs body)
+        :representation
+        ..expression
+        :abstraction))
+
+  (def: #export (closure inputs body)
+    (-> (List Var) Statement Computation)
+    (|> body
+        ..block
+        (format "function"
+                (|> inputs
+                    (list\map ..code)
+                    (text.join_with ..argument_separator)
+                    ..expression)
+                " ")
+        ..expression
+        :abstraction))
+
+  (template [ ]
+    [(def: #export ( param subject)
+       (-> Expression Expression Computation)
+       (|> (format (:representation subject) " "  " " (:representation param))
+           ..expression
+           :abstraction))]
+
+    [=  "==="]
+    [<  "<"]
+    [<= "<="]
+    [>  ">"]
+    [>= ">="]
+    
+    [+  "+"]
+    [-  "-"]
+    [*  "*"]
+    [/  "/"]
+    [%  "%"]
+
+    [left_shift "<<"]
+    [arithmetic_right_shift ">>"]
+    [logic_right_shift ">>>"]
+
+    [or      "||"]
+    [and     "&&"]
+    [bit_xor "^"]
+    [bit_or  "|"]
+    [bit_and "&"]
+    )
+
+  (template [ ]
+    [(def: #export 
+       (-> Expression Computation)
+       (|>> :representation (text.prefix ) ..expression :abstraction))]
+
+    [not "!"]
+    [bit_not "~"]
+    [negate "-"]
+    )
+
+  (template [  ]
+    [(def: #export ( value)
+       {#.doc "A 32-bit integer expression."}
+       (->  Computation)
+       (:abstraction (..expression (format ( value) "|0"))))]
+
+    [to_i32 Expression :representation]
+    [i32 Int %.int]
+    )
+
+  (def: #export (int value)
+    (-> Int Literal)
+    (:abstraction (.if (i.< +0 value)
+                    (%.int value)
+                    (%.nat (.nat value)))))
+
+  (def: #export (? test then else)
+    (-> Expression Expression Expression Computation)
+    (|> (format (:representation test)
+                " ? " (:representation then)
+                " : " (:representation else))
+        ..expression
+        :abstraction))
+
+  (def: #export type_of
+    (-> Expression Computation)
+    (|>> :representation
+         (format "typeof ")
+         ..expression
+         :abstraction))
+
+  (def: #export (new constructor inputs)
+    (-> Expression (List Expression) Computation)
+    (|> (format "new " (:representation constructor)
+                (|> inputs
+                    (list\map ..code)
+                    (text.join_with ..argument_separator)
+                    ..expression))
+        ..expression
+        :abstraction))
+
+  (def: #export statement
+    (-> Expression Statement)
+    (|>> :representation (text.suffix ..statement_suffix) :abstraction))
+
+  (def: #export use_strict
+    Statement
+    (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix)))
+
+  (def: #export (declare name)
+    (-> Var Statement)
+    (:abstraction (format "var " (:representation name) ..statement_suffix)))
+
+  (def: #export (define name value)
+    (-> Var Expression Statement)
+    (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix)))
+
+  (def: #export (set' name value)
+    (-> Location Expression Expression)
+    (:abstraction (..expression (format (:representation name) " = " (:representation value)))))
+
+  (def: #export (set name value)
+    (-> Location Expression Statement)
+    (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix)))
+
+  (def: #export (throw message)
+    (-> Expression Statement)
+    (:abstraction (format "throw " (:representation message) ..statement_suffix)))
+
+  (def: #export (return value)
+    (-> Expression Statement)
+    (:abstraction (format "return " (:representation value) ..statement_suffix)))
+
+  (def: #export (delete' value)
+    (-> Location Expression)
+    (:abstraction (format "delete " (:representation value))))
+
+  (def: #export (delete value)
+    (-> Location Statement)
+    (:abstraction (format (:representation (delete' value)) ..statement_suffix)))
+
+  (def: #export (if test then! else!)
+    (-> Expression Statement Statement Statement)
+    (:abstraction (format "if(" (:representation test) ") "
+                          (..block then!)
+                          " else "
+                          (..block else!))))
+
+  (def: #export (when test then!)
+    (-> Expression Statement Statement)
+    (:abstraction (format "if(" (:representation test) ") "
+                          (..block then!))))
+
+  (def: #export (while test body)
+    (-> Expression Statement Loop)
+    (:abstraction (format "while(" (:representation test) ") "
+                          (..block body))))
+
+  (def: #export (do_while test body)
+    (-> Expression Statement Loop)
+    (:abstraction (format "do " (..block body)
+                          " while(" (:representation test) ")" ..statement_suffix)))
+
+  (def: #export (try body [exception catch])
+    (-> Statement [Var Statement] Statement)
+    (:abstraction (format "try "
+                          (..block body)
+                          " catch(" (:representation exception) ") "
+                          (..block catch))))
+
+  (def: #export (for var init condition update iteration)
+    (-> Var Expression Expression Expression Statement Loop)
+    (:abstraction (format "for(" (:representation (..define var init))
+                          " " (:representation condition)
+                          ..statement_suffix " " (:representation update)
+                          ")"
+                          (..block iteration))))
+
+  (def: #export label
+    (-> Text Label)
+    (|>> :abstraction))
+
+  (def: #export (with_label label loop)
+    (-> Label Loop Statement)
+    (:abstraction (format (:representation label) ": " (:representation loop))))
+
+  (template [ <0> <1>]
+    [(def: #export <0>
+       Statement
+       (:abstraction (format  ..statement_suffix)))
+
+     (def: #export (<1> label)
+       (-> Label Statement)
+       (:abstraction (format  " " (:representation label) ..statement_suffix)))]
+
+    ["break"    break    break_at]
+    ["continue" continue continue_at]
+    )
+
+  (template [ ]
+    [(def: #export 
+       (-> Location Expression)
+       (|>> :representation
+            (text.suffix )
+            :abstraction))]
+
+    [++ "++"]
+    [-- "--"]
+    )
+
+  (def: #export (comment commentary on)
+    (All [kind] (-> Text (Code kind) (Code kind)))
+    (:abstraction (format "/* "  commentary " */" " " (:representation on))))
+
+  (def: #export (switch input cases default)
+    (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement)
+    (:abstraction (format "switch (" (:representation input) ") "
+                          (|> (format (|> cases
+                                          (list\map (.function (_ [when then])
+                                                      (format (|> when
+                                                                  (list\map (|>> :representation (text.enclose ["case " ":"])))
+                                                                  (text.join_with text.new_line))
+                                                              (..nest (:representation then)))))
+                                          (text.join_with text.new_line))
+                                      text.new_line
+                                      (case default
+                                        (#.Some default)
+                                        (format "default:"
+                                                (..nest (:representation default)))
+                                        
+                                        #.None ""))
+                              :abstraction
+                              ..block))))
+  )
+
+(def: #export (cond clauses else!)
+  (-> (List [Expression Statement]) Statement Statement)
+  (list\fold (.function (_ [test then!] next!)
+               (..if test then! next!))
+             else!
+             (list.reverse clauses)))
+
+(template [ + + +]
+  [(`` (def: #export ( function)
+         (-> Expression (~~ (template.splice +)) Computation)
+         (.function (_ (~~ (template.splice +)))
+           (..apply/* function (list (~~ (template.splice +)))))))
+
+   (`` (template [ ]
+         [(def: #export  ( (..var )))]
+
+         (~~ (template.splice +))))]
+
+  [apply/1 [_0] [Expression]
+   [[not_a_number? "isNaN"]]]
+
+  [apply/2 [_0 _1] [Expression Expression]
+   []]
+
+  [apply/3 [_0 _1 _2] [Expression Expression Expression]
+   []]
+  )
diff --git a/stdlib/source/library/lux/target/jvm.lux b/stdlib/source/library/lux/target/jvm.lux
new file mode 100644
index 000000000..b470abea9
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm.lux
@@ -0,0 +1,284 @@
+(.module:
+  [library
+   [lux (#- Type)
+    [data
+     [collection
+      [row (#+ Row)]]]
+    [target
+     [jvm
+      [type (#+ Type)
+       ["." category (#+ Primitive Class Value Method)]]]]]])
+
+(type: #export Literal
+  (#Boolean Bit)
+  (#Int Int)
+  (#Long Int)
+  (#Double Frac)
+  (#Char Nat)
+  (#String Text))
+
+(type: #export Constant
+  (#BIPUSH Int)
+  
+  (#SIPUSH Int)
+
+  #ICONST_M1
+  #ICONST_0
+  #ICONST_1
+  #ICONST_2
+  #ICONST_3
+  #ICONST_4
+  #ICONST_5
+
+  #LCONST_0
+  #LCONST_1
+  
+  #FCONST_0
+  #FCONST_1
+  #FCONST_2
+  
+  #DCONST_0
+  #DCONST_1
+  
+  #ACONST_NULL
+
+  (#LDC Literal))
+
+(type: #export Int_Arithmetic
+  #IADD
+  #ISUB
+  #IMUL
+  #IDIV
+  #IREM
+  #INEG)
+
+(type: #export Long_Arithmetic
+  #LADD
+  #LSUB
+  #LMUL
+  #LDIV
+  #LREM
+  #LNEG)
+
+(type: #export Float_Arithmetic
+  #FADD
+  #FSUB
+  #FMUL
+  #FDIV
+  #FREM
+  #FNEG)
+
+(type: #export Double_Arithmetic
+  #DADD
+  #DSUB
+  #DMUL
+  #DDIV
+  #DREM
+  #DNEG)
+
+(type: #export Arithmetic
+  (#Int_Arithmetic Int_Arithmetic)
+  (#Long_Arithmetic Long_Arithmetic)
+  (#Float_Arithmetic Float_Arithmetic)
+  (#Double_Arithmetic Double_Arithmetic))
+
+(type: #export Int_Bitwise
+  #IOR
+  #IXOR
+  #IAND
+  #ISHL
+  #ISHR
+  #IUSHR)
+
+(type: #export Long_Bitwise
+  #LOR
+  #LXOR
+  #LAND
+  #LSHL
+  #LSHR
+  #LUSHR)
+
+(type: #export Bitwise
+  (#Int_Bitwise Int_Bitwise)
+  (#Long_Bitwise Long_Bitwise))
+
+(type: #export Conversion
+  #I2B
+  #I2S
+  #I2L
+  #I2F
+  #I2D
+  #I2C
+
+  #L2I
+  #L2F
+  #L2D
+
+  #F2I
+  #F2L
+  #F2D
+  
+  #D2I
+  #D2L
+  #D2F)
+
+(type: #export Array
+  #ARRAYLENGTH
+
+  (#NEWARRAY (Type Primitive))
+  (#ANEWARRAY (Type category.Object))
+
+  #BALOAD
+  #BASTORE
+
+  #SALOAD
+  #SASTORE
+
+  #IALOAD
+  #IASTORE
+
+  #LALOAD
+  #LASTORE
+
+  #FALOAD
+  #FASTORE
+
+  #DALOAD
+  #DASTORE
+  
+  #CALOAD
+  #CASTORE
+
+  #AALOAD
+  #AASTORE)
+
+(type: #export Object
+  (#GETSTATIC (Type Class) Text (Type Value))
+  (#PUTSTATIC (Type Class) Text (Type Value))
+
+  (#NEW (Type Class))
+  
+  (#INSTANCEOF (Type Class))
+  (#CHECKCAST (Type category.Object))
+
+  (#GETFIELD (Type Class) Text (Type Value))
+  (#PUTFIELD (Type Class) Text (Type Value))
+  
+  (#INVOKEINTERFACE (Type Class) Text (Type Method))
+  (#INVOKESPECIAL (Type Class) Text (Type Method))
+  (#INVOKESTATIC (Type Class) Text (Type Method))
+  (#INVOKEVIRTUAL (Type Class) Text (Type Method)))
+
+(type: #export Register Nat)
+
+(type: #export Local_Int
+  (#ILOAD Register)
+  (#ISTORE Register))
+
+(type: #export Local_Long
+  (#LLOAD Register)
+  (#LSTORE Register))
+
+(type: #export Local_Float
+  (#FLOAD Register)
+  (#FSTORE Register))
+
+(type: #export Local_Double
+  (#DLOAD Register)
+  (#DSTORE Register))
+
+(type: #export Local_Object
+  (#ALOAD Register)
+  (#ASTORE Register))
+
+(type: #export Local
+  (#Local_Int Local_Int)
+  (#IINC Register)
+  (#Local_Long Local_Long)
+  (#Local_Float Local_Float)
+  (#Local_Double Local_Double)
+  (#Local_Object Local_Object))
+
+(type: #export Stack
+  #DUP
+  #DUP_X1
+  #DUP_X2
+  #DUP2
+  #DUP2_X1
+  #DUP2_X2
+  #SWAP
+  #POP
+  #POP2)
+
+(type: #export Comparison
+  #LCMP
+  
+  #FCMPG
+  #FCMPL
+
+  #DCMPG
+  #DCMPL)
+
+(type: #export Label Nat)
+
+(type: #export (Branching label)
+  (#IF_ICMPEQ label)
+  (#IF_ICMPGE label)
+  (#IF_ICMPGT label)
+  (#IF_ICMPLE label)
+  (#IF_ICMPLT label)
+  (#IF_ICMPNE label)
+  (#IFEQ label)
+  (#IFNE label)
+  (#IFGE label)
+  (#IFGT label)
+  (#IFLE label)
+  (#IFLT label)
+
+  (#TABLESWITCH Int Int label (List label))
+  (#LOOKUPSWITCH label (List [Int label]))
+
+  (#IF_ACMPEQ label)
+  (#IF_ACMPNE label)
+  (#IFNONNULL label)
+  (#IFNULL label))
+
+(type: #export (Exception label)
+  (#Try label label label (Type Class))
+  #ATHROW)
+
+(type: #export Concurrency
+  #MONITORENTER
+  #MONITOREXIT)
+
+(type: #export Return
+  #RETURN
+  #IRETURN
+  #LRETURN
+  #FRETURN
+  #DRETURN
+  #ARETURN)
+
+(type: #export (Control label)
+  (#GOTO label)
+  (#Branching (Branching label))
+  (#Exception (Exception label))
+  (#Concurrency Concurrency)
+  (#Return Return))
+
+(type: #export (Instruction embedded label)
+  #NOP
+  (#Constant Constant)
+  (#Arithmetic Arithmetic)
+  (#Bitwise Bitwise)
+  (#Conversion Conversion)
+  (#Array Array)
+  (#Object Object)
+  (#Local Local)
+  (#Stack Stack)
+  (#Comparison Comparison)
+  (#Control (Control label))
+  (#Embedded embedded))
+
+(type: #export (Bytecode embedded label)
+  (Row (Instruction embedded label)))
diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux
new file mode 100644
index 000000000..9869a6f8b
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/attribute.lux
@@ -0,0 +1,123 @@
+(.module:
+  [library
+   [lux (#- Info Code)
+    [abstract
+     [monad (#+ do)]
+     ["." equivalence (#+ Equivalence)]]
+    [control
+     ["." try]
+     ["." exception (#+ exception:)]]
+    [data
+     ["." sum]
+     ["." product]
+     [format
+      [".F" binary (#+ Writer)]]]
+    [math
+     [number
+      ["n" nat]]]]]
+  ["." // #_
+   ["#." index (#+ Index)]
+   [encoding
+    ["#." unsigned (#+ U2 U4)]]
+   ["#." constant (#+ UTF8 Class Value)
+    ["#/." pool (#+ Pool Resource)]]]
+  ["." / #_
+   ["#." constant (#+ Constant)]
+   ["#." code]])
+
+(type: #export (Info about)
+  {#name (Index UTF8)
+   #length U4
+   #info about})
+
+(def: #export (info_equivalence Equivalence)
+  (All [about]
+    (-> (Equivalence about)
+        (Equivalence (Info about))))
+  ($_ product.equivalence
+      //index.equivalence
+      //unsigned.equivalence
+      Equivalence))
+
+(def: (info_writer writer)
+  (All [about]
+    (-> (Writer about)
+        (Writer (Info about))))
+  (function (_ [name length info])
+    (let [[nameS nameT] (//index.writer name)
+          [lengthS lengthT] (//unsigned.writer/4 length)
+          [infoS infoT] (writer info)]
+      [($_ n.+ nameS lengthS infoS)
+       (|>> nameT lengthT infoT)])))
+
+(with_expansions [ (as_is (/code.Code Attribute))]
+  (type: #export #rec Attribute
+    (#Constant (Info (Constant Any)))
+    (#Code (Info )))
+
+  (type: #export Code
+    )
+  )
+
+(def: #export equivalence
+  (Equivalence Attribute)
+  (equivalence.rec
+   (function (_ equivalence)
+     ($_ sum.equivalence
+         (info_equivalence /constant.equivalence)
+         (info_equivalence (/code.equivalence equivalence))))))
+
+(def: common_attribute_length
+  ($_ n.+
+      ## u2 attribute_name_index;
+      //unsigned.bytes/2
+      ## u4 attribute_length;
+      //unsigned.bytes/4
+      ))
+
+(def: (length attribute)
+  (-> Attribute Nat)
+  (case attribute
+    (^template []
+      [( [name length info])
+       (|> length //unsigned.value (n.+ ..common_attribute_length))])
+    ([#Constant] [#Code])))
+
+## TODO: Inline ASAP
+(def: (constant' @name index)
+  (-> (Index UTF8) (Constant Any) Attribute)
+  (#Constant {#name @name
+              #length (|> /constant.length //unsigned.u4 try.assume)
+              #info index}))
+
+(def: #export (constant index)
+  (-> (Constant Any) (Resource Attribute))
+  (do //constant/pool.monad
+    [@name (//constant/pool.utf8 "ConstantValue")]
+    (wrap (constant' @name index))))
+
+## TODO: Inline ASAP
+(def: (code' @name specification)
+  (-> (Index UTF8) Code Attribute)
+  (#Code {#name @name
+          ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+          #length (|> specification
+                      (/code.length ..length)
+                      //unsigned.u4
+                      try.assume)
+          #info specification}))
+
+(def: #export (code specification)
+  (-> Code (Resource Attribute))
+  (do //constant/pool.monad
+    [@name (//constant/pool.utf8 "Code")]
+    (wrap (code' @name specification))))
+
+(def: #export (writer value)
+  (Writer Attribute)
+  (case value
+    (#Constant attribute)
+    ((info_writer /constant.writer) attribute)
+    
+    (#Code attribute)
+    ((info_writer (/code.writer writer)) attribute)))
diff --git a/stdlib/source/library/lux/target/jvm/attribute/code.lux b/stdlib/source/library/lux/target/jvm/attribute/code.lux
new file mode 100644
index 000000000..80cc7a6ad
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/attribute/code.lux
@@ -0,0 +1,83 @@
+(.module:
+  [library
+   [lux (#- Code)
+    [type (#+ :share)]
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." product]
+     ["." binary (#+ Binary)]
+     [format
+      [".F" binary (#+ Writer) ("#\." monoid)]]
+     [collection
+      ["." row (#+ Row) ("#\." functor fold)]]]
+    [math
+     [number
+      ["n" nat]]]]]
+  ["." /// #_
+   [bytecode
+    [environment
+     ["#." limit (#+ Limit)]]]
+   [encoding
+    ["#." unsigned (#+ U2)]]]
+  ["." / #_
+   ["#." exception (#+ Exception)]])
+
+(type: #export (Code Attribute)
+  {#limit Limit
+   #code Binary
+   #exception_table (Row Exception)
+   #attributes (Row Attribute)})
+
+(def: #export (length length code)
+  (All [Attribute] (-> (-> Attribute Nat) (Code Attribute) Nat))
+  ($_ n.+
+      ## u2 max_stack;
+      ## u2 max_locals;
+      ///limit.length
+      ## u4 code_length;
+      ///unsigned.bytes/4
+      ## u1 code[code_length];
+      (binary.size (get@ #code code))
+      ## u2 exception_table_length;
+      ///unsigned.bytes/2
+      ## exception_table[exception_table_length];
+      (|> code
+          (get@ #exception_table)
+          row.size
+          (n.* /exception.length))
+      ## u2 attributes_count;
+      ///unsigned.bytes/2
+      ## attribute_info attributes[attributes_count];
+      (|> code
+          (get@ #attributes)
+          (row\map length)
+          (row\fold n.+ 0))))
+
+(def: #export (equivalence attribute_equivalence)
+  (All [attribute]
+    (-> (Equivalence attribute) (Equivalence (Code attribute))))
+  ($_ product.equivalence
+      ///limit.equivalence
+      binary.equivalence
+      (row.equivalence /exception.equivalence)
+      (row.equivalence attribute_equivalence)
+      ))
+
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+(def: #export (writer writer code)
+  (All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute))))
+  ($_ binaryF\compose
+      ## u2 max_stack;
+      ## u2 max_locals;
+      (///limit.writer (get@ #limit code))
+      ## u4 code_length;
+      ## u1 code[code_length];
+      (binaryF.binary/32 (get@ #code code))
+      ## u2 exception_table_length;
+      ## exception_table[exception_table_length];
+      ((binaryF.row/16 /exception.writer) (get@ #exception_table code))
+      ## u2 attributes_count;
+      ## attribute_info attributes[attributes_count];
+      ((binaryF.row/16 writer) (get@ #attributes code))
+      ))
diff --git a/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux
new file mode 100644
index 000000000..e2aa089b0
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux
@@ -0,0 +1,58 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." product]
+     ["." format #_
+      ["#" binary (#+ Writer)]]]
+    [math
+     [number
+      ["n" nat]]]]]
+  ["." // #_
+   ["//#" /// #_
+    [constant (#+ Class)]
+    ["#." index (#+ Index)]
+    [bytecode
+     ["#." address (#+ Address)]]
+    [encoding
+     ["#." unsigned (#+ U2)]]]])
+
+(type: #export Exception
+  {#start Address
+   #end Address
+   #handler Address
+   #catch (Index Class)})
+
+(def: #export equivalence
+  (Equivalence Exception)
+  ($_ product.equivalence
+      ////address.equivalence
+      ////address.equivalence
+      ////address.equivalence
+      ////index.equivalence
+      ))
+
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+(def: #export length
+  Nat
+  ($_ n.+
+      ## u2 start_pc;
+      ////unsigned.bytes/2
+      ## u2 end_pc;
+      ////unsigned.bytes/2
+      ## u2 handler_pc;
+      ////unsigned.bytes/2
+      ## u2 catch_type;
+      ////unsigned.bytes/2
+      ))
+
+(def: #export writer
+  (Writer Exception)
+  ($_ format.and
+      ////address.writer
+      ////address.writer
+      ////address.writer
+      ////index.writer
+      ))
diff --git a/stdlib/source/library/lux/target/jvm/attribute/constant.lux b/stdlib/source/library/lux/target/jvm/attribute/constant.lux
new file mode 100644
index 000000000..d9f26d418
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/attribute/constant.lux
@@ -0,0 +1,27 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     [format
+      [binary (#+ Writer)]]]]]
+  ["." /// #_
+   [constant (#+ Value)]
+   ["#." index (#+ Index)]
+   [encoding
+    ["#." unsigned (#+ U2 U4)]]])
+
+(type: #export (Constant a)
+  (Index (Value a)))
+
+(def: #export equivalence
+  (All [a] (Equivalence (Constant a)))
+  ///index.equivalence)
+
+(def: #export length
+  ///index.length)
+
+(def: #export writer
+  (All [a] (Writer (Constant a)))
+  ///index.writer)
diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux
new file mode 100644
index 000000000..c50278c28
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode.lux
@@ -0,0 +1,1046 @@
+(.module:
+  [library
+   [lux (#- Type int try)
+    ["." ffi (#+ import:)]
+    [abstract
+     [monoid (#+ Monoid)]
+     ["." monad (#+ Monad do)]]
+    [control
+     ["." writer (#+ Writer)]
+     ["." state (#+ State')]
+     ["." function]
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]]
+    [data
+     ["." product]
+     ["." maybe]
+     [text
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." functor fold)]
+      ["." dictionary (#+ Dictionary)]
+      ["." row (#+ Row)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["n" nat]
+      ["i" int]
+      ["." i32 (#+ I32)]]]]]
+  ["." / #_
+   ["#." address (#+ Address)]
+   ["#." jump (#+ Jump Big_Jump)]
+   ["_" instruction (#+ Primitive_Array_Type Instruction Estimator) ("#\." monoid)]
+   ["#." environment (#+ Environment)
+    [limit
+     ["/." registry (#+ Register Registry)]
+     ["/." stack (#+ Stack)]]]
+   ["/#" // #_
+    ["#." index (#+ Index)]
+    [encoding
+     ["#." name]
+     ["#." unsigned (#+ U1 U2)]
+     ["#." signed (#+ S1 S2 S4)]]
+    ["#." constant (#+ UTF8)
+     ["#/." pool (#+ Pool Resource)]]
+    [attribute
+     [code
+      ["#." exception (#+ Exception)]]]
+    ["." type (#+ Type)
+     [category (#+ Class Object Value' Value Return' Return Method)]
+     ["." reflection]
+     ["." parser]]]])
+
+(type: #export Label Nat)
+
+(type: #export Resolver (Dictionary Label [Stack (Maybe Address)]))
+
+(type: #export Tracker
+  {#program_counter Address
+   #next Label
+   #known Resolver})
+
+(def: fresh
+  Tracker
+  {#program_counter /address.start
+   #next 0
+   #known (dictionary.new n.hash)})
+
+(type: #export Relative
+  (-> Resolver (Try [(Row Exception) Instruction])))
+
+(def: no_exceptions
+  (Row Exception)
+  row.empty)
+
+(def: relative_identity
+  Relative
+  (function.constant (#try.Success [..no_exceptions _.empty])))
+
+(implementation: relative_monoid
+  (Monoid Relative)
+
+  (def: identity ..relative_identity)
+
+  (def: (compose left right)
+    (cond (is? ..relative_identity left)
+          right
+
+          (is? ..relative_identity right)
+          left
+
+          ## else
+          (function (_ resolver)
+            (do try.monad
+              [[left_exceptions left_instruction] (left resolver)
+               [right_exceptions right_instruction] (right resolver)]
+              (wrap [(\ row.monoid compose left_exceptions right_exceptions)
+                     (_\compose left_instruction right_instruction)]))))))
+
+(type: #export (Bytecode a)
+  (State' Try [Pool Environment Tracker] (Writer Relative a)))
+
+(def: #export new_label
+  (Bytecode Label)
+  (function (_ [pool environment tracker])
+    (#try.Success [[pool
+                    environment
+                    (update@ #next inc tracker)]
+                   [..relative_identity
+                    (get@ #next tracker)]])))
+
+(exception: #export (label_has_already_been_set {label Label})
+  (exception.report
+   ["Label" (%.nat label)]))
+
+(exception: #export (mismatched_environments {instruction Name}
+                                             {label Label}
+                                             {address Address}
+                                             {expected Stack}
+                                             {actual Stack})
+  (exception.report
+   ["Instruction" (%.name instruction)]
+   ["Label" (%.nat label)]
+   ["Address" (/address.format address)]
+   ["Expected" (/stack.format expected)]
+   ["Actual" (/stack.format actual)]))
+
+(with_expansions [ (as_is (wrap [[pool
+                                           environment
+                                           (update@ #known
+                                                    (dictionary.put label [actual (#.Some @here)])
+                                                    tracker)]
+                                          [..relative_identity
+                                           []]]))]
+  (def: #export (set_label label)
+    (-> Label (Bytecode Any))
+    (function (_ [pool environment tracker])
+      (let [@here (get@ #program_counter tracker)]
+        (case (dictionary.get label (get@ #known tracker))
+          (#.Some [expected (#.Some address)])
+          (exception.throw ..label_has_already_been_set [label])
+          
+          (#.Some [expected #.None])
+          (do try.monad
+            [[actual environment] (/environment.continue expected environment)]
+            )
+
+          #.None
+          (do try.monad
+            [[actual environment] (/environment.continue (|> environment
+                                                             (get@ #/environment.stack)
+                                                             (maybe.default /stack.empty))
+                                                         environment)]
+            ))))))
+
+(def: #export monad
+  (Monad Bytecode)
+  (<| (:as (Monad Bytecode))
+      (writer.with ..relative_monoid)
+      (: (Monad (State' Try [Pool Environment Tracker])))
+      state.with
+      (: (Monad Try))
+      try.monad))
+
+(def: #export fail
+  (-> Text Bytecode)
+  (|>> #try.Failure function.constant))
+
+(def: #export (throw exception value)
+  (All [e] (-> (exception.Exception e) e Bytecode))
+  (..fail (exception.construct exception value)))
+
+(def: #export (resolve environment bytecode)
+  (All [a] (-> Environment (Bytecode a) (Resource [Environment (Row Exception) Instruction a])))
+  (function (_ pool)
+    (do try.monad
+      [[[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh])
+       [exceptions instruction] (relative (get@ #known tracker))]
+      (wrap [pool [environment exceptions instruction output]]))))
+
+(def: (step estimator counter)
+  (-> Estimator Address (Try Address))
+  (/address.move (estimator counter) counter))
+
+(def: (bytecode consumption production registry [estimator bytecode] input)
+  (All [a] (-> U2 U2 Registry [Estimator (-> [a] Instruction)] [a] (Bytecode Any)))
+  (function (_ [pool environment tracker])
+    (do {! try.monad}
+      [environment' (|> environment
+                        (/environment.consumes consumption)
+                        (monad.bind ! (/environment.produces production))
+                        (monad.bind ! (/environment.has registry)))
+       program_counter' (step estimator (get@ #program_counter tracker))]
+      (wrap [[pool
+              environment'
+              (set@ #program_counter program_counter' tracker)]
+             [(function.constant (wrap [..no_exceptions (bytecode input)]))
+              []]]))))
+
+(template [ ]
+  [(def:  U2 (|>  //unsigned.u2 try.assume))]
+
+  [$0 0]
+  [$1 1]
+  [$2 2]
+  [$3 3]
+  [$4 4]
+  [$5 5]
+  [$6 6]
+  )
+
+(template [ ]
+  [(def:  Registry (|>  //unsigned.u2 try.assume /registry.registry))]
+
+  [@_ 0]
+  [@0 1]
+  [@1 2]
+  [@2 3]
+  [@3 4]
+  [@4 5]
+  )
+
+(template [    ]
+  [(def: #export 
+     (Bytecode Any)
+     (..bytecode 
+                 
+                 
+                 
+                 []))]
+
+  [nop $0 $0 @_ _.nop]
+  
+  [aconst_null $0 $1 @_ _.aconst_null]
+
+  [iconst_m1 $0 $1 @_ _.iconst_m1]
+  [iconst_0 $0 $1 @_ _.iconst_0]
+  [iconst_1 $0 $1 @_ _.iconst_1]
+  [iconst_2 $0 $1 @_ _.iconst_2]
+  [iconst_3 $0 $1 @_ _.iconst_3]
+  [iconst_4 $0 $1 @_ _.iconst_4]
+  [iconst_5 $0 $1 @_ _.iconst_5]
+
+  [lconst_0 $0 $2 @_ _.lconst_0]
+  [lconst_1 $0 $2 @_ _.lconst_1]
+
+  [fconst_0 $0 $1 @_ _.fconst_0]
+  [fconst_1 $0 $1 @_ _.fconst_1]
+  [fconst_2 $0 $1 @_ _.fconst_2]
+  
+  [dconst_0 $0 $2 @_ _.dconst_0]
+  [dconst_1 $0 $2 @_ _.dconst_1]
+
+  [pop $1 $0 @_ _.pop]
+  [pop2 $2 $0 @_ _.pop2]
+  
+  [dup $1 $2 @_ _.dup]
+  [dup_x1 $2 $3 @_ _.dup_x1]
+  [dup_x2 $3 $4 @_ _.dup_x2]
+  [dup2 $2 $4 @_ _.dup2]
+  [dup2_x1 $3 $5 @_ _.dup2_x1]
+  [dup2_x2 $4 $6 @_ _.dup2_x2]
+  
+  [swap $2 $2 @_ _.swap]
+
+  [iaload $2 $1 @_ _.iaload]
+  [laload $2 $2 @_ _.laload]
+  [faload $2 $1 @_ _.faload]
+  [daload $2 $2 @_ _.daload]
+  [aaload $2 $1 @_ _.aaload]
+  [baload $2 $1 @_ _.baload]
+  [caload $2 $1 @_ _.caload]
+  [saload $2 $1 @_ _.saload]
+
+  [iload_0 $0 $1 @0 _.iload_0]
+  [iload_1 $0 $1 @1 _.iload_1]
+  [iload_2 $0 $1 @2 _.iload_2]
+  [iload_3 $0 $1 @3 _.iload_3]
+
+  [lload_0 $0 $2 @1 _.lload_0]
+  [lload_1 $0 $2 @2 _.lload_1]
+  [lload_2 $0 $2 @3 _.lload_2]
+  [lload_3 $0 $2 @4 _.lload_3]
+  
+  [fload_0 $0 $1 @0 _.fload_0]
+  [fload_1 $0 $1 @1 _.fload_1]
+  [fload_2 $0 $1 @2 _.fload_2]
+  [fload_3 $0 $1 @3 _.fload_3]
+  
+  [dload_0 $0 $2 @1 _.dload_0]
+  [dload_1 $0 $2 @2 _.dload_1]
+  [dload_2 $0 $2 @3 _.dload_2]
+  [dload_3 $0 $2 @4 _.dload_3]
+  
+  [aload_0 $0 $1 @0 _.aload_0]
+  [aload_1 $0 $1 @1 _.aload_1]
+  [aload_2 $0 $1 @2 _.aload_2]
+  [aload_3 $0 $1 @3 _.aload_3]
+
+  [iastore $3 $1 @_ _.iastore]
+  [lastore $4 $1 @_ _.lastore]
+  [fastore $3 $1 @_ _.fastore]
+  [dastore $4 $1 @_ _.dastore]
+  [aastore $3 $1 @_ _.aastore]
+  [bastore $3 $1 @_ _.bastore]
+  [castore $3 $1 @_ _.castore]
+  [sastore $3 $1 @_ _.sastore]
+
+  [istore_0 $1 $0 @0 _.istore_0]
+  [istore_1 $1 $0 @1 _.istore_1]
+  [istore_2 $1 $0 @2 _.istore_2]
+  [istore_3 $1 $0 @3 _.istore_3]
+
+  [lstore_0 $2 $0 @1 _.lstore_0]
+  [lstore_1 $2 $0 @2 _.lstore_1]
+  [lstore_2 $2 $0 @3 _.lstore_2]
+  [lstore_3 $2 $0 @4 _.lstore_3]
+
+  [fstore_0 $1 $0 @0 _.fstore_0]
+  [fstore_1 $1 $0 @1 _.fstore_1]
+  [fstore_2 $1 $0 @2 _.fstore_2]
+  [fstore_3 $1 $0 @3 _.fstore_3]
+
+  [dstore_0 $2 $0 @1 _.dstore_0]
+  [dstore_1 $2 $0 @2 _.dstore_1]
+  [dstore_2 $2 $0 @3 _.dstore_2]
+  [dstore_3 $2 $0 @4 _.dstore_3]
+  
+  [astore_0 $1 $0 @0 _.astore_0]
+  [astore_1 $1 $0 @1 _.astore_1]
+  [astore_2 $1 $0 @2 _.astore_2]
+  [astore_3 $1 $0 @3 _.astore_3]
+
+  [iadd $2 $1 @_ _.iadd]
+  [isub $2 $1 @_ _.isub]
+  [imul $2 $1 @_ _.imul]
+  [idiv $2 $1 @_ _.idiv]
+  [irem $2 $1 @_ _.irem]
+  [ineg $1 $1 @_ _.ineg]
+  [iand $2 $1 @_ _.iand]
+  [ior $2 $1 @_ _.ior]
+  [ixor $2 $1 @_ _.ixor]
+  [ishl $2 $1 @_ _.ishl]
+  [ishr $2 $1 @_ _.ishr]
+  [iushr $2 $1 @_ _.iushr]
+
+  [ladd $4 $2 @_ _.ladd]
+  [lsub $4 $2 @_ _.lsub]
+  [lmul $4 $2 @_ _.lmul]
+  [ldiv $4 $2 @_ _.ldiv]
+  [lrem $4 $2 @_ _.lrem]
+  [lneg $2 $2 @_ _.lneg]
+  [land $4 $2 @_ _.land]
+  [lor $4 $2 @_ _.lor]
+  [lxor $4 $2 @_ _.lxor]
+  [lshl $3 $2 @_ _.lshl]
+  [lshr $3 $2 @_ _.lshr]
+  [lushr $3 $2 @_ _.lushr]
+  
+  [fadd $2 $1 @_ _.fadd]
+  [fsub $2 $1 @_ _.fsub]
+  [fmul $2 $1 @_ _.fmul]
+  [fdiv $2 $1 @_ _.fdiv]
+  [frem $2 $1 @_ _.frem]
+  [fneg $1 $1 @_ _.fneg]
+  
+  [dadd $4 $2 @_ _.dadd]
+  [dsub $4 $2 @_ _.dsub]
+  [dmul $4 $2 @_ _.dmul]
+  [ddiv $4 $2 @_ _.ddiv]
+  [drem $4 $2 @_ _.drem]
+  [dneg $2 $2 @_ _.dneg]
+
+  [l2i $2 $1 @_ _.l2i]
+  [l2f $2 $1 @_ _.l2f]
+  [l2d $2 $2 @_ _.l2d]
+  
+  [f2i $1 $1 @_ _.f2i]
+  [f2l $1 $2 @_ _.f2l]
+  [f2d $1 $2 @_ _.f2d]
+  
+  [d2i $2 $1 @_ _.d2i]
+  [d2l $2 $2 @_ _.d2l]
+  [d2f $2 $1 @_ _.d2f]
+
+  [i2l $1 $2 @_ _.i2l]
+  [i2f $1 $1 @_ _.i2f]
+  [i2d $1 $2 @_ _.i2d]
+  [i2b $1 $1 @_ _.i2b]
+  [i2c $1 $1 @_ _.i2c]
+  [i2s $1 $1 @_ _.i2s]
+
+  [lcmp $4 $1 @_ _.lcmp]
+  
+  [fcmpl $2 $1 @_ _.fcmpl]
+  [fcmpg $2 $1 @_ _.fcmpg]
+
+  [dcmpl $4 $1 @_ _.dcmpl]
+  [dcmpg $4 $1 @_ _.dcmpg]
+
+  [arraylength $1 $1 @_ _.arraylength]
+  
+  [monitorenter $1 $0 @_ _.monitorenter]
+  [monitorexit $1 $0 @_ _.monitorexit]
+  )
+
+(def: discontinuity!
+  (Bytecode Any)
+  (function (_ [pool environment tracker])
+    (do try.monad
+      [_ (/environment.stack environment)]
+      (wrap [[pool
+              (/environment.discontinue environment)
+              tracker]
+             [..relative_identity
+              []]]))))
+
+(template [  ]
+  [(def: #export 
+     (Bytecode Any)
+     (do ..monad
+       [_ (..bytecode  $0 @_  [])]
+       ..discontinuity!))]
+
+  [ireturn $1 _.ireturn]
+  [lreturn $2 _.lreturn]
+  [freturn $1 _.freturn]
+  [dreturn $2 _.dreturn]
+  [areturn $1 _.areturn]
+  [return $0 _.return]
+
+  [athrow $1 _.athrow]
+  )
+
+(def: #export (bipush byte)
+  (-> S1 (Bytecode Any))
+  (..bytecode $0 $1 @_ _.bipush [byte]))
+
+(def: (lift resource)
+  (All [a]
+    (-> (Resource a)
+        (Bytecode a)))
+  (function (_ [pool environment tracker])
+    (do try.monad
+      [[pool' output] (resource pool)]
+      (wrap [[pool' environment tracker]
+             [..relative_identity
+              output]]))))
+
+(def: #export (string value)
+  (-> //constant.UTF8 (Bytecode Any))
+  (do ..monad
+    [index (..lift (//constant/pool.string value))]
+    (case (|> index //index.value //unsigned.value //unsigned.u1)
+      (#try.Success index)
+      (..bytecode $0 $1 @_ _.ldc [index])
+
+      (#try.Failure _)
+      (..bytecode $0 $1 @_ _.ldc_w/string [index]))))
+
+(import: java/lang/Float
+  ["#::."
+   (#static floatToRawIntBits #manual [float] int)])
+
+(import: java/lang/Double
+  ["#::."
+   (#static doubleToRawLongBits #manual [double] long)])
+
+(template [      ]
+  [(def: #export ( value)
+     (->  (Bytecode Any))
+     (case (|> value )
+       (^template [ ]
+         [ (..bytecode $0 $1 @_  [])])
+       
+       
+       _ (do ..monad
+           [index (..lift ( ( value)))]
+           (case (|> index //index.value //unsigned.value //unsigned.u1)
+             (#try.Success index)
+             (..bytecode $0 $1 @_ _.ldc [index])
+
+             (#try.Failure _)
+             (..bytecode $0 $1 @_  [index])))))]
+
+  [int I32 //constant.integer //constant/pool.integer _.ldc_w/integer
+   (<| .int i32.i64)
+   ([-1 _.iconst_m1]
+    [+0 _.iconst_0]
+    [+1 _.iconst_1]
+    [+2 _.iconst_2]
+    [+3 _.iconst_3]
+    [+4 _.iconst_4]
+    [+5 _.iconst_5])]
+  )
+
+(def: (arbitrary_float value)
+  (-> java/lang/Float (Bytecode Any))
+  (do ..monad
+    [index (..lift (//constant/pool.float (//constant.float value)))]
+    (case (|> index //index.value //unsigned.value //unsigned.u1)
+      (#try.Success index)
+      (..bytecode $0 $1 @_ _.ldc [index])
+
+      (#try.Failure _)
+      (..bytecode $0 $1 @_ _.ldc_w/float [index]))))
+
+(def: float_bits
+  (-> java/lang/Float Int)
+  (|>> java/lang/Float::floatToRawIntBits
+       ffi.int_to_long
+       (:as Int)))
+
+(def: negative_zero_float_bits
+  (|> -0.0 (:as java/lang/Double) ffi.double_to_float ..float_bits))
+
+(def: #export (float value)
+  (-> java/lang/Float (Bytecode Any))
+  (if (i.= ..negative_zero_float_bits
+           (..float_bits value))
+    (..arbitrary_float value)
+    (case (|> value ffi.float_to_double (:as Frac))
+      (^template [ ]
+        [ (..bytecode $0 $1 @_  [])])
+      ([+0.0 _.fconst_0]
+       [+1.0 _.fconst_1]
+       [+2.0 _.fconst_2])
+      
+      _ (..arbitrary_float value))))
+
+(template [      ]
+  [(def: #export ( value)
+     (->  (Bytecode Any))
+     (case (|> value )
+       (^template [ ]
+         [ (..bytecode $0 $2 @_  [])])
+       
+       
+       _ (do ..monad
+           [index (..lift ( ( value)))]
+           (..bytecode $0 $2 @_  [index]))))]
+
+  [long Int //constant.long //constant/pool.long _.ldc2_w/long
+   (<|)
+   ([+0 _.lconst_0]
+    [+1 _.lconst_1])]
+  )
+
+(def: (arbitrary_double value)
+  (-> java/lang/Double (Bytecode Any))
+  (do ..monad
+    [index (..lift (//constant/pool.double (//constant.double (:as Frac value))))]
+    (..bytecode $0 $2 @_ _.ldc2_w/double [index])))
+
+(def: double_bits
+  (-> java/lang/Double Int)
+  (|>> java/lang/Double::doubleToRawLongBits
+       (:as Int)))
+
+(def: negative_zero_double_bits
+  (..double_bits (:as java/lang/Double -0.0)))
+
+(def: #export (double value)
+  (-> java/lang/Double (Bytecode Any))
+  (if (i.= ..negative_zero_double_bits
+           (..double_bits value))
+    (..arbitrary_double value)
+    (case (:as Frac value)
+      (^template [ ]
+        [ (..bytecode $0 $2 @_  [])])
+      ([+0.0 _.dconst_0]
+       [+1.0 _.dconst_1])
+      
+      _ (..arbitrary_double value))))
+
+(exception: #export (invalid_register {id Nat})
+  (exception.report
+   ["ID" (%.nat id)]))
+
+(def: (register id)
+  (-> Nat (Bytecode Register))
+  (case (//unsigned.u1 id)
+    (#try.Success register)
+    (\ ..monad wrap register)
+    
+    (#try.Failure error)
+    (..throw ..invalid_register [id])))
+
+(template [    ]
+  [(def: #export ( local)
+     (-> Nat (Bytecode Any))
+     (with_expansions [' (template.splice )]
+       (`` (case local
+             (~~ (template [  ]
+                   [ (..bytecode $0    [])]
+                   
+                   '))
+             _ (do ..monad
+                 [local (..register local)]
+                 (..bytecode $0  ( local)  [local]))))))]
+  
+  [/registry.for $1 iload _.iload
+   [[0 _.iload_0 @0]
+    [1 _.iload_1 @1]
+    [2 _.iload_2 @2]
+    [3 _.iload_3 @3]]]
+  [/registry.for_wide $2 lload _.lload
+   [[0 _.lload_0 @1]
+    [1 _.lload_1 @2]
+    [2 _.lload_2 @3]
+    [3 _.lload_3 @4]]]
+  [/registry.for $1 fload _.fload
+   [[0 _.fload_0 @0]
+    [1 _.fload_1 @1]
+    [2 _.fload_2 @2]
+    [3 _.fload_3 @3]]]
+  [/registry.for_wide $2 dload _.dload
+   [[0 _.dload_0 @1]
+    [1 _.dload_1 @2]
+    [2 _.dload_2 @3]
+    [3 _.dload_3 @4]]]
+  [/registry.for $1 aload _.aload
+   [[0 _.aload_0 @0]
+    [1 _.aload_1 @1]
+    [2 _.aload_2 @2]
+    [3 _.aload_3 @3]]]
+  )
+
+(template [    ]
+  [(def: #export ( local)
+     (-> Nat (Bytecode Any))
+     (with_expansions [' (template.splice )]
+       (`` (case local
+             (~~ (template [  ]
+                   [ (..bytecode  $0   [])]
+                   
+                   '))
+             _ (do ..monad
+                 [local (..register local)]
+                 (..bytecode  $0 ( local)  [local]))))))]
+  
+  [/registry.for $1 istore _.istore
+   [[0 _.istore_0 @0]
+    [1 _.istore_1 @1]
+    [2 _.istore_2 @2]
+    [3 _.istore_3 @3]]]
+  [/registry.for_wide $2 lstore _.lstore
+   [[0 _.lstore_0 @1]
+    [1 _.lstore_1 @2]
+    [2 _.lstore_2 @3]
+    [3 _.lstore_3 @4]]]
+  [/registry.for $1 fstore _.fstore
+   [[0 _.fstore_0 @0]
+    [1 _.fstore_1 @1]
+    [2 _.fstore_2 @2]
+    [3 _.fstore_3 @3]]]
+  [/registry.for_wide $2 dstore _.dstore
+   [[0 _.dstore_0 @1]
+    [1 _.dstore_1 @2]
+    [2 _.dstore_2 @3]
+    [3 _.dstore_3 @4]]]
+  [/registry.for $1 astore _.astore
+   [[0 _.astore_0 @0]
+    [1 _.astore_1 @1]
+    [2 _.astore_2 @2]
+    [3 _.astore_3 @3]]]
+  )
+
+(template [    ]
+  [(def: #export 
+     (->  (Bytecode Any))
+     (..bytecode   @_ ))]
+  
+  [$1 $1 newarray _.newarray Primitive_Array_Type]
+  [$0 $1 sipush _.sipush S2]
+  )
+
+(exception: #export (unknown_label {label Label})
+  (exception.report
+   ["Label" (%.nat label)]))
+
+(exception: #export (cannot_do_a_big_jump {label Label}
+                                          {@from Address}
+                                          {jump Big_Jump})
+  (exception.report
+   ["Label" (%.nat label)]
+   ["Start" (|> @from /address.value //unsigned.value %.nat)]
+   ["Target" (|> jump //signed.value %.int)]))
+
+(type: Any_Jump (Either Big_Jump Jump))
+
+(def: (jump @from @to)
+  (-> Address Address (Try Any_Jump))
+  (do {! try.monad}
+    [jump (\ ! map //signed.value
+             (/address.jump @from @to))]
+    (let [big? (n.> (//unsigned.value //unsigned.maximum/2)
+                    (.nat (i.* (if (i.>= +0 jump)
+                                 +1
+                                 -1)
+                               jump)))]
+      (if big?
+        (\ ! map (|>> #.Left) (//signed.s4 jump))
+        (\ ! map (|>> #.Right) (//signed.s2 jump))))))
+
+(exception: #export (unset_label {label Label})
+  (exception.report
+   ["Label" (%.nat label)]))
+
+(def: (resolve_label label resolver)
+  (-> Label Resolver (Try [Stack Address]))
+  (case (dictionary.get label resolver)
+    (#.Some [actual (#.Some address)])
+    (#try.Success [actual address])
+
+    (#.Some [actual #.None])
+    (exception.throw ..unset_label [label])
+    
+    #.None
+    (exception.throw ..unknown_label [label])))
+
+(def: (acknowledge_label stack label tracker)
+  (-> Stack Label Tracker Tracker)
+  (case (dictionary.get label (get@ #known tracker))
+    (#.Some _)
+    tracker
+
+    #.None
+    (update@ #known (dictionary.put label [stack #.None]) tracker)))
+
+(template [  ]
+  [(def: #export ( label)
+     (-> Label (Bytecode Any))
+     (let [[estimator bytecode] ]
+       (function (_ [pool environment tracker])
+         (let [@here (get@ #program_counter tracker)]
+           (do try.monad
+             [environment' (|> environment
+                               (/environment.consumes ))
+              actual (/environment.stack environment')
+              program_counter' (step estimator @here)]
+             (wrap (let [@from @here]
+                     [[pool
+                       environment'
+                       (|> tracker
+                           (..acknowledge_label actual label)
+                           (set@ #program_counter program_counter'))]
+                      [(function (_ resolver)
+                         (do try.monad
+                           [[expected @to] (..resolve_label label resolver)
+                            _ (exception.assert ..mismatched_environments [(name_of ) label @here expected actual]
+                                                (\ /stack.equivalence = expected actual))
+                            jump (..jump @from @to)]
+                           (case jump
+                             (#.Left jump)
+                             (exception.throw ..cannot_do_a_big_jump [label @from jump])
+
+                             (#.Right jump)
+                             (wrap [..no_exceptions (bytecode jump)]))))
+                       []]])))))))]
+
+  [$1 ifeq _.ifeq]
+  [$1 ifne _.ifne]
+  [$1 iflt _.iflt]
+  [$1 ifge _.ifge]
+  [$1 ifgt _.ifgt]
+  [$1 ifle _.ifle]
+  
+  [$1 ifnull _.ifnull]
+  [$1 ifnonnull _.ifnonnull]
+
+  [$2 if_icmpeq _.if_icmpeq]
+  [$2 if_icmpne _.if_icmpne]
+  [$2 if_icmplt _.if_icmplt]
+  [$2 if_icmpge _.if_icmpge]
+  [$2 if_icmpgt _.if_icmpgt]
+  [$2 if_icmple _.if_icmple]
+  
+  [$2 if_acmpeq _.if_acmpeq]
+  [$2 if_acmpne _.if_acmpne]
+  )
+
+(template [   ]
+  [(def: #export ( label)
+     (-> Label (Bytecode Any))
+     (let [[estimator bytecode] ]
+       (function (_ [pool environment tracker])
+         (do try.monad
+           [actual (/environment.stack environment)
+            #let [@here (get@ #program_counter tracker)]
+            program_counter' (step estimator @here)]
+           (wrap (let [@from @here]
+                   [[pool
+                     (/environment.discontinue environment)
+                     (|> tracker
+                         (..acknowledge_label actual label)
+                         (set@ #program_counter program_counter'))]
+                    [(function (_ resolver)
+                       (case (dictionary.get label resolver)
+                         (#.Some [expected (#.Some @to)])
+                         (do try.monad
+                           [_ (exception.assert ..mismatched_environments [(name_of ) label @here expected actual]
+                                                (\ /stack.equivalence = expected actual))
+                            jump (..jump @from @to)]
+                           (case jump
+                             (#.Left jump)
+                             
+
+                             (#.Right jump)
+                             ))
+
+                         (#.Some [expected #.None])
+                         (exception.throw ..unset_label [label])
+
+                         #.None
+                         (exception.throw ..unknown_label [label])))
+                     []]]))))))]
+
+  [goto _.goto
+   (exception.throw ..cannot_do_a_big_jump [label @from jump])
+   (wrap [..no_exceptions (bytecode jump)])]
+  [goto_w _.goto_w
+   (wrap [..no_exceptions (bytecode jump)])
+   (wrap [..no_exceptions (bytecode (/jump.lift jump))])]
+  )
+
+(def: (big_jump jump)
+  (-> Any_Jump Big_Jump)
+  (case jump
+    (#.Left big)
+    big
+
+    (#.Right small)
+    (/jump.lift small)))
+
+(exception: #export invalid_tableswitch)
+
+(def: #export (tableswitch minimum default [at_minimum afterwards])
+  (-> S4 Label [Label (List Label)] (Bytecode Any))
+  (let [[estimator bytecode] _.tableswitch]
+    (function (_ [pool environment tracker])
+      (do try.monad
+        [environment' (|> environment
+                          (/environment.consumes $1))
+         actual (/environment.stack environment')
+         program_counter' (step (estimator (list.size afterwards)) (get@ #program_counter tracker))]
+        (wrap (let [@from (get@ #program_counter tracker)]
+                [[pool
+                  environment'
+                  (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards))
+                      (set@ #program_counter program_counter'))]
+                 [(function (_ resolver)
+                    (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
+                                 (function (_ label)
+                                   (dictionary.get label resolver)))]
+                      (case (do {! maybe.monad}
+                              [@default (|> default get (monad.bind ! product.right))
+                               @at_minimum (|> at_minimum get (monad.bind ! product.right))
+                               @afterwards (|> afterwards
+                                               (monad.map ! get)
+                                               (monad.bind ! (monad.map ! product.right)))]
+                              (wrap [@default @at_minimum @afterwards]))
+                        (#.Some [@default @at_minimum @afterwards])
+                        (do {! try.monad}
+                          [>default (\ ! map ..big_jump (..jump @from @default))
+                           >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum))
+                           >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))
+                                                  @afterwards)]
+                          (wrap [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])]))
+
+                        #.None
+                        (exception.throw ..invalid_tableswitch []))))
+                  []]]))))))
+
+(exception: #export invalid_lookupswitch)
+
+(def: #export (lookupswitch default cases)
+  (-> Label (List [S4 Label]) (Bytecode Any))
+  (let [cases (list.sort (function (_ [left _] [right _])
+                           (i.< (//signed.value left)
+                                (//signed.value right)))
+                         cases)
+        [estimator bytecode] _.lookupswitch]
+    (function (_ [pool environment tracker])
+      (do try.monad
+        [environment' (|> environment
+                          (/environment.consumes $1))
+         actual (/environment.stack environment')
+         program_counter' (step (estimator (list.size cases)) (get@ #program_counter tracker))]
+        (wrap (let [@from (get@ #program_counter tracker)]
+                [[pool
+                  environment'
+                  (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases)))
+                      (set@ #program_counter program_counter'))]
+                 [(function (_ resolver)
+                    (let [get (: (-> Label (Maybe [Stack (Maybe Address)]))
+                                 (function (_ label)
+                                   (dictionary.get label resolver)))]
+                      (case (do {! maybe.monad}
+                              [@default (|> default get (monad.bind ! product.right))
+                               @cases (|> cases
+                                          (monad.map ! (|>> product.right get))
+                                          (monad.bind ! (monad.map ! product.right)))]
+                              (wrap [@default @cases]))
+                        (#.Some [@default @cases])
+                        (do {! try.monad}
+                          [>default (\ ! map ..big_jump (..jump @from @default))
+                           >cases (|> @cases
+                                      (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)))
+                                      (\ ! map (|>> (list.zip/2 (list\map product.left cases)))))]
+                          (wrap [..no_exceptions (bytecode >default >cases)]))
+
+                        #.None
+                        (exception.throw ..invalid_lookupswitch []))))
+                  []]]))))))
+
+(def: reflection
+  (All [category]
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> type.reflection reflection.reflection))
+
+(template [    ]
+  [(def: #export ( class)
+     (-> (Type ) (Bytecode Any))
+     (do ..monad
+       [## TODO: Make sure it's impossible to have indexes greater than U2.
+        index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
+       (..bytecode   @_  [index])))]
+
+  [$0 $1 new Class _.new]
+  [$1 $1 anewarray Object _.anewarray]
+  [$1 $1 checkcast Object _.checkcast]
+  [$1 $1 instanceof Object _.instanceof]
+  )
+
+(def: #export (iinc register increase)
+  (-> Nat U1 (Bytecode Any))
+  (do ..monad
+    [register (..register register)]
+    (..bytecode $0 $0 (/registry.for register) _.iinc [register increase])))
+
+(exception: #export (multiarray_cannot_be_zero_dimensional {class (Type Object)})
+  (exception.report ["Class" (..reflection class)]))
+
+(def: #export (multianewarray class dimensions)
+  (-> (Type Object) U1 (Bytecode Any))
+  (do ..monad
+    [_ (: (Bytecode Any)
+          (case (|> dimensions //unsigned.value)
+            0 (..throw ..multiarray_cannot_be_zero_dimensional [class])
+            _ (wrap [])))
+     index (..lift (//constant/pool.class (//name.internal (..reflection class))))]
+    (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions])))
+
+(def: (type_size type)
+  (-> (Type Return) Nat)
+  (cond (is? type.void type)
+        0
+
+        (or (is? type.long type)
+            (is? type.double type))
+        2
+
+        ## else
+        1))
+
+(template [   ]
+  [(def: #export ( class method type)
+     (-> (Type Class) Text (Type Method) (Bytecode Any))
+     (let [[inputs output exceptions] (parser.method type)]
+       (do ..monad
+         [index (<| ..lift
+                    ( (..reflection class))
+                    {#//constant/pool.name method
+                     #//constant/pool.descriptor (type.descriptor type)})
+          #let [consumption (|> inputs
+                                (list\map ..type_size)
+                                (list\fold n.+ (if  0 1))
+                                //unsigned.u1
+                                try.assume)
+                production (|> output ..type_size //unsigned.u1 try.assume)]]
+         (..bytecode (//unsigned.lift/2 consumption)
+                     (//unsigned.lift/2 production)
+                     @_
+                      [index consumption production]))))]
+
+  [#1 invokestatic _.invokestatic //constant/pool.method]
+  [#0 invokevirtual _.invokevirtual //constant/pool.method]
+  [#0 invokespecial _.invokespecial //constant/pool.method]
+  [#0 invokeinterface _.invokeinterface //constant/pool.interface_method]
+  )
+
+(template [  <1> <2>]
+  [(def: #export ( class field type)
+     (-> (Type Class) Text (Type Value) (Bytecode Any))
+     (do ..monad
+       [index (<| ..lift
+                  (//constant/pool.field (..reflection class))
+                  {#//constant/pool.name field
+                   #//constant/pool.descriptor (type.descriptor type)})]
+       (if (or (is? type.long type)
+               (is? type.double type))
+         (..bytecode  $2 @_ <2> [index])
+         (..bytecode  $1 @_ <1> [index]))))]
+
+  [$0 getstatic _.getstatic/1 _.getstatic/2]
+  [$1 putstatic _.putstatic/1 _.putstatic/2]
+  [$1 getfield _.getfield/1 _.getfield/2]
+  [$2 putfield _.putfield/1 _.putfield/2]
+  )
+
+(exception: #export (invalid_range_for_try {start Address} {end Address})
+  (exception.report
+   ["Start" (|> start /address.value //unsigned.value %.nat)]
+   ["End" (|> end /address.value //unsigned.value %.nat)]))
+
+(def: #export (try @start @end @handler catch)
+  (-> Label Label Label (Type Class) (Bytecode Any))
+  (do ..monad
+    [@catch (..lift (//constant/pool.class (//name.internal (..reflection catch))))]
+    (function (_ [pool environment tracker])
+      (#try.Success
+       [[pool
+         environment
+         (..acknowledge_label /stack.catch @handler tracker)]
+        [(function (_ resolver)
+           (do try.monad
+             [[_ @start] (..resolve_label @start resolver)
+              [_ @end] (..resolve_label @end resolver)
+              _ (if (/address.after? @start @end)
+                  (wrap [])
+                  (exception.throw ..invalid_range_for_try [@start @end]))
+              [_ @handler] (..resolve_label @handler resolver)]
+             (wrap [(row.row {#//exception.start @start
+                              #//exception.end @end
+                              #//exception.handler @handler
+                              #//exception.catch @catch})
+                    _.empty])))
+         []]]))))
+
+(def: #export (compose pre post)
+  (All [pre post]
+    (-> (Bytecode pre) (Bytecode post) (Bytecode post)))
+  (do ..monad
+    [_ pre]
+    post))
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/address.lux b/stdlib/source/library/lux/target/jvm/bytecode/address.lux
new file mode 100644
index 000000000..8d51a8597
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux
@@ -0,0 +1,74 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     [format
+      [binary (#+ Writer)]]
+     [text
+      ["%" format (#+ Format)]]]
+    [math
+     [number
+      ["n" nat]]]
+    [type
+     abstract]]]
+  ["." // #_
+   [jump (#+ Big_Jump)]
+   ["/#" // #_
+    [encoding
+     ["#." unsigned (#+ U2)]
+     ["#." signed (#+ S4)]]]])
+
+(abstract: #export Address
+  U2
+
+  (def: #export value
+    (-> Address U2)
+    (|>> :representation))
+
+  (def: #export start
+    Address
+    (|> 0 ///unsigned.u2 try.assume :abstraction))
+
+  (def: #export (move distance)
+    (-> U2 (-> Address (Try Address)))
+    (|>> :representation
+         (///unsigned.+/2 distance)
+         (\ try.functor map (|>> :abstraction))))
+
+  (def: with_sign
+    (-> Address (Try S4))
+    (|>> :representation ///unsigned.value .int ///signed.s4))
+
+  (def: #export (jump from to)
+    (-> Address Address (Try Big_Jump))
+    (do try.monad
+      [from (with_sign from)
+       to (with_sign to)]
+      (///signed.-/4 from to)))
+
+  (def: #export (after? reference subject)
+    (-> Address Address Bit)
+    (n.> (|> reference :representation ///unsigned.value)
+         (|> subject :representation ///unsigned.value)))
+
+  (implementation: #export equivalence
+    (Equivalence Address)
+    
+    (def: (= reference subject)
+      (\ ///unsigned.equivalence =
+         (:representation reference)
+         (:representation subject))))
+
+  (def: #export writer
+    (Writer Address)
+    (|>> :representation ///unsigned.writer/2))
+
+  (def: #export format
+    (Format Address)
+    (|>> :representation ///unsigned.value %.nat))
+  )
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux
new file mode 100644
index 000000000..fdf50d974
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux
@@ -0,0 +1,108 @@
+(.module:
+  [library
+   [lux (#- Type static)
+    [abstract
+     [monad (#+ do)]
+     [monoid (#+ Monoid)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]]]]
+  [/
+   ["/." limit (#+ Limit)
+    ["/." stack (#+ Stack)]
+    ["/." registry (#+ Registry)]]
+   [///
+    [encoding
+     [unsigned (#+ U2)]]
+    [type (#+ Type)
+     [category (#+ Method)]]]])
+
+(type: #export Environment
+  {#limit Limit
+   #stack (Maybe Stack)})
+
+(template [ ]
+  [(def: #export ( type)
+     (-> (Type Method) (Try Environment))
+     (do try.monad
+       [limit ( type)]
+       (wrap {#limit limit
+              #stack (#.Some /stack.empty)})))]
+
+  [static /limit.static]
+  [virtual /limit.virtual]
+  )
+
+(type: #export Condition
+  (-> Environment (Try Environment)))
+
+(implementation: #export monoid
+  (Monoid Condition)
+
+  (def: identity (|>> #try.Success))
+
+  (def: (compose left right)
+    (function (_ environment)
+      (do try.monad
+        [environment (left environment)]
+        (right environment)))))
+
+(exception: #export discontinuity)
+
+(def: #export (stack environment)
+  (-> Environment (Try Stack))
+  (case (get@ #..stack environment)
+    (#.Some stack)
+    (#try.Success stack)
+
+    #.None
+    (exception.throw ..discontinuity [])))
+
+(def: #export discontinue
+  (-> Environment Environment)
+  (set@ #..stack #.None))
+
+(exception: #export (mismatched_stacks {expected Stack}
+                                       {actual Stack})
+  (exception.report
+   ["Expected" (/stack.format expected)]
+   ["Actual" (/stack.format actual)]))
+
+(def: #export (continue expected environment)
+  (-> Stack Environment (Try [Stack Environment]))
+  (case (get@ #..stack environment)
+    (#.Some actual)
+    (if (\ /stack.equivalence = expected actual)
+      (#try.Success [actual environment])
+      (exception.throw ..mismatched_stacks [expected actual]))
+
+    #.None
+    (#try.Success [expected (set@ #..stack (#.Some expected) environment)])))
+
+(def: #export (consumes amount)
+  (-> U2 Condition)
+  ## TODO: Revisit this definition once lenses/optics have been implemented,
+  ## since it can probably be simplified with them.
+  (function (_ environment)
+    (do try.monad
+      [previous (..stack environment)
+       current (/stack.pop amount previous)]
+      (wrap (set@ #..stack (#.Some current) environment)))))
+
+(def: #export (produces amount)
+  (-> U2 Condition)
+  (function (_ environment)
+    (do try.monad
+      [previous (..stack environment)
+       current (/stack.push amount previous)
+       #let [limit (|> environment
+                       (get@ [#..limit #/limit.stack])
+                       (/stack.max current))]]
+      (wrap (|> environment
+                (set@ #..stack (#.Some current))
+                (set@ [#..limit #/limit.stack] limit))))))
+
+(def: #export (has registry)
+  (-> Registry Condition)
+  (|>> (update@ [#..limit #/limit.registry] (/registry.has registry))
+       #try.Success))
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux
new file mode 100644
index 000000000..c7e9a8959
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux
@@ -0,0 +1,58 @@
+(.module:
+  [library
+   [lux (#- Type static)
+    [abstract
+     [monad (#+ do)]
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." product]
+     ["." format #_
+      ["#" binary (#+ Writer) ("#\." monoid)]]]
+    [math
+     [number
+      ["n" nat]]]]]
+  ["." / #_
+   ["#." stack (#+ Stack)]
+   ["#." registry (#+ Registry)]
+   [////
+    [type (#+ Type)
+     [category (#+ Method)]]]])
+
+(type: #export Limit
+  {#stack Stack
+   #registry Registry})
+
+(template [ ]
+  [(def: #export ( type)
+     (-> (Type Method) (Try Limit))
+     (do try.monad
+       [registry ( type)]
+       (wrap {#stack /stack.empty
+              #registry registry})))]
+
+  [static /registry.static]
+  [virtual /registry.virtual]
+  )
+
+(def: #export length
+  ($_ n.+
+      ## u2 max_stack;
+      /stack.length
+      ## u2 max_locals;
+      /registry.length))
+
+(def: #export equivalence
+  (Equivalence Limit)
+  ($_ product.equivalence
+      /stack.equivalence
+      /registry.equivalence
+      ))
+
+(def: #export (writer limit)
+  (Writer Limit)
+  ($_ format\compose
+      (/stack.writer (get@ #stack limit))
+      (/registry.writer (get@ #registry limit))
+      ))
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux
new file mode 100644
index 000000000..05872be60
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux
@@ -0,0 +1,91 @@
+(.module:
+  [library
+   [lux (#- Type for static)
+    [abstract
+     ["." equivalence (#+ Equivalence)]]
+    [control
+     ["." try (#+ Try) ("#\." functor)]]
+    [data
+     [format
+      [binary (#+ Writer)]]
+     [collection
+      ["." list ("#\." functor fold)]]]
+    [math
+     [number
+      ["n" nat]]]
+    [type
+     abstract]]]
+  ["." ///// #_
+   [encoding
+    ["#." unsigned (#+ U1 U2)]]
+   ["#." type (#+ Type)
+    [category (#+ Method)]
+    ["#/." parser]]])
+
+(type: #export Register U1)
+
+(def: normal 1)
+(def: wide 2)
+
+(abstract: #export Registry
+  U2
+
+  (def: #export registry
+    (-> U2 Registry)
+    (|>> :abstraction))
+
+  (def: (minimal type)
+    (-> (Type Method) Nat)
+    (let [[inputs output exceptions] (/////type/parser.method type)]
+      (|> inputs
+          (list\map (function (_ input)
+                      (if (or (is? /////type.long input)
+                              (is? /////type.double input))
+                        ..wide
+                        ..normal)))
+          (list\fold n.+ 0))))
+
+  (template [ ]
+    [(def: #export 
+       (-> (Type Method) (Try Registry))
+       (|>> ..minimal
+            (n.+ )
+            /////unsigned.u2
+            (try\map ..registry)))]
+
+    [0 static]
+    [1 virtual]
+    )
+
+  (def: #export equivalence
+    (Equivalence Registry)
+    (\ equivalence.functor map
+       (|>> :representation)
+       /////unsigned.equivalence))
+
+  (def: #export writer
+    (Writer Registry)
+    (|>> :representation /////unsigned.writer/2))
+
+  (def: #export (has needed)
+    (-> Registry Registry Registry)
+    (|>> :representation
+         (/////unsigned.max/2 (:representation needed))
+         :abstraction))
+
+  (template [ ]
+    [(def: #export 
+       (-> Register Registry)
+       (let [extra (|>  /////unsigned.u2 try.assume)]
+         (|>> /////unsigned.lift/2
+              (/////unsigned.+/2 extra)
+              try.assume
+              :abstraction)))]
+
+    [for ..normal]
+    [for_wide ..wide]
+    )
+  )
+
+(def: #export length
+  /////unsigned.bytes/2)
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux
new file mode 100644
index 000000000..99a560347
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux
@@ -0,0 +1,69 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." equivalence (#+ Equivalence)]]
+    [control
+     ["." try (#+ Try)]]
+    [data
+     ["." maybe]
+     [text
+      ["%" format (#+ Format)]]
+     [format
+      [binary (#+ Writer)]]]
+    [type
+     abstract]]]
+  ["." ///// #_
+   [encoding
+    ["#." unsigned (#+ U2)]]])
+
+(abstract: #export Stack
+  U2
+
+  (template [ ]
+    [(def: #export 
+       Stack
+       (|>  /////unsigned.u2 maybe.assume :abstraction))]
+
+    [0 empty]
+    [1 catch]
+    )
+
+  (def: #export equivalence
+    (Equivalence Stack)
+    (\ equivalence.functor map
+       (|>> :representation)
+       /////unsigned.equivalence))
+
+  (def: #export writer
+    (Writer Stack)
+    (|>> :representation /////unsigned.writer/2))
+
+  (def: stack
+    (-> U2 Stack)
+    (|>> :abstraction))
+
+  (template [ ]
+    [(def: #export ( amount)
+       (-> U2 (-> Stack (Try Stack)))
+       (|>> :representation
+            ( amount)
+            (\ try.functor map ..stack)))]
+
+    [/////unsigned.+/2 push]
+    [/////unsigned.-/2 pop]
+    )
+
+  (def: #export (max left right)
+    (-> Stack Stack Stack)
+    (:abstraction
+     (/////unsigned.max/2 (:representation left)
+                          (:representation right))))
+
+  (def: #export format
+    (Format Stack)
+    (|>> :representation /////unsigned.value %.nat))
+  )
+
+(def: #export length
+  /////unsigned.bytes/2)
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux
new file mode 100644
index 000000000..65e36875f
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux
@@ -0,0 +1,714 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [monad (#+ do)]
+     [monoid (#+ Monoid)]]
+    [control
+     ["." function]
+     ["." try]]
+    [data
+     ["." product]
+     ["." binary]
+     ["." format #_
+      ["#" binary (#+ Mutation Specification)]]
+     [collection
+      ["." list]]]
+    [macro
+     ["." template]]
+    [math
+     [number (#+ hex)
+      ["n" nat]]]
+    [type
+     abstract]]]
+  ["." // #_
+   ["#." address (#+ Address)]
+   ["#." jump (#+ Jump Big_Jump)]
+   [environment
+    [limit
+     [registry (#+ Register)]]]
+   ["/#" // #_
+    ["#." index (#+ Index)]
+    ["#." constant (#+ Class Reference)]
+    [encoding
+     ["#." unsigned (#+ U1 U2 U4)]
+     ["#." signed (#+ S1 S2 S4)]]
+    [type
+     [category (#+ Value Method)]]]])
+
+(type: #export Size U2)
+
+(type: #export Estimator
+  (-> Address Size))
+
+(def: fixed
+  (-> Size Estimator)
+  function.constant)
+
+(type: #export Instruction
+  (-> Specification Specification))
+
+(def: #export empty
+  Instruction
+  function.identity)
+
+(def: #export run
+  (-> Instruction Specification)
+  (function.apply format.no_op))
+
+(type: Opcode Nat)
+
+(template [ ]
+  [(def:  Size (|>  ///unsigned.u2 try.assume))]
+
+  [opcode_size 1]
+  [register_size 1]
+  [byte_size 1]
+  [index_size 2]
+  [big_jump_size 4]
+  [integer_size 4]
+  )
+
+(def: (nullary' opcode)
+  (-> Opcode Mutation)
+  (function (_ [offset binary])
+    [(n.+ (///unsigned.value ..opcode_size)
+          offset)
+     (try.assume
+      (binary.write/8 offset opcode binary))]))
+
+(def: nullary
+  [Estimator (-> Opcode Instruction)]
+  [(..fixed ..opcode_size)
+   (function (_ opcode [size mutation])
+     [(n.+ (///unsigned.value ..opcode_size)
+           size)
+      (|>> mutation ((nullary' opcode)))])])
+
+(template [ ]
+  [(def: 
+     Size
+     (|> ..opcode_size
+         (///unsigned.+/2 ) try.assume))]
+
+  [size/1 ..register_size]
+  [size/2 ..index_size]
+  [size/4 ..big_jump_size]
+  )
+
+(template [    ]
+  [(with_expansions [ (template.identifier ["'" ])]
+     (def: ( opcode input0)
+       (-> Opcode  Mutation)
+       (function (_ [offset binary])
+         [(n.+ (///unsigned.value ) offset)
+          (try.assume
+           (do try.monad
+             [_ (binary.write/8 offset opcode binary)]
+             ( (n.+ (///unsigned.value ..opcode_size) offset)
+                       ( input0)
+                       binary)))]))
+
+     (def: 
+       [Estimator (-> Opcode  Instruction)]
+       [(..fixed )
+        (function (_ opcode input0 [size mutation])
+          [(n.+ (///unsigned.value ) size)
+           (|>> mutation (( opcode input0)))])]))]
+
+  [..size/1 unary/1 U1 binary.write/8 ///unsigned.value]
+  [..size/2 unary/2 U2 binary.write/16 ///unsigned.value]
+  [..size/2 jump/2 Jump binary.write/16 ///signed.value]
+  [..size/4 jump/4 Big_Jump binary.write/32 ///signed.value]
+  )
+
+(template [   ]
+  [(with_expansions [ (template.identifier ["'" ])]
+     (def: ( opcode input0)
+       (-> Opcode  Mutation)
+       (function (_ [offset binary])
+         [(n.+ (///unsigned.value ) offset)
+          (try.assume
+           (do try.monad
+             [_ (binary.write/8 offset opcode binary)]
+             ( (n.+ (///unsigned.value ..opcode_size) offset)
+                       (///signed.value input0)
+                       binary)))]))
+
+     (def: 
+       [Estimator (-> Opcode  Instruction)]
+       [(..fixed )
+        (function (_ opcode input0 [size mutation])
+          [(n.+ (///unsigned.value ) size)
+           (|>> mutation (( opcode input0)))])]))]
+
+  [..size/1 unary/1' S1 binary.write/8]
+  [..size/2 unary/2' S2 binary.write/16]
+  )
+
+(def: size/11
+  Size
+  (|> ..opcode_size
+      (///unsigned.+/2 ..register_size) try.assume
+      (///unsigned.+/2 ..byte_size) try.assume))
+
+(def: (binary/11' opcode input0 input1)
+  (-> Opcode U1 U1 Mutation)
+  (function (_ [offset binary])
+    [(n.+ (///unsigned.value ..size/11) offset)
+     (try.assume
+      (do try.monad
+        [_ (binary.write/8 offset opcode binary)
+         _ (binary.write/8 (n.+ (///unsigned.value ..opcode_size) offset)
+                           (///unsigned.value input0)
+                           binary)]
+        (binary.write/8 (n.+ (///unsigned.value ..size/1) offset)
+                        (///unsigned.value input1)
+                        binary)))]))
+
+(def: binary/11
+  [Estimator (-> Opcode U1 U1 Instruction)]
+  [(..fixed ..size/11)
+   (function (_ opcode input0 input1 [size mutation])
+     [(n.+ (///unsigned.value ..size/11) size)
+      (|>> mutation ((binary/11' opcode input0 input1)))])])
+
+(def: size/21
+  Size
+  (|> ..opcode_size
+      (///unsigned.+/2 ..index_size) try.assume
+      (///unsigned.+/2 ..byte_size) try.assume))
+
+(def: (binary/21' opcode input0 input1)
+  (-> Opcode U2 U1 Mutation)
+  (function (_ [offset binary])
+    [(n.+ (///unsigned.value ..size/21) offset)
+     (try.assume
+      (do try.monad
+        [_ (binary.write/8 offset opcode binary)
+         _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset)
+                            (///unsigned.value input0)
+                            binary)]
+        (binary.write/8 (n.+ (///unsigned.value ..size/2) offset)
+                        (///unsigned.value input1)
+                        binary)))]))
+
+(def: binary/21
+  [Estimator (-> Opcode U2 U1 Instruction)]
+  [(..fixed ..size/21)
+   (function (_ opcode input0 input1 [size mutation])
+     [(n.+ (///unsigned.value ..size/21) size)
+      (|>> mutation ((binary/21' opcode input0 input1)))])])
+
+(def: size/211
+  Size
+  (|> ..opcode_size
+      (///unsigned.+/2 ..index_size) try.assume
+      (///unsigned.+/2 ..byte_size) try.assume
+      (///unsigned.+/2 ..byte_size) try.assume))
+
+(def: (trinary/211' opcode input0 input1 input2)
+  (-> Opcode U2 U1 U1 Mutation)
+  (function (_ [offset binary])
+    [(n.+ (///unsigned.value ..size/211) offset)
+     (try.assume
+      (do try.monad
+        [_ (binary.write/8 offset opcode binary)
+         _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset)
+                            (///unsigned.value input0)
+                            binary)
+         _ (binary.write/8 (n.+ (///unsigned.value ..size/2) offset)
+                           (///unsigned.value input1)
+                           binary)]
+        (binary.write/8 (n.+ (///unsigned.value ..size/21) offset)
+                        (///unsigned.value input2)
+                        binary)))]))
+
+(def: trinary/211
+  [Estimator (-> Opcode U2 U1 U1 Instruction)]
+  [(..fixed ..size/211)
+   (function (_ opcode input0 input1 input2 [size mutation])
+     [(n.+ (///unsigned.value ..size/211) size)
+      (|>> mutation ((trinary/211' opcode input0 input1 input2)))])])
+
+(abstract: #export Primitive_Array_Type
+  U1
+
+  (def: code
+    (-> Primitive_Array_Type U1)
+    (|>> :representation))
+
+  (template [ ]
+    [(def: #export  (|>  ///unsigned.u1 try.assume :abstraction))]
+    
+    [04 t_boolean]
+    [05 t_char]
+    [06 t_float]
+    [07 t_double]
+    [08 t_byte]
+    [09 t_short]
+    [10 t_int]
+    [11 t_long]
+    ))
+
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5
+(with_expansions [ (template [ ]
+                                [[  [] []]]
+
+                                ["01" aconst_null]
+
+                                ["02" iconst_m1]
+                                ["03" iconst_0]
+                                ["04" iconst_1]
+                                ["05" iconst_2]
+                                ["06" iconst_3]
+                                ["07" iconst_4]
+                                ["08" iconst_5]
+
+                                ["09" lconst_0]
+                                ["0A" lconst_1]
+
+                                ["0B" fconst_0]
+                                ["0C" fconst_1]
+                                ["0D" fconst_2]
+                                
+                                ["0E" dconst_0]
+                                ["0F" dconst_1])
+                   (template [ ]
+                                     [[  [[register Register]] [register]]]
+
+                                     ["15" iload]
+                                     ["16" lload]
+                                     ["17" fload]
+                                     ["18" dload]
+                                     ["19" aload])
+                   (template [ ]
+                                            [[  [] []]]
+
+                                            ["1A" iload_0]
+                                            ["1B" iload_1]
+                                            ["1C" iload_2]
+                                            ["1D" iload_3]
+
+                                            ["1E" lload_0]
+                                            ["1F" lload_1]
+                                            ["20" lload_2]
+                                            ["21" lload_3]
+                                            
+                                            ["22" fload_0]
+                                            ["23" fload_1]
+                                            ["24" fload_2]
+                                            ["25" fload_3]
+                                            
+                                            ["26" dload_0]
+                                            ["27" dload_1]
+                                            ["28" dload_2]
+                                            ["29" dload_3]
+                                            
+                                            ["2A" aload_0]
+                                            ["2B" aload_1]
+                                            ["2C" aload_2]
+                                            ["2D" aload_3])
+                   (template [ ]
+                                      [[  [[register Register]] [register]]]
+
+                                      ["36" istore]
+                                      ["37" lstore]
+                                      ["38" fstore]
+                                      ["39" dstore]
+                                      ["3A" astore])
+                   (template [ ]
+                                             [[  [] []]]
+
+                                             ["3B" istore_0]
+                                             ["3C" istore_1]
+                                             ["3D" istore_2]
+                                             ["3E" istore_3]
+
+                                             ["3F" lstore_0]
+                                             ["40" lstore_1]
+                                             ["41" lstore_2]
+                                             ["42" lstore_3]
+
+                                             ["43" fstore_0]
+                                             ["44" fstore_1]
+                                             ["45" fstore_2]
+                                             ["46" fstore_3]
+
+                                             ["47" dstore_0]
+                                             ["48" dstore_1]
+                                             ["49" dstore_2]
+                                             ["4A" dstore_3]
+                                             
+                                             ["4B" astore_0]
+                                             ["4C" astore_1]
+                                             ["4D" astore_2]
+                                             ["4E" astore_3])
+                   (template [ ]
+                                  [[  [] []]]
+
+                                  ["2E" iaload]
+                                  ["2F" laload]
+                                  ["30" faload]
+                                  ["31" daload]
+                                  ["32" aaload]
+                                  ["33" baload]
+                                  ["34" caload]
+                                  ["35" saload])
+                   (template [ ]
+                                   [[  [] []]]
+
+                                   ["4f" iastore]
+                                   ["50" lastore]
+                                   ["51" fastore]
+                                   ["52" dastore]
+                                   ["53" aastore]
+                                   ["54" bastore]
+                                   ["55" castore]
+                                   ["56" sastore])
+                   (template [ ]
+                                 [[  [] []]]
+
+                                 ["60" iadd]
+                                 ["64" isub]
+                                 ["68" imul]
+                                 ["6c" idiv]
+                                 ["70" irem]
+                                 ["74" ineg]
+                                 ["78" ishl]
+                                 ["7a" ishr]
+                                 ["7c" iushr]
+                                 ["7e" iand]
+                                 ["80" ior]
+                                 ["82" ixor]
+
+                                 ["61" ladd]
+                                 ["65" lsub]
+                                 ["69" lmul]
+                                 ["6D" ldiv]
+                                 ["71" lrem]
+                                 ["75" lneg]
+                                 ["7F" land]
+                                 ["81" lor]
+                                 ["83" lxor]
+                                 
+                                 ["62" fadd]
+                                 ["66" fsub]
+                                 ["6A" fmul]
+                                 ["6E" fdiv]
+                                 ["72" frem]
+                                 ["76" fneg]
+                                 
+                                 ["63" dadd]
+                                 ["67" dsub]
+                                 ["6B" dmul]
+                                 ["6F" ddiv]
+                                 ["73" drem]
+                                 ["77" dneg])
+                   (template [ ]
+                                  [[  [] []]]
+
+                                  ["88" l2i]
+                                  ["89" l2f]
+                                  ["8A" l2d]
+                                  
+                                  ["8B" f2i]
+                                  ["8C" f2l]
+                                  ["8D" f2d]
+                                  
+                                  ["8E" d2i]
+                                  ["8F" d2l]
+                                  ["90" d2f]
+
+                                  ["85" i2l]
+                                  ["86" i2f]
+                                  ["87" i2d]
+                                  ["91" i2b]
+                                  ["92" i2c]
+                                  ["93" i2s])
+                   (template [ ]
+                                  [[  [] []]]
+
+                                  ["94" lcmp]
+                                  
+                                  ["95" fcmpl]
+                                  ["96" fcmpg]
+
+                                  ["97" dcmpl]
+                                  ["98" dcmpg])
+                   (template [ ]
+                              [[  [] []]]
+
+                              ["AC" ireturn]
+                              ["AD" lreturn]
+                              ["AE" freturn]
+                              ["AF" dreturn]
+                              ["B0" areturn]
+                              ["B1" return]
+                              )
+                   (template [ ]
+                            [[  [[jump Jump]] [jump]]]
+
+                            ["99" ifeq]
+                            ["9A" ifne]
+                            ["9B" iflt]
+                            ["9C" ifge]
+                            ["9D" ifgt]
+                            ["9E" ifle]
+                            
+                            ["9F" if_icmpeq]
+                            ["A0" if_icmpne]
+                            ["A1" if_icmplt]
+                            ["A2" if_icmpge]
+                            ["A3" if_icmpgt]
+                            ["A4" if_icmple]
+                            
+                            ["A5" if_acmpeq]
+                            ["A6" if_acmpne]
+                            
+                            ["A7" goto]
+                            ["A8" jsr]
+
+                            ["C6" ifnull]
+                            ["C7" ifnonnull])
+                   (template [ ]
+                             [[  [[index (Index (Reference Value))]] [(///index.value index)]]]
+
+                             ["B2" getstatic/1] ["B2" getstatic/2]
+                             ["B3" putstatic/1] ["B3" putstatic/2]
+                             ["B4" getfield/1] ["B4" getfield/2]
+                             ["B5" putfield/1] ["B5" putfield/2])]
+  (template [ ]
+    [(with_expansions [' (template.splice )]
+       (template [   ]
+         [(with_expansions [' (template.splice )
+                             (template [ ]
+                                            []
+
+                                            ')
+                             (template [ ]
+                                            []
+
+                                            ')]
+            (def: #export 
+              [Estimator (-> [] Instruction)]
+              (let [[estimator '] ]
+                [estimator
+                 (function (_ [])
+                   (`` (' (hex ) (~~ (template.splice )))))])))]
+
+         '
+         ))]
+
+    [..nullary
+     [["00" nop [] []]
+      
+      ["57" pop [] []]
+      ["58" pop2 [] []]
+      ["59" dup [] []]
+      ["5A" dup_x1 [] []]
+      ["5B" dup_x2 [] []]
+      ["5C" dup2 [] []]
+      ["5D" dup2_x1 [] []]
+      ["5E" dup2_x2 [] []]
+      ["5F" swap [] []]
+      
+      
+      
+      
+      
+      ["79" lshl [] []]
+      ["7B" lshr [] []]
+      ["7D" lushr [] []]
+      
+      
+      
+      ["BE" arraylength [] []]
+      ["BF" athrow [] []]
+      ["C2" monitorenter [] []]
+      ["C3" monitorexit [] []]]]
+
+    [..unary/1
+     [["12" ldc [[index U1]] [index]]
+      
+      
+      ["A9" ret [[register Register]] [register]]
+      ["BC" newarray [[type Primitive_Array_Type]] [(..code type)]]]]
+
+    [..unary/1'
+     [["10" bipush  [[byte S1]] [byte]]]]
+
+    [..unary/2
+     [["13" ldc_w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]]
+      ["13" ldc_w/float [[index (Index ///constant.Float)]] [(///index.value index)]]
+      ["13" ldc_w/string [[index (Index ///constant.String)]] [(///index.value index)]]
+      ["14" ldc2_w/long [[index (Index ///constant.Long)]] [(///index.value index)]]
+      ["14" ldc2_w/double [[index (Index ///constant.Double)]] [(///index.value index)]]
+      
+      ["BB" new [[index (Index Class)]] [(///index.value index)]]
+      ["BD" anewarray [[index (Index Class)]] [(///index.value index)]]
+      ["C0" checkcast [[index (Index Class)]] [(///index.value index)]]
+      ["C1" instanceof [[index (Index Class)]] [(///index.value index)]]
+      ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]
+      ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]
+      ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]]]
+
+    [..unary/2'
+     [["11" sipush  [[short S2]] [short]]]]
+
+    [..jump/2
+     []]
+
+    [..jump/4
+     [["C8" goto_w [[jump Big_Jump]] [jump]]
+      ["C9" jsr_w [[jump Big_Jump]] [jump]]]]
+
+    [..binary/11
+     [["84" iinc [[register Register] [byte U1]] [register byte]]]]
+
+    [..binary/21
+     [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.value index) count]]]]
+
+    [..trinary/211
+     [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]]
+    ))
+
+(def: (switch_padding offset)
+  (-> Nat Nat)
+  (let [parameter_start (n.+ (///unsigned.value ..opcode_size)
+                             offset)]
+    (n.% 4
+         (n.- (n.% 4 parameter_start)
+              4))))
+
+(def: #export tableswitch
+  [(-> Nat Estimator)
+   (-> S4 Big_Jump [Big_Jump (List Big_Jump)] Instruction)]
+  (let [estimator (: (-> Nat Estimator)
+                     (function (_ amount_of_afterwards offset)
+                       (|> ($_ n.+
+                               (///unsigned.value ..opcode_size)
+                               (switch_padding (///unsigned.value (//address.value offset)))
+                               (///unsigned.value ..big_jump_size)
+                               (///unsigned.value ..integer_size)
+                               (///unsigned.value ..integer_size)
+                               (n.* (///unsigned.value ..big_jump_size)
+                                    (inc amount_of_afterwards)))
+                           ///unsigned.u2
+                           try.assume)))]
+    [estimator
+     (function (_ minimum default [at_minimum afterwards])
+       (let [amount_of_afterwards (list.size afterwards)
+             estimator (estimator amount_of_afterwards)]
+         (function (_ [size mutation])
+           (let [padding (switch_padding size)
+                 tableswitch_size (try.assume
+                                   (do {! try.monad}
+                                     [size (///unsigned.u2 size)]
+                                     (\ ! map (|>> estimator ///unsigned.value)
+                                        (//address.move size //address.start))))
+                 tableswitch_mutation (: Mutation
+                                         (function (_ [offset binary])
+                                           [(n.+ tableswitch_size offset)
+                                            (try.assume
+                                             (do {! try.monad}
+                                               [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4)
+                                                maximum (///signed.+/4 minimum amount_of_afterwards)
+                                                _ (binary.write/8 offset (hex "AA") binary)
+                                                #let [offset (n.+ (///unsigned.value ..opcode_size) offset)]
+                                                _ (case padding
+                                                    3 (do !
+                                                        [_ (binary.write/8 offset 0 binary)]
+                                                        (binary.write/16 (inc offset) 0 binary))
+                                                    2 (binary.write/16 offset 0 binary)
+                                                    1 (binary.write/8 offset 0 binary)
+                                                    _ (wrap binary))
+                                                #let [offset (n.+ padding offset)]
+                                                _ (binary.write/32 offset (///signed.value default) binary)
+                                                #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)]
+                                                _ (binary.write/32 offset (///signed.value minimum) binary)
+                                                #let [offset (n.+ (///unsigned.value ..integer_size) offset)]
+                                                _ (binary.write/32 offset (///signed.value maximum) binary)]
+                                               (loop [offset (n.+ (///unsigned.value ..integer_size) offset)
+                                                      afterwards (: (List Big_Jump)
+                                                                    (#.Cons at_minimum afterwards))]
+                                                 (case afterwards
+                                                   #.Nil
+                                                   (wrap binary)
+                                                   
+                                                   (#.Cons head tail)
+                                                   (do !
+                                                     [_ (binary.write/32 offset (///signed.value head) binary)]
+                                                     (recur (n.+ (///unsigned.value ..big_jump_size) offset)
+                                                            tail))))))]))]
+             [(n.+ tableswitch_size
+                   size)
+              (|>> mutation tableswitch_mutation)]))))]))
+
+(def: #export lookupswitch
+  [(-> Nat Estimator)
+   (-> Big_Jump (List [S4 Big_Jump]) Instruction)]
+  (let [case_size (n.+ (///unsigned.value ..integer_size)
+                       (///unsigned.value ..big_jump_size))
+        estimator (: (-> Nat Estimator)
+                     (function (_ amount_of_cases offset)
+                       (|> ($_ n.+
+                               (///unsigned.value ..opcode_size)
+                               (switch_padding (///unsigned.value (//address.value offset)))
+                               (///unsigned.value ..big_jump_size)
+                               (///unsigned.value ..integer_size)
+                               (n.* amount_of_cases case_size))
+                           ///unsigned.u2
+                           try.assume)))]
+    [estimator
+     (function (_ default cases)
+       (let [amount_of_cases (list.size cases)
+             estimator (estimator amount_of_cases)]
+         (function (_ [size mutation])
+           (let [padding (switch_padding size)
+                 lookupswitch_size (try.assume
+                                    (do {! try.monad}
+                                      [size (///unsigned.u2 size)]
+                                      (\ ! map (|>> estimator ///unsigned.value)
+                                         (//address.move size //address.start))))
+                 lookupswitch_mutation (: Mutation
+                                          (function (_ [offset binary])
+                                            [(n.+ lookupswitch_size offset)
+                                             (try.assume
+                                              (do {! try.monad}
+                                                [_ (binary.write/8 offset (hex "AB") binary)
+                                                 #let [offset (n.+ (///unsigned.value ..opcode_size) offset)]
+                                                 _ (case padding
+                                                     3 (do !
+                                                         [_ (binary.write/8 offset 0 binary)]
+                                                         (binary.write/16 (inc offset) 0 binary))
+                                                     2 (binary.write/16 offset 0 binary)
+                                                     1 (binary.write/8 offset 0 binary)
+                                                     _ (wrap binary))
+                                                 #let [offset (n.+ padding offset)]
+                                                 _ (binary.write/32 offset (///signed.value default) binary)
+                                                 #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)]
+                                                 _ (binary.write/32 offset amount_of_cases binary)]
+                                                (loop [offset (n.+ (///unsigned.value ..integer_size) offset)
+                                                       cases cases]
+                                                  (case cases
+                                                    #.Nil
+                                                    (wrap binary)
+                                                    
+                                                    (#.Cons [value jump] tail)
+                                                    (do !
+                                                      [_ (binary.write/32 offset (///signed.value value) binary)
+                                                       _ (binary.write/32 (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)]
+                                                      (recur (n.+ case_size offset)
+                                                             tail))))))]))]
+             [(n.+ lookupswitch_size
+                   size)
+              (|>> mutation lookupswitch_mutation)]))))]))
+
+(implementation: #export monoid
+  (Monoid Instruction)
+
+  (def: identity ..empty)
+
+  (def: (compose left right)
+    (|>> left right)))
diff --git a/stdlib/source/library/lux/target/jvm/bytecode/jump.lux b/stdlib/source/library/lux/target/jvm/bytecode/jump.lux
new file mode 100644
index 000000000..2873ef781
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/bytecode/jump.lux
@@ -0,0 +1,27 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [data
+     ["." format #_
+      ["#" binary (#+ Writer)]]]]]
+  ["." /// #_
+   [encoding
+    ["#." signed (#+ S2 S4)]]])
+
+(type: #export Jump S2)
+
+(def: #export equivalence
+  (Equivalence Jump)
+  ///signed.equivalence)
+
+(def: #export writer
+  (Writer Jump)
+  ///signed.writer/2)
+
+(type: #export Big_Jump S4)
+
+(def: #export lift
+  (-> Jump Big_Jump)
+  ///signed.lift/4)
diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux
new file mode 100644
index 000000000..7f6705de8
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/class.lux
@@ -0,0 +1,134 @@
+ (.module:
+   [library
+    [lux #*
+     [abstract
+      [equivalence (#+ Equivalence)]
+      ["." monad (#+ do)]]
+     [control
+      ["." state]
+      ["." try (#+ Try)]]
+     [data
+      ["." product]
+      [format
+       [".F" binary (#+ Writer) ("#\." monoid)]]
+      [collection
+       ["." row (#+ Row)]]]]]
+  ["." // #_
+   ["#." modifier (#+ Modifier modifiers:)]
+   ["#." version (#+ Version Minor Major)]
+   ["#." magic (#+ Magic)]
+   ["#." index (#+ Index)]
+   ["#." attribute (#+ Attribute)]
+   ["#." field (#+ Field)]
+   ["#." method (#+ Method)]
+   [encoding
+    ["#." unsigned]
+    ["#." name (#+ Internal)]]
+   ["#." constant (#+ Constant)
+    ["#/." pool (#+ Pool Resource)]]])
+
+(type: #export #rec Class
+  {#magic Magic
+   #minor_version Minor
+   #major_version Major
+   #constant_pool Pool
+   #modifier (Modifier Class)
+   #this (Index //constant.Class)
+   #super (Index //constant.Class)
+   #interfaces (Row (Index //constant.Class))
+   #fields (Row Field)
+   #methods (Row Method)
+   #attributes (Row Attribute)})
+
+(modifiers: Class
+  ["0001" public]
+  ["0010" final]
+  ["0020" super]
+  ["0200" interface]
+  ["0400" abstract]
+  ["1000" synthetic]
+  ["2000" annotation]
+  ["4000" enum]
+  )
+
+(def: #export equivalence
+  (Equivalence Class)
+  ($_ product.equivalence
+      //unsigned.equivalence
+      //unsigned.equivalence
+      //unsigned.equivalence
+      //constant/pool.equivalence
+      //modifier.equivalence
+      //index.equivalence
+      //index.equivalence
+      (row.equivalence //index.equivalence)
+      (row.equivalence //field.equivalence)
+      (row.equivalence //method.equivalence)
+      (row.equivalence //attribute.equivalence)))
+
+(def: (install_classes this super interfaces)
+  (-> Internal Internal (List Internal)
+      (Resource [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))]))
+  (do {! //constant/pool.monad}
+    [@this (//constant/pool.class this)
+     @super (//constant/pool.class super)
+     @interfaces (: (Resource (Row (Index //constant.Class)))
+                    (monad.fold ! (function (_ interface @interfaces)
+                                    (do !
+                                      [@interface (//constant/pool.class interface)]
+                                      (wrap (row.add @interface @interfaces))))
+                                row.empty
+                                interfaces))]
+    (wrap [@this @super @interfaces])))
+
+(def: #export (class version modifier
+                     this super interfaces
+                     fields methods attributes)
+  (-> Major (Modifier Class)
+      Internal Internal (List Internal)
+      (List (Resource Field))
+      (List (Resource Method))
+      (Row Attribute)
+      (Try Class))
+  (do try.monad
+    [[pool [@this @super @interfaces] =fields =methods]
+     (<| (state.run' //constant/pool.empty)
+         (do //constant/pool.monad
+           [classes (install_classes this super interfaces)
+            =fields (monad.seq //constant/pool.monad fields)
+            =methods (monad.seq //constant/pool.monad methods)]
+           (wrap [classes =fields =methods])))]
+    (wrap {#magic //magic.code
+           #minor_version //version.default_minor
+           #major_version version
+           #constant_pool pool
+           #modifier modifier
+           #this @this
+           #super @super
+           #interfaces @interfaces
+           #fields (row.from_list =fields)
+           #methods (row.from_list =methods)
+           #attributes attributes})))
+
+(def: #export (writer class)
+  (Writer Class)
+  (`` ($_ binaryF\compose
+          (~~ (template [ ]
+                [( (get@  class))]
+
+                [//magic.writer #magic]
+                [//version.writer #minor_version]
+                [//version.writer #major_version]
+                [//constant/pool.writer #constant_pool]
+                [//modifier.writer #modifier]
+                [//index.writer #this]
+                [//index.writer #super]))
+          (~~ (template [ ]
+                [((binaryF.row/16 ) (get@  class))]
+
+                [//index.writer #interfaces]
+                [//field.writer #fields]
+                [//method.writer #methods]
+                [//attribute.writer #attributes]
+                ))
+          )))
diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux
new file mode 100644
index 000000000..663dc472f
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/constant.lux
@@ -0,0 +1,246 @@
+(.module:
+  [library
+   [lux #*
+    ["." ffi (#+ import:)]
+    ["@" target]
+    [abstract
+     [monad (#+ do)]
+     ["." equivalence (#+ Equivalence)]]
+    [data
+     ["." sum]
+     ["." product]
+     ["." text]
+     [format
+      [".F" binary (#+ Writer) ("#\." monoid)]]
+     [collection
+      ["." row (#+ Row)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["." i32 (#+ I32)]
+      ["." i64]
+      ["." int]
+      ["." frac]]]
+    [type
+     abstract]]]
+  ["." / #_
+   ["#." tag]
+   ["/#" // #_
+    ["#." index (#+ Index)]
+    [type
+     ["#." category]
+     ["#." descriptor (#+ Descriptor)]]
+    [encoding
+     ["#." unsigned]]]])
+
+(type: #export UTF8 Text)
+
+(def: utf8_writer
+  (Writer UTF8)
+  binaryF.utf8/16)
+
+(abstract: #export Class
+  (Index UTF8)
+
+  (def: #export index
+    (-> Class (Index UTF8))
+    (|>> :representation))
+  
+  (def: #export class
+    (-> (Index UTF8) Class)
+    (|>> :abstraction))
+
+  (def: #export class_equivalence
+    (Equivalence Class)
+    (\ equivalence.functor map
+       ..index
+       //index.equivalence))
+
+  (def: class_writer
+    (Writer Class)
+    (|>> :representation //index.writer))
+  )
+
+(import: java/lang/Float
+  ["#::."
+   (#static floatToRawIntBits #manual [float] int)])
+
+(implementation: #export float_equivalence
+  (Equivalence java/lang/Float)
+
+  (def: (= parameter subject)
+    (for {@.old
+          ("jvm feq" parameter subject)
+          
+          @.jvm
+          ("jvm float ="
+           ("jvm object cast" parameter)
+           ("jvm object cast" subject))})))
+
+(import: java/lang/Double
+  ["#::."
+   (#static doubleToRawLongBits [double] long)])
+
+(abstract: #export (Value kind)
+  kind
+
+  (def: #export value
+    (All [kind] (-> (Value kind) kind))
+    (|>> :representation))
+
+  (def: #export (value_equivalence Equivalence)
+    (All [kind]
+      (-> (Equivalence kind)
+          (Equivalence (Value kind))))
+    (\ equivalence.functor map
+       (|>> :representation)
+       Equivalence))
+
+  (template [  ]
+    [(type: #export  (Value ))
+
+     (def: #export 
+       (->  )
+       (|>> :abstraction))]
+
+    [integer Integer I32]
+    [float   Float   java/lang/Float]
+    [long    Long    .Int]
+    [double  Double  Frac]
+    [string  String  (Index UTF8)]
+    )
+
+  (template [   ]
+    [(def: 
+       (Writer )
+       (`` (|>> :representation
+                (~~ (template.splice ))
+                (~~ (template.splice )))))]
+
+    [integer_writer Integer [] [binaryF.bits/32]]
+    [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]]
+    [long_writer Long [] [binaryF.bits/64]]
+    [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]]
+    [string_writer String [] [//index.writer]]
+    )
+  )
+
+(type: #export (Name_And_Type of)
+  {#name (Index UTF8)
+   #descriptor (Index (Descriptor of))})
+
+(type: #export (Reference of)
+  {#class (Index Class)
+   #name_and_type (Index (Name_And_Type of))})
+
+(template [  ]
+  [(def: #export 
+     (Equivalence ( Any))
+     ($_ product.equivalence
+         //index.equivalence
+         //index.equivalence))
+
+   (def: 
+     (Writer ( Any))
+     ($_ binaryF.and
+         //index.writer
+         //index.writer))]
+
+  [Name_And_Type name_and_type_equivalence name_and_type_writer]
+  [Reference reference_equivalence reference_writer]
+  )
+
+(type: #export Constant
+  (#UTF8 UTF8)
+  (#Integer Integer)
+  (#Float Float)
+  (#Long Long)
+  (#Double Double)
+  (#Class Class)
+  (#String String)
+  (#Field (Reference //category.Value))
+  (#Method (Reference //category.Method))
+  (#Interface_Method (Reference //category.Method))
+  (#Name_And_Type (Name_And_Type Any)))
+
+(def: #export (size constant)
+  (-> Constant Nat)
+  (case constant
+    (^or (#Long _) (#Double _))
+    2
+
+    _
+    1))
+
+(def: #export equivalence
+  (Equivalence Constant)
+  ## TODO: Delete the explicit "implementation" and use the combinator
+  ## version below as soon as the new format for variants is implemented.
+  (implementation
+   (def: (= reference sample)
+     (case [reference sample]
+       (^template [ ]
+         [[( reference) ( sample)]
+          (\  = reference sample)])
+       ([#UTF8 text.equivalence]
+        [#Integer (..value_equivalence i32.equivalence)]
+        [#Long (..value_equivalence int.equivalence)]
+        [#Float (..value_equivalence float_equivalence)]
+        [#Double (..value_equivalence frac.equivalence)]
+        [#Class ..class_equivalence]
+        [#String (..value_equivalence //index.equivalence)]
+        [#Field ..reference_equivalence]
+        [#Method ..reference_equivalence]
+        [#Interface_Method ..reference_equivalence]
+        [#Name_And_Type ..name_and_type_equivalence])
+       
+       _
+       false)))
+  ## ($_ sum.equivalence
+  ##     ## #UTF8
+  ##     text.equivalence
+  ##     ## #Long
+  ##     (..value_equivalence int.equivalence)
+  ##     ## #Double
+  ##     (..value_equivalence frac.equivalence)
+  ##     ## #Class
+  ##     ..class_equivalence
+  ##     ## #String
+  ##     (..value_equivalence //index.equivalence)
+  ##     ## #Field
+  ##     ..reference_equivalence
+  ##     ## #Method
+  ##     ..reference_equivalence
+  ##     ## #Interface_Method
+  ##     ..reference_equivalence
+  ##     ## #Name_And_Type
+  ##     ..name_and_type_equivalence
+  ##     )
+  )
+
+(def: #export writer
+  (Writer Constant)
+  (with_expansions [ (as_is [#UTF8             /tag.utf8             ..utf8_writer]
+                                       [#Integer          /tag.integer          ..integer_writer]
+                                       [#Float            /tag.float            ..float_writer]
+                                       [#Long             /tag.long             ..long_writer]
+                                       [#Double           /tag.double           ..double_writer]
+                                       [#Class            /tag.class            ..class_writer]
+                                       [#String           /tag.string           ..string_writer]
+                                       [#Field            /tag.field            ..reference_writer]
+                                       [#Method           /tag.method           ..reference_writer]
+                                       [#Interface_Method /tag.interface_method ..reference_writer]
+                                       [#Name_And_Type    /tag.name_and_type    ..name_and_type_writer]
+                                       ## TODO: Method_Handle
+                                       ## TODO: Method_Type
+                                       ## TODO: Invoke_Dynamic
+                                       )]
+    (function (_ value)
+      (case value
+        (^template [  ]
+          [( value)
+           (binaryF\compose (/tag.writer )
+                            ( value))])
+        ()
+        ))))
diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux
new file mode 100644
index 000000000..e7fa465d8
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux
@@ -0,0 +1,158 @@
+(.module:
+  [library
+   [lux #*
+    ["." ffi]
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [monad (#+ Monad do)]]
+    [control
+     ["." state (#+ State')]
+     ["." try (#+ Try)]]
+    [data
+     ["." product]
+     ["." text]
+     ["." format #_
+      ["#" binary (#+ Writer) ("specification\." monoid)]]
+     [collection
+      ["." row (#+ Row) ("#\." fold)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["." i32]
+      ["n" nat]
+      ["." int]
+      ["." frac]]]
+    [type
+     abstract]]]
+  ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference)
+   [//
+    [encoding
+     ["#." name (#+ Internal External)]
+     ["#." unsigned]]
+    ["#." index (#+ Index)]
+    [type
+     [category (#+ Value Method)]
+     ["#." descriptor (#+ Descriptor)]]]])
+
+(type: #export Pool [Index (Row [Index Constant])])
+
+(def: #export equivalence
+  (Equivalence Pool)
+  (product.equivalence //index.equivalence
+                       (row.equivalence (product.equivalence //index.equivalence
+                                                             //.equivalence))))
+
+(type: #export (Resource a)
+  (State' Try Pool a))
+
+(def: #export monad
+  (Monad Resource)
+  (state.with try.monad))
+
+(template: (!add   )
+  (function (_ [current pool])
+    (let [' ]
+      (with_expansions [ (as_is (recur (.inc idx)))]
+        (loop [idx 0]
+          (case (row.nth idx pool)
+            (#try.Success entry)
+            (case entry
+              [index ( reference)]
+              (if (\  = reference ')
+                (#try.Success [[current pool]
+                               index])
+                )
+              
+              _
+              )
+            
+            (#try.Failure _)
+            (let [new ( ')]
+              (do {! try.monad}
+                [@new (//unsigned.u2 (//.size new))
+                 next (: (Try Index)
+                         (|> current
+                             //index.value
+                             (//unsigned.+/2 @new)
+                             (\ ! map //index.index)))]
+                (wrap [[next
+                        (row.add [current new] pool)]
+                       current])))))))))
+
+(template: (!index )
+  (|>  //index.value //unsigned.value))
+
+(type: (Adder of)
+  (-> of (Resource (Index of))))
+
+(template [   ]
+  [(def: #export ( value)
+     (Adder )
+     (!add   value))]
+
+  [integer Integer #//.Integer (//.value_equivalence i32.equivalence)]
+  [float Float #//.Float (//.value_equivalence //.float_equivalence)]
+  [long Long #//.Long (//.value_equivalence int.equivalence)]
+  [double Double #//.Double (//.value_equivalence frac.equivalence)]
+  [utf8 UTF8 #//.UTF8 text.equivalence]
+  )
+
+(def: #export (string value)
+  (-> Text (Resource (Index String)))
+  (do ..monad
+    [@value (utf8 value)
+     #let [value (//.string @value)]]
+    (!add #//.String (//.value_equivalence //index.equivalence) value)))
+
+(def: #export (class name)
+  (-> Internal (Resource (Index Class)))
+  (do ..monad
+    [@name (utf8 (//name.read name))
+     #let [value (//.class @name)]]
+    (!add #//.Class //.class_equivalence value)))
+
+(def: #export (descriptor value)
+  (All [kind]
+    (-> (Descriptor kind)
+        (Resource (Index (Descriptor kind)))))
+  (let [value (//descriptor.descriptor value)]
+    (!add #//.UTF8 text.equivalence value)))
+
+(type: #export (Member of)
+  {#name UTF8
+   #descriptor (Descriptor of)})
+
+(def: #export (name_and_type [name descriptor])
+  (All [of]
+    (-> (Member of) (Resource (Index (Name_And_Type of)))))
+  (do ..monad
+    [@name (utf8 name)
+     @descriptor (..descriptor descriptor)]
+    (!add #//.Name_And_Type //.name_and_type_equivalence {#//.name @name #//.descriptor @descriptor})))
+
+(template [  ]
+  [(def: #export ( class member)
+     (-> External (Member ) (Resource (Index (Reference ))))
+     (do ..monad
+       [@class (..class (//name.internal class))
+        @name_and_type (name_and_type member)]
+       (!add  //.reference_equivalence {#//.class @class #//.name_and_type @name_and_type})))]
+
+  [field #//.Field Value]
+  [method #//.Method Method]
+  [interface_method #//.Interface_Method Method]
+  )
+
+(def: #export writer
+  (Writer Pool)
+  (function (_ [next pool])
+    (row\fold (function (_ [_index post] pre)
+                (specification\compose pre (//.writer post)))
+              (format.bits/16 (!index next))
+              pool)))
+
+(def: #export empty
+  Pool
+  [(|> 1 //unsigned.u2 try.assume //index.index)
+   row.empty])
diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux
new file mode 100644
index 000000000..414de077b
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux
@@ -0,0 +1,50 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [equivalence (#+ Equivalence)]]
+    [control
+     ["." try]]
+    [data
+     [format
+      [binary (#+ Writer)]]]
+    [type
+     abstract]]]
+  ["." /// #_
+   [encoding
+    ["#." unsigned (#+ U1) ("u1//." equivalence)]]])
+
+(abstract: #export Tag
+  U1
+
+  (implementation: #export equivalence
+    (Equivalence Tag)
+    (def: (= reference sample)
+      (u1//= (:representation reference)
+             (:representation sample))))
+
+  (template [ ]
+    [(def: #export 
+       Tag
+       (|>  ///unsigned.u1 try.assume :abstraction))]
+
+    [01 utf8]
+    [03 integer]
+    [04 float]
+    [05 long]
+    [06 double]
+    [07 class]
+    [08 string]
+    [09 field]
+    [10 method]
+    [11 interface_method]
+    [12 name_and_type]
+    [15 method_handle]
+    [16 method_type]
+    [18 invoke_dynamic]
+    )
+
+  (def: #export writer
+    (Writer Tag)
+    (|>> :representation ///unsigned.writer/1))
+  )
diff --git a/stdlib/source/library/lux/target/jvm/encoding/name.lux b/stdlib/source/library/lux/target/jvm/encoding/name.lux
new file mode 100644
index 000000000..5a1982d3e
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/encoding/name.lux
@@ -0,0 +1,40 @@
+(.module:
+  [library
+   [lux #*
+    [data
+     ["." text
+      ["%" format (#+ format)]]]
+    [type
+     abstract]]])
+
+(def: #export internal_separator "/")
+(def: #export external_separator ".")
+
+(type: #export External Text)
+
+(abstract: #export Internal
+  Text
+
+  (def: #export internal
+    (-> External Internal)
+    (|>> (text.replace_all ..external_separator
+                           ..internal_separator)
+         :abstraction))
+
+  (def: #export read
+    (-> Internal Text)
+    (|>> :representation))
+
+  (def: #export external
+    (-> Internal External)
+    (|>> :representation
+         (text.replace_all ..internal_separator
+                           ..external_separator))))
+
+(def: #export sanitize
+  (-> Text External)
+  (|>> ..internal ..external))
+
+(def: #export (qualify package class)
+  (-> Text External External)
+  (format (..sanitize package) ..external_separator class))
diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux
new file mode 100644
index 000000000..a914dfc3c
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux
@@ -0,0 +1,107 @@
+(.module:
+  [library
+   [lux (#- int)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]]
+    [data
+     [text
+      ["%" format (#+ format)]]
+     ["." format #_
+      ["#" binary (#+ Writer)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["." i64]
+      ["n" nat]
+      ["i" int]]]
+    [type
+     abstract]]])
+
+(abstract: #export (Signed brand)
+  Int
+
+  (def: #export value
+    (-> (Signed Any) Int)
+    (|>> :representation))
+
+  (implementation: #export equivalence
+    (All [brand] (Equivalence (Signed brand)))
+    (def: (= reference sample)
+      (i.= (:representation reference) (:representation sample))))
+
+  (implementation: #export order
+    (All [brand] (Order (Signed brand)))
+    
+    (def: &equivalence ..equivalence)
+    (def: (< reference sample)
+      (i.< (:representation reference) (:representation sample))))
+
+  (exception: #export (value_exceeds_the_scope {value Int}
+                                               {scope Nat})
+    (exception.report
+     ["Value" (%.int value)]
+     ["Scope (in bytes)" (%.nat scope)]))
+
+  (template [     <+> <->]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (abstract: #export  Any)
+       (type: #export  (Signed )))
+
+     (def: #export  )
+     
+     (def: #export 
+       
+       (|>  (n.* i64.bits_per_byte) dec i64.mask :abstraction))
+     
+     (def: #export 
+       (-> Int (Try ))
+       (let [positive (|>  (n.* i64.bits_per_byte) i64.mask)
+             negative (|> positive .int (i.right_shift 1) i64.not)]
+         (function (_ value)
+           (if (i.= (if (i.< +0 value)
+                      (i64.or negative value)
+                      (i64.and positive value))
+                    value)
+             (#try.Success (:abstraction value))
+             (exception.throw ..value_exceeds_the_scope [value ])))))
+
+     (template [ ]
+       [(def: #export ( parameter subject)
+          (->   (Try ))
+          (
+           ( (:representation parameter)
+                                 (:representation subject))))]
+
+       [<+> i.+]
+       [<-> i.-]
+       )]
+
+    [1 S1 bytes/1 s1 maximum/1 +/1 -/1]
+    [2 S2 bytes/2 s2 maximum/2 +/2 -/2]
+    [4 S4 bytes/4 s4 maximum/4 +/4 -/4]
+    )
+
+  (template [  ]
+    [(def: #export 
+       (->  )
+       (|>> :transmutation))]
+
+    [lift/2 S1 S2]
+    [lift/4 S2 S4]
+    )
+
+  (template [  ]
+    [(def: #export 
+       (Writer )
+       (|>> :representation ))]
+
+    [writer/1 S1 format.bits/8]
+    [writer/2 S2 format.bits/16]
+    [writer/4 S4 format.bits/32]
+    )
+  )
diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux
new file mode 100644
index 000000000..d8299fa65
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux
@@ -0,0 +1,121 @@
+(.module:
+  [library
+   [lux (#- nat)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]]
+    [data
+     [text
+      ["%" format (#+ format)]]
+     ["." format #_
+      ["#" binary (#+ Writer)]]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["n" nat]
+      ["." i64]]]
+    [type
+     abstract]]])
+
+(abstract: #export (Unsigned brand)
+  Nat
+
+  (def: #export value
+    (-> (Unsigned Any) Nat)
+    (|>> :representation))
+
+  (implementation: #export equivalence
+    (All [brand] (Equivalence (Unsigned brand)))
+    (def: (= reference sample)
+      (n.= (:representation reference)
+           (:representation sample))))
+
+  (implementation: #export order
+    (All [brand] (Order (Unsigned brand)))
+    
+    (def: &equivalence ..equivalence)
+    (def: (< reference sample)
+      (n.< (:representation reference)
+           (:representation sample))))
+
+  (exception: #export (value_exceeds_the_maximum {type Name}
+                                                 {value Nat}
+                                                 {maximum (Unsigned Any)})
+    (exception.report
+     ["Type" (%.name type)]
+     ["Value" (%.nat value)]
+     ["Maximum" (%.nat (:representation maximum))]))
+
+  (exception: #export [brand] (subtraction_cannot_yield_negative_value
+                               {type Name}
+                               {parameter (Unsigned brand)}
+                               {subject (Unsigned brand)})
+    (exception.report
+     ["Type" (%.name type)]
+     ["Parameter" (%.nat (:representation parameter))]
+     ["Subject" (%.nat (:representation subject))]))
+
+  (template [     <+> <-> ]
+    [(with_expansions [ (template.identifier [ "'"])]
+       (abstract: #export  Any)
+       (type: #export  (Unsigned )))
+
+     (def: #export  )
+     
+     (def: #export 
+       
+       (|>  (n.* i64.bits_per_byte) i64.mask :abstraction))
+     
+     (def: #export ( value)
+       (-> Nat (Try ))
+       (if (n.<= (:representation ) value)
+         (#try.Success (:abstraction value))
+         (exception.throw ..value_exceeds_the_maximum [(name_of ) value ])))
+
+     (def: #export (<+> parameter subject)
+       (->   (Try ))
+       (
+        (n.+ (:representation parameter)
+             (:representation subject))))
+
+     (def: #export (<-> parameter subject)
+       (->   (Try ))
+       (let [parameter' (:representation parameter)
+             subject' (:representation subject)]
+         (if (n.<= subject' parameter')
+           (#try.Success (:abstraction (n.- parameter' subject')))
+           (exception.throw ..subtraction_cannot_yield_negative_value [(name_of ) parameter subject]))))
+
+     (def: #export ( left right)
+       (->   )
+       (:abstraction (n.max (:representation left)
+                            (:representation right))))]
+
+    [1 U1 bytes/1 u1 maximum/1 +/1 -/1 max/1]
+    [2 U2 bytes/2 u2 maximum/2 +/2 -/2 max/2]
+    [4 U4 bytes/4 u4 maximum/4 +/4 -/4 max/4]
+    )
+
+  (template [  ]
+    [(def: #export 
+       (->  )
+       (|>> :transmutation))]
+
+    [lift/2 U1 U2]
+    [lift/4 U2 U4]
+    )
+
+  (template [  ]
+    [(def: #export 
+       (Writer )
+       (|>> :representation ))]
+
+    [writer/1 U1 format.bits/8]
+    [writer/2 U2 format.bits/16]
+    [writer/4 U4 format.bits/32]
+    )
+  )
diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux
new file mode 100644
index 000000000..aa71794a5
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/field.lux
@@ -0,0 +1,70 @@
+(.module:
+  [library
+   [lux (#- Type static)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     ["." monad (#+ do)]]
+    [data
+     ["." product]
+     [format
+      [".F" binary (#+ Writer) ("#\." monoid)]]
+     [collection
+      ["." row (#+ Row)]]]]]
+  ["." // #_
+   ["." modifier (#+ Modifier modifiers:)]
+   ["#." constant (#+ UTF8)
+    ["#/." pool (#+ Pool Resource)]]
+   ["#." index (#+ Index)]
+   ["#." attribute (#+ Attribute)]
+   ["#." type (#+ Type)
+    [category (#+ Value)]
+    [descriptor (#+ Descriptor)]]])
+
+(type: #export #rec Field
+  {#modifier (Modifier Field)
+   #name (Index UTF8)
+   #descriptor (Index (Descriptor Value))
+   #attributes (Row Attribute)})
+
+(modifiers: Field
+  ["0001" public]
+  ["0002" private]
+  ["0004" protected]
+  ["0008" static]
+  ["0010" final]
+  ["0040" volatile]
+  ["0080" transient]
+  ["1000" synthetic]
+  ["4000" enum]
+  )
+
+(def: #export equivalence
+  (Equivalence Field)
+  ($_ product.equivalence
+      modifier.equivalence
+      //index.equivalence
+      //index.equivalence
+      (row.equivalence //attribute.equivalence)))
+
+(def: #export (writer field)
+  (Writer Field)
+  (`` ($_ binaryF\compose
+          (~~ (template [ ]
+                [( (get@  field))]
+
+                [modifier.writer #modifier]
+                [//index.writer #name]
+                [//index.writer #descriptor]
+                [(binaryF.row/16 //attribute.writer) #attributes]))
+          )))
+
+(def: #export (field modifier name type attributes)
+  (-> (Modifier Field) UTF8 (Type Value) (Row Attribute)
+      (Resource Field))
+  (do //constant/pool.monad
+    [@name (//constant/pool.utf8 name)
+     @descriptor (//constant/pool.descriptor (//type.descriptor type))]
+    (wrap {#modifier modifier
+           #name @name
+           #descriptor @descriptor
+           #attributes attributes})))
diff --git a/stdlib/source/library/lux/target/jvm/index.lux b/stdlib/source/library/lux/target/jvm/index.lux
new file mode 100644
index 000000000..851d6903f
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/index.lux
@@ -0,0 +1,38 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." equivalence (#+ Equivalence)]]
+    [data
+     [format
+      [binary (#+ Writer)]]]
+    [type
+     abstract]]]
+  ["." // #_
+   [encoding
+    ["#." unsigned (#+ U2)]]])
+
+(def: #export length
+  //unsigned.bytes/2)
+
+(abstract: #export (Index kind)
+  U2
+
+  (def: #export index
+    (All [kind] (-> U2 (Index kind)))
+    (|>> :abstraction))
+
+  (def: #export value
+    (-> (Index Any) U2)
+    (|>> :representation))
+
+  (def: #export equivalence
+    (All [kind] (Equivalence (Index kind)))
+    (\ equivalence.functor map
+       ..value
+       //unsigned.equivalence))
+
+  (def: #export writer
+    (All [kind] (Writer (Index kind)))
+    (|>> :representation //unsigned.writer/2))
+  )
diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux
new file mode 100644
index 000000000..8b86321ca
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/loader.lux
@@ -0,0 +1,143 @@
+(.module:
+  [library
+   [lux #*
+    ["@" target]
+    [abstract
+     [monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     ["." io (#+ IO)]
+     [concurrency
+      ["." atom (#+ Atom)]]]
+    [data
+     ["." binary (#+ Binary)]
+     ["." text
+      ["%" format (#+ format)]]
+     [collection
+      ["." array]
+      ["." dictionary (#+ Dictionary)]]]
+    ["." ffi (#+ import: object do_to)]]])
+
+(type: #export Library
+  (Atom (Dictionary Text Binary)))
+
+(exception: #export (already_stored {class Text})
+  (exception.report
+   ["Class" class]))
+
+(exception: #export (unknown {class Text} {known_classes (List Text)})
+  (exception.report
+   ["Class" class]
+   ["Known classes" (exception.enumerate (|>>) known_classes)]))
+
+(exception: #export (cannot_define {class Text} {error Text})
+  (exception.report
+   ["Class" class]
+   ["Error" error]))
+
+(import: java/lang/Object
+  ["#::."
+   (getClass [] (java/lang/Class java/lang/Object))])
+
+(import: java/lang/String)
+
+(import: java/lang/reflect/Method
+  ["#::."
+   (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)])
+
+(import: (java/lang/Class a)
+  ["#::."
+   (getDeclaredMethod [java/lang/String [(java/lang/Class [? < java/lang/Object])]] java/lang/reflect/Method)])
+
+(import: java/lang/Integer
+  ["#::."
+   (#static TYPE (java/lang/Class java/lang/Integer))])
+
+(import: java/lang/reflect/AccessibleObject
+  ["#::."
+   (setAccessible [boolean] void)])
+
+(import: java/lang/ClassLoader
+  ["#::."
+   (loadClass [java/lang/String]
+              #io #try (java/lang/Class java/lang/Object))])
+
+(with_expansions [ (as_is (java/lang/Class java/lang/Object))]
+  (def: java/lang/ClassLoader::defineClass
+    java/lang/reflect/Method
+    (let [signature (|> (ffi.array  4)
+                        (ffi.array_write 0 (:as 
+                                                (ffi.class_for java/lang/String)))
+                        (ffi.array_write 1 (java/lang/Object::getClass (ffi.array byte 0)))
+                        (ffi.array_write 2 (:as 
+                                                (java/lang/Integer::TYPE)))
+                        (ffi.array_write 3 (:as 
+                                                (java/lang/Integer::TYPE))))]
+      (do_to (java/lang/Class::getDeclaredMethod "defineClass"
+                                                 signature
+                                                 (ffi.class_for java/lang/ClassLoader))
+        (java/lang/reflect/AccessibleObject::setAccessible true)))))
+
+(def: #export (define class_name bytecode loader)
+  (-> Text Binary java/lang/ClassLoader (Try java/lang/Object))
+  (let [signature (array.from_list (list (:as java/lang/Object
+                                              class_name)
+                                         (:as java/lang/Object
+                                              bytecode)
+                                         (:as java/lang/Object
+                                              (|> 0
+                                                  (:as (primitive "java.lang.Long"))
+                                                  ffi.long_to_int))
+                                         (:as java/lang/Object
+                                              (|> bytecode
+                                                  binary.size
+                                                  (:as (primitive "java.lang.Long"))
+                                                  ffi.long_to_int))))]
+    (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass)))
+
+(def: #export (new_library _)
+  (-> Any Library)
+  (atom.atom (dictionary.new text.hash)))
+
+(def: #export (memory library)
+  (-> Library java/lang/ClassLoader)
+  (with_expansions [ (for {@.old
+                                 (<|)
+                                 
+                                 @.jvm
+                                 "jvm object cast"})]
+    (<| 
+        (object [] java/lang/ClassLoader []
+          []
+          (java/lang/ClassLoader (findClass self {class_name java/lang/String})
+                                 (java/lang/Class [? < java/lang/Object])
+                                 #throws [java/lang/ClassNotFoundException]
+                                 (let [class_name (:as Text class_name)
+                                       classes (|> library atom.read io.run)]
+                                   (case (dictionary.get class_name classes)
+                                     (#.Some bytecode)
+                                     (case (..define class_name bytecode (<|  self))
+                                       (#try.Success class)
+                                       (:assume class)
+
+                                       (#try.Failure error)
+                                       (error! (exception.construct ..cannot_define [class_name error])))
+
+                                     #.None
+                                     (error! (exception.construct ..unknown [class_name (dictionary.keys classes)])))))))))
+
+(def: #export (store name bytecode library)
+  (-> Text Binary Library (IO (Try Any)))
+  (do {! io.monad}
+    [library' (atom.read library)]
+    (if (dictionary.key? library' name)
+      (wrap (exception.throw ..already_stored name))
+      (do !
+        [_ (atom.update (dictionary.put name bytecode) library)]
+        (wrap (#try.Success []))))))
+
+(def: #export (load name loader)
+  (-> Text java/lang/ClassLoader
+      (IO (Try (java/lang/Class java/lang/Object))))
+  (java/lang/ClassLoader::loadClass name loader))
diff --git a/stdlib/source/library/lux/target/jvm/magic.lux b/stdlib/source/library/lux/target/jvm/magic.lux
new file mode 100644
index 000000000..70859362b
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/magic.lux
@@ -0,0 +1,20 @@
+(.module:
+  [library
+   [lux #*
+    [control
+     ["." try]]
+    [math
+     [number (#+ hex)]]]]
+  ["." // #_
+   [encoding
+    ["#." unsigned (#+ U4)]]])
+
+(type: #export Magic
+  U4)
+
+(def: #export code
+  Magic
+  (|> (hex "CAFEBABE") //unsigned.u4 try.assume))
+
+(def: #export writer
+  //unsigned.writer/4)
diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux
new file mode 100644
index 000000000..e832b1667
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/method.lux
@@ -0,0 +1,104 @@
+(.module:
+  [library
+   [lux (#- Type static)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     ["." monad (#+ do)]]
+    [control
+     ["." try]]
+    [data
+     ["." product]
+     ["." format #_
+      ["#" binary (#+ Writer) ("#\." monoid)]]
+     [collection
+      ["." row (#+ Row)]]]]]
+  ["." // #_
+   ["#." modifier (#+ Modifier modifiers:)]
+   ["#." index (#+ Index)]
+   ["#." attribute (#+ Attribute)
+    ["#/." code]]
+   ["#." constant (#+ UTF8)
+    ["#/." pool (#+ Pool Resource)]]
+   ["#." bytecode (#+ Bytecode)
+    ["#/." environment (#+ Environment)]
+    ["#/." instruction]]
+   ["#." type (#+ Type)
+    ["#/." category]
+    ["#." descriptor (#+ Descriptor)]]])
+
+(type: #export #rec Method
+  {#modifier (Modifier Method)
+   #name (Index UTF8)
+   #descriptor (Index (Descriptor //type/category.Method))
+   #attributes (Row Attribute)})
+
+(modifiers: Method
+  ["0001" public]
+  ["0002" private]
+  ["0004" protected]
+  ["0008" static]
+  ["0010" final]
+  ["0020" synchronized]
+  ["0040" bridge]
+  ["0080" var_args]
+  ["0100" native]
+  ["0400" abstract]
+  ["0800" strict]
+  ["1000" synthetic]
+  )
+
+(def: #export (method modifier name type attributes code)
+  (-> (Modifier Method) UTF8 (Type //type/category.Method) (List (Resource Attribute)) (Maybe (Bytecode Any))
+      (Resource Method))
+  (do {! //constant/pool.monad}
+    [@name (//constant/pool.utf8 name)
+     @descriptor (//constant/pool.descriptor (//type.descriptor type))
+     attributes (|> attributes
+                    (monad.seq !)
+                    (\ ! map row.from_list))
+     attributes (case code
+                  (#.Some code)
+                  (do !
+                    [environment (case (if (//modifier.has? static modifier)
+                                         (//bytecode/environment.static type)
+                                         (//bytecode/environment.virtual type))
+                                   (#try.Success environment)
+                                   (wrap environment)
+                                   
+                                   (#try.Failure error)
+                                   (function (_ _) (#try.Failure error)))
+                     [environment exceptions instruction output] (//bytecode.resolve environment code)
+                     #let [bytecode (|> instruction //bytecode/instruction.run format.instance)]
+                     @code (//attribute.code {#//attribute/code.limit (get@ #//bytecode/environment.limit environment)
+                                              #//attribute/code.code bytecode
+                                              #//attribute/code.exception_table exceptions
+                                              #//attribute/code.attributes (row.row)})]
+                    (wrap (row.add @code attributes)))
+                  
+                  #.None
+                  (wrap attributes))]
+    (wrap {#modifier modifier
+           #name @name
+           #descriptor @descriptor
+           #attributes attributes})))
+
+(def: #export equivalence
+  (Equivalence Method)
+  ($_ product.equivalence
+      //modifier.equivalence
+      //index.equivalence
+      //index.equivalence
+      (row.equivalence //attribute.equivalence)
+      ))
+
+(def: #export (writer field)
+  (Writer Method)
+  (`` ($_ format\compose
+          (~~ (template [ ]
+                [( (get@  field))]
+
+                [//modifier.writer #modifier]
+                [//index.writer #name]
+                [//index.writer #descriptor]
+                [(format.row/16 //attribute.writer) #attributes]))
+          )))
diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux
new file mode 100644
index 000000000..109486231
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/modifier.lux
@@ -0,0 +1,88 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     ["." equivalence (#+ Equivalence)]
+     ["." monoid (#+ Monoid)]]
+    [control
+     ["." try]
+     ["<>" parser
+      ["" code]]]
+    [data
+     [format
+      [".F" binary (#+ Writer)]]]
+    [macro (#+ with_gensyms)
+     [syntax (#+ syntax:)]
+     ["." code]]
+    [math
+     ["." number (#+ hex)
+      ["." i64]]]
+    [type
+     abstract]]]
+  ["." // #_
+   [encoding
+    ["#." unsigned]]])
+
+(abstract: #export (Modifier of)
+  //unsigned.U2
+
+  (def: #export code
+    (-> (Modifier Any) //unsigned.U2)
+    (|>> :representation))
+
+  (implementation: #export equivalence
+    (All [of] (Equivalence (Modifier of)))
+    
+    (def: (= reference sample)
+      (\ //unsigned.equivalence =
+         (:representation reference)
+         (:representation sample))))
+
+  (template: (!wrap value)
+    (|> value
+        //unsigned.u2
+        try.assume
+        :abstraction))
+
+  (template: (!unwrap value)
+    (|> value
+        :representation
+        //unsigned.value))
+
+  (def: #export (has? sub super)
+    (All [of] (-> (Modifier of) (Modifier of) Bit))
+    (let [sub (!unwrap sub)]
+      (|> (!unwrap super)
+          (i64.and sub)
+          (\ i64.equivalence = sub))))
+
+  (implementation: #export monoid
+    (All [of] (Monoid (Modifier of)))
+
+    (def: identity
+      (!wrap (hex "0000")))
+    
+    (def: (compose left right)
+      (!wrap (i64.or (!unwrap left) (!unwrap right)))))
+
+  (def: #export empty
+    Modifier
+    (\ ..monoid identity))
+
+  (def: #export writer
+    (All [of] (Writer (Modifier of)))
+    (|>> :representation //unsigned.writer/2))
+
+  (def: modifier
+    (-> Nat Modifier)
+    (|>> !wrap))
+  )
+
+(syntax: #export (modifiers: ofT {options (<>.many .any)})
+  (with_gensyms [g!modifier g!code]
+    (wrap (list (` (template [(~ g!code) (~ g!modifier)]
+                     [(def: (~' #export) (~ g!modifier)
+                        (..Modifier (~ ofT))
+                        ((~! ..modifier) ((~! number.hex) (~ g!code))))]
+                     
+                     (~+ options)))))))
diff --git a/stdlib/source/library/lux/target/jvm/modifier/inner.lux b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
new file mode 100644
index 000000000..fc9bc982c
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/modifier/inner.lux
@@ -0,0 +1,21 @@
+(.module:
+  [library
+   [lux (#- static)
+    [type
+     abstract]]]
+  [// (#+ modifiers:)])
+
+(abstract: #export Inner Any)
+
+(modifiers: Inner
+  ["0001" public]
+  ["0002" private]
+  ["0004" protected]
+  ["0008" static]
+  ["0010" final]
+  ["0200" interface]
+  ["0400" abstract]
+  ["1000" synthetic]
+  ["2000" annotation]
+  ["4000" enum]
+  )
diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux
new file mode 100644
index 000000000..e2297f313
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/reflection.lux
@@ -0,0 +1,382 @@
+(.module:
+  [library
+   [lux (#- type)
+    ["." ffi (#+ import:)]
+    ["." type]
+    [abstract
+     ["." monad (#+ do)]]
+    [control
+     ["." try (#+ Try)]
+     ["." exception (#+ exception:)]
+     [parser
+      ["" text]]]
+    [data
+     ["." text ("#\." equivalence)
+      ["%" format (#+ format)]]
+     [collection
+      ["." list ("#\." fold functor)]
+      ["." array]
+      ["." dictionary]]]
+    [math
+     [number
+      ["n" nat]]]]]
+  ["." // #_
+   [encoding
+    ["#." name (#+ External)]]
+   ["/" type
+    [category (#+ Void Value Return Method Primitive Object Class Array Parameter)]
+    ["#." lux (#+ Mapping)]
+    ["#." descriptor]
+    ["#." reflection]
+    ["#." parser]]])
+
+(import: java/lang/String)
+
+(import: java/lang/Object
+  ["#::."
+   (toString [] java/lang/String)
+   (getClass [] (java/lang/Class java/lang/Object))])
+
+(import: java/lang/reflect/Type
+  ["#::."
+   (getTypeName [] java/lang/String)])
+
+(import: java/lang/reflect/GenericArrayType
+  ["#::."
+   (getGenericComponentType [] java/lang/reflect/Type)])
+
+(import: java/lang/reflect/ParameterizedType
+  ["#::."
+   (getRawType [] java/lang/reflect/Type)
+   (getActualTypeArguments [] [java/lang/reflect/Type])])
+
+(import: (java/lang/reflect/TypeVariable d)
+  ["#::."
+   (getName [] java/lang/String)
+   (getBounds [] [java/lang/reflect/Type])])
+
+(import: (java/lang/reflect/WildcardType d)
+  ["#::."
+   (getLowerBounds [] [java/lang/reflect/Type])
+   (getUpperBounds [] [java/lang/reflect/Type])])
+
+(import: java/lang/reflect/Modifier
+  ["#::."
+   (#static isStatic [int] boolean)
+   (#static isFinal [int] boolean)
+   (#static isInterface [int] boolean)
+   (#static isAbstract [int] boolean)])
+
+(import: java/lang/annotation/Annotation)
+
+(import: java/lang/Deprecated)
+
+(import: java/lang/reflect/Field
+  ["#::."
+   (getDeclaringClass [] (java/lang/Class java/lang/Object))
+   (getModifiers [] int)
+   (getGenericType [] java/lang/reflect/Type)
+   (getDeclaredAnnotations [] [java/lang/annotation/Annotation])])
+
+(import: java/lang/reflect/Method
+  ["#::."
+   (getName [] java/lang/String)
+   (getModifiers [] int)
+   (getDeclaringClass [] (java/lang/Class java/lang/Object))
+   (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)])
+   (getGenericParameterTypes [] [java/lang/reflect/Type])
+   (getGenericReturnType [] java/lang/reflect/Type)
+   (getGenericExceptionTypes [] [java/lang/reflect/Type])])
+
+(import: (java/lang/reflect/Constructor c)
+  ["#::."
+   (getModifiers [] int)
+   (getDeclaringClass [] (java/lang/Class c))
+   (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))])
+   (getGenericParameterTypes [] [java/lang/reflect/Type])
+   (getGenericExceptionTypes [] [java/lang/reflect/Type])])
+
+(import: (java/lang/Class c)
+  ["#::."
+   (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object))
+   (getName [] java/lang/String)
+   (getModifiers [] int)
+   (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean)
+   (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))])
+   (getGenericInterfaces [] [java/lang/reflect/Type])
+   (getGenericSuperclass [] #? java/lang/reflect/Type)
+   (getDeclaredField [java/lang/String] #try java/lang/reflect/Field)
+   (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)])
+   (getDeclaredMethods [] [java/lang/reflect/Method])])
+
+(exception: #export (unknown_class {class External})
+  (exception.report
+   ["Class" (%.text class)]))
+
+(template []
+  [(exception: #export ( {jvm_type java/lang/reflect/Type})
+     (exception.report
+      ["Type" (java/lang/reflect/Type::getTypeName jvm_type)]
+      ["Class" (|> jvm_type java/lang/Object::getClass java/lang/Object::toString)]))]
+
+  [not_a_class]
+  [cannot_convert_to_a_lux_type]
+  )
+
+(def: #export (load name)
+  (-> External (Try (java/lang/Class java/lang/Object)))
+  (case (java/lang/Class::forName name)
+    (#try.Success class)
+    (#try.Success class)
+
+    (#try.Failure _)
+    (exception.throw ..unknown_class name)))
+
+(def: #export (sub? super sub)
+  (-> External External (Try Bit))
+  (do try.monad
+    [super (..load super)
+     sub (..load sub)]
+    (wrap (java/lang/Class::isAssignableFrom sub super))))
+
+(def: (class' parameter reflection)
+  (-> (-> java/lang/reflect/Type (Try (/.Type Parameter)))
+      java/lang/reflect/Type
+      (Try (/.Type Class)))
+  (<| (case (ffi.check java/lang/Class reflection)
+        (#.Some class)
+        (let [class_name (|> class
+                             (:as (java/lang/Class java/lang/Object))
+                             java/lang/Class::getName)]
+          (`` (if (or (~~ (template []
+                            [(text\= (/reflection.reflection )
+                                     class_name)]
+
+                            [/reflection.boolean]
+                            [/reflection.byte]
+                            [/reflection.short]
+                            [/reflection.int]
+                            [/reflection.long]
+                            [/reflection.float]
+                            [/reflection.double]
+                            [/reflection.char]))
+                      (text.starts_with? /descriptor.array_prefix class_name))
+                (exception.throw ..not_a_class reflection)
+                (#try.Success (/.class class_name (list))))))
+        _)
+      (case (ffi.check java/lang/reflect/ParameterizedType reflection)
+        (#.Some reflection)
+        (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
+          (case (ffi.check java/lang/Class raw)
+            (#.Some raw)
+            (do {! try.monad}
+              [paramsT (|> reflection
+                           java/lang/reflect/ParameterizedType::getActualTypeArguments
+                           array.to_list
+                           (monad.map ! parameter))]
+              (wrap (/.class (|> raw
+                                 (:as (java/lang/Class java/lang/Object))
+                                 java/lang/Class::getName)
+                             paramsT)))
+
+            _
+            (exception.throw ..not_a_class raw)))
+        _)
+      ## else
+      (exception.throw ..cannot_convert_to_a_lux_type reflection)))
+
+(def: #export (parameter reflection)
+  (-> java/lang/reflect/Type (Try (/.Type Parameter)))
+  (<| (case (ffi.check java/lang/reflect/TypeVariable reflection)
+        (#.Some reflection)
+        (#try.Success (/.var (java/lang/reflect/TypeVariable::getName reflection)))
+        _)
+      (case (ffi.check java/lang/reflect/WildcardType reflection)
+        (#.Some reflection)
+        ## TODO: Instead of having single lower/upper bounds, should
+        ## allow for multiple ones.
+        (case [(array.read 0 (java/lang/reflect/WildcardType::getLowerBounds reflection))
+               (array.read 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))]
+          (^template [ ]
+            [
+             (case (ffi.check java/lang/reflect/GenericArrayType bound)
+               (#.Some _)
+               ## TODO: Array bounds should not be "erased" as they
+               ## are right now.
+               (#try.Success /.wildcard)
+
+               _
+               (\ try.monad map  (..class' parameter bound)))])
+          ([[_ (#.Some bound)] /.upper]
+           [[(#.Some bound) _] /.lower])
+          
+          _
+          (#try.Success /.wildcard))
+        _)
+      (..class' parameter reflection)))
+
+(def: #export class
+  (-> java/lang/reflect/Type
+      (Try (/.Type Class)))
+  (..class' ..parameter))
+
+(def: #export (type reflection)
+  (-> java/lang/reflect/Type (Try (/.Type Value)))
+  (<| (case (ffi.check java/lang/Class reflection)
+        (#.Some reflection)
+        (let [class_name (|> reflection
+                             (:as (java/lang/Class java/lang/Object))
+                             java/lang/Class::getName)]
+          (`` (cond (~~ (template [ ]
+                          [(text\= (/reflection.reflection )
+                                   class_name)
+                           (#try.Success )]
+
+                          [/reflection.boolean /.boolean]
+                          [/reflection.byte /.byte]
+                          [/reflection.short /.short]
+                          [/reflection.int /.int]
+                          [/reflection.long /.long]
+                          [/reflection.float /.float]
+                          [/reflection.double /.double]
+                          [/reflection.char /.char]))
+                    (if (text.starts_with? /descriptor.array_prefix class_name)
+                      (.run /parser.value (|> class_name //name.internal //name.read))
+                      (#try.Success (/.class class_name (list)))))))
+        _)
+      (case (ffi.check java/lang/reflect/GenericArrayType reflection)
+        (#.Some reflection)
+        (|> reflection
+            java/lang/reflect/GenericArrayType::getGenericComponentType
+            type
+            (\ try.monad map /.array))
+        _)
+      ## else
+      (..parameter reflection)))
+
+(def: #export (return reflection)
+  (-> java/lang/reflect/Type (Try (/.Type Return)))
+  (with_expansions [ (as_is (..type reflection))]
+    (case (ffi.check java/lang/Class reflection)
+      (#.Some class)
+      (let [class_name (|> reflection
+                           (:as (java/lang/Class java/lang/Object))
+                           java/lang/Class::getName)]
+        (if (text\= (/reflection.reflection /reflection.void)
+                    class_name)
+          (#try.Success /.void)
+          ))
+
+      #.None
+      )))
+
+(exception: #export (cannot_correspond {class (java/lang/Class java/lang/Object)}
+                                       {type Type})
+  (exception.report
+   ["Class" (java/lang/Object::toString class)]
+   ["Type" (%.type type)]))
+
+(exception: #export (type_parameter_mismatch {expected Nat}
+                                             {actual Nat}
+                                             {class (java/lang/Class java/lang/Object)}
+                                             {type Type})
+  (exception.report
+   ["Expected" (%.nat expected)]
+   ["Actual" (%.nat actual)]
+   ["Class" (java/lang/Object::toString class)]
+   ["Type" (%.type type)]))
+
+(exception: #export (non_jvm_type {type Type})
+  (exception.report
+   ["Type" (%.type type)]))
+
+(def: #export (correspond class type)
+  (-> (java/lang/Class java/lang/Object) Type (Try Mapping))
+  (case type
+    (#.Primitive name params)
+    (let [class_name (java/lang/Class::getName class)
+          class_params (array.to_list (java/lang/Class::getTypeParameters class))
+          num_class_params (list.size class_params)
+          num_type_params (list.size params)]
+      (if (text\= class_name name)
+        (if (n.= num_class_params num_type_params)
+          (|> params
+              (list.zip/2 (list\map (|>> java/lang/reflect/TypeVariable::getName)
+                                    class_params))
+              (list\fold (function (_ [name paramT] mapping)
+                           (dictionary.put name paramT mapping))
+                         /lux.fresh)
+              #try.Success)
+          (exception.throw ..type_parameter_mismatch [num_class_params num_type_params class type]))
+        (exception.throw ..cannot_correspond [class type])))
+
+    (#.Named name anonymousT)
+    (correspond class anonymousT)
+
+    (#.Apply inputT abstractionT)
+    (case (type.apply (list inputT) abstractionT)
+      (#.Some outputT)
+      (correspond class outputT)
+
+      #.None
+      (exception.throw ..non_jvm_type [type]))
+
+    _
+    (exception.throw ..non_jvm_type [type])))
+
+(exception: #export (mistaken_field_owner {field java/lang/reflect/Field}
+                                          {owner (java/lang/Class java/lang/Object)}
+                                          {target (java/lang/Class java/lang/Object)})
+  (exception.report
+   ["Field" (java/lang/Object::toString field)]
+   ["Owner" (java/lang/Object::toString owner)]
+   ["Target" (java/lang/Object::toString target)]))
+
+(template []
+  [(exception: #export ( {field Text}
+                               {class (java/lang/Class java/lang/Object)})
+     (exception.report
+      ["Field" (%.text field)]
+      ["Class" (java/lang/Object::toString class)]))]
+
+  [unknown_field]
+  [not_a_static_field]
+  [not_a_virtual_field]
+  )
+
+(def: #export (field field target)
+  (-> Text (java/lang/Class java/lang/Object) (Try java/lang/reflect/Field))
+  (case (java/lang/Class::getDeclaredField field target)
+    (#try.Success field)
+    (let [owner (java/lang/reflect/Field::getDeclaringClass field)]
+      (if (is? owner target)
+        (#try.Success field)
+        (exception.throw ..mistaken_field_owner [field owner target])))
+
+    (#try.Failure _)
+    (exception.throw ..unknown_field [field target])))
+
+(def: #export deprecated?
+  (-> (array.Array java/lang/annotation/Annotation) Bit)
+  (|>> array.to_list
+       (list.all (|>> (ffi.check java/lang/Deprecated)))
+       list.empty?
+       not))
+
+(template [   ]
+  [(def: #export ( field class)
+     (-> Text (java/lang/Class java/lang/Object) (Try [Bit Bit (/.Type Value)]))
+     (do {! try.monad}
+       [fieldJ (..field field class)
+        #let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]]
+       (case (java/lang/reflect/Modifier::isStatic modifiers)
+          (|> fieldJ
+                     java/lang/reflect/Field::getGenericType
+                     ..type
+                     (\ ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers)
+                                    (..deprecated? (java/lang/reflect/Field::getDeclaredAnnotations fieldJ))])))
+          (exception.throw  [field class]))))]
+
+  [static_field ..not_a_static_field #1 #0]
+  [virtual_field ..not_a_virtual_field #0 #1]
+  )
diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux
new file mode 100644
index 000000000..e11ef5c99
--- /dev/null
+++ b/stdlib/source/library/lux/target/jvm/type.lux
@@ -0,0 +1,205 @@
+(.module:
+  [library
+   [lux (#- Type int char)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [hash (#+ Hash)]]
+    [data
+     ["." maybe]
+     ["." text
+      ["%" format (#+ Format)]]
+     [collection
+      ["." list ("#\." functor)]]]
+    [math
+     [number
+      ["n" nat]]]
+    [type
+     abstract]]]
+  ["." // #_
+   [encoding
+    ["#." name (#+ External)]]]
+  ["." / #_
+   [category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
+   ["#." signature (#+ Signature)]
+   ["#." descriptor (#+ Descriptor)]
+   ["#." reflection (#+ Reflection)]])
+
+(abstract: #export (Type category)
+  [(Signature category) (Descriptor category) (Reflection category)]
+
+  (type: #export Argument
+    [Text (Type Value)])
+
+  (type: #export (Typed a)
+    [(Type Value) a])
+
+  (type: #export Constraint
+    {#name Text
+     #super_class (Type Class)
+     #super_interfaces (List (Type Class))})
+  
+  (template [