From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- .gitignore | 16 +- commands.md | 53 +- documentation/research/math.md | 1 + lux-jvm/project.clj | 32 + lux-jvm/source/luxc/lang/directive/jvm.lux | 538 ++++++++++ lux-jvm/source/luxc/lang/host/jvm.lux | 131 +++ lux-jvm/source/luxc/lang/host/jvm/def.lux | 298 ++++++ lux-jvm/source/luxc/lang/host/jvm/inst.lux | 464 +++++++++ lux-jvm/source/luxc/lang/synthesis/variable.lux | 98 ++ lux-jvm/source/luxc/lang/translation/jvm.lux | 182 ++++ lux-jvm/source/luxc/lang/translation/jvm/case.lux | 239 +++++ .../source/luxc/lang/translation/jvm/common.lux | 72 ++ .../luxc/lang/translation/jvm/expression.lux | 72 ++ .../source/luxc/lang/translation/jvm/extension.lux | 16 + .../luxc/lang/translation/jvm/extension/common.lux | 388 ++++++++ .../luxc/lang/translation/jvm/extension/host.lux | 1047 ++++++++++++++++++++ .../source/luxc/lang/translation/jvm/function.lux | 331 +++++++ lux-jvm/source/luxc/lang/translation/jvm/loop.lux | 81 ++ .../source/luxc/lang/translation/jvm/primitive.lux | 30 + .../source/luxc/lang/translation/jvm/program.lux | 82 ++ .../source/luxc/lang/translation/jvm/reference.lux | 65 ++ .../source/luxc/lang/translation/jvm/runtime.lux | 387 ++++++++ .../source/luxc/lang/translation/jvm/structure.lux | 79 ++ lux-jvm/source/program.lux | 180 ++++ lux-jvm/source/test/program.lux | 18 + lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux | 549 ++++++++++ lux-jvm/test/test/luxc/lang/synthesis/loop.lux | 162 +++ .../test/test/luxc/lang/synthesis/procedure.lux | 34 + lux-jvm/test/test/luxc/lang/translation/js.lux | 160 +++ lux-jvm/test/test/luxc/lang/translation/jvm.lux | 641 ++++++++++++ lux-r/project.clj | 34 + lux-r/source/luxc/lang/host/r.lux | 299 ++++++ lux-r/source/luxc/lang/synthesis/variable.lux | 98 ++ lux-r/source/luxc/lang/translation/r.lux | 216 ++++ lux-r/source/luxc/lang/translation/r/case.jvm.lux | 195 ++++ .../luxc/lang/translation/r/expression.jvm.lux | 88 ++ .../luxc/lang/translation/r/function.jvm.lux | 94 ++ lux-r/source/luxc/lang/translation/r/loop.jvm.lux | 37 + .../luxc/lang/translation/r/primitive.jvm.lux | 22 + .../lang/translation/r/procedure/common.jvm.lux | 339 +++++++ .../luxc/lang/translation/r/procedure/host.jvm.lux | 89 ++ .../luxc/lang/translation/r/reference.jvm.lux | 42 + .../source/luxc/lang/translation/r/runtime.jvm.lux | 802 +++++++++++++++ .../luxc/lang/translation/r/statement.jvm.lux | 45 + .../luxc/lang/translation/r/structure.jvm.lux | 31 + lux-r/source/program.lux | 180 ++++ lux-r/source/test/program.lux | 18 + new-luxc/project.clj | 34 - new-luxc/source/luxc/lang/directive/jvm.lux | 538 ---------- new-luxc/source/luxc/lang/host/jvm.lux | 131 --- new-luxc/source/luxc/lang/host/jvm/def.lux | 298 ------ new-luxc/source/luxc/lang/host/jvm/inst.lux | 464 --------- new-luxc/source/luxc/lang/host/r.lux | 299 ------ new-luxc/source/luxc/lang/synthesis/variable.lux | 98 -- new-luxc/source/luxc/lang/translation/jvm.lux | 182 ---- new-luxc/source/luxc/lang/translation/jvm/case.lux | 239 ----- .../source/luxc/lang/translation/jvm/common.lux | 72 -- .../luxc/lang/translation/jvm/expression.lux | 72 -- .../source/luxc/lang/translation/jvm/extension.lux | 16 - .../luxc/lang/translation/jvm/extension/common.lux | 388 -------- .../luxc/lang/translation/jvm/extension/host.lux | 1047 -------------------- .../source/luxc/lang/translation/jvm/function.lux | 331 ------- new-luxc/source/luxc/lang/translation/jvm/loop.lux | 81 -- .../source/luxc/lang/translation/jvm/primitive.lux | 30 - .../source/luxc/lang/translation/jvm/program.lux | 82 -- .../source/luxc/lang/translation/jvm/reference.lux | 65 -- .../source/luxc/lang/translation/jvm/runtime.lux | 387 -------- .../source/luxc/lang/translation/jvm/structure.lux | 79 -- new-luxc/source/luxc/lang/translation/r.lux | 216 ---- .../source/luxc/lang/translation/r/case.jvm.lux | 195 ---- .../luxc/lang/translation/r/expression.jvm.lux | 88 -- .../luxc/lang/translation/r/function.jvm.lux | 94 -- .../source/luxc/lang/translation/r/loop.jvm.lux | 37 - .../luxc/lang/translation/r/primitive.jvm.lux | 22 - .../lang/translation/r/procedure/common.jvm.lux | 339 ------- .../luxc/lang/translation/r/procedure/host.jvm.lux | 89 -- .../luxc/lang/translation/r/reference.jvm.lux | 42 - .../source/luxc/lang/translation/r/runtime.jvm.lux | 802 --------------- .../luxc/lang/translation/r/statement.jvm.lux | 45 - .../luxc/lang/translation/r/structure.jvm.lux | 31 - new-luxc/source/program.lux | 180 ---- new-luxc/source/test/program.lux | 18 - new-luxc/test/test/luxc/lang/analysis/host.jvm.lux | 549 ---------- new-luxc/test/test/luxc/lang/synthesis/loop.lux | 162 --- .../test/test/luxc/lang/synthesis/procedure.lux | 34 - new-luxc/test/test/luxc/lang/translation/js.lux | 160 --- new-luxc/test/test/luxc/lang/translation/jvm.lux | 641 ------------ 87 files changed, 9060 insertions(+), 8692 deletions(-) create mode 100644 lux-jvm/project.clj create mode 100644 lux-jvm/source/luxc/lang/directive/jvm.lux create mode 100644 lux-jvm/source/luxc/lang/host/jvm.lux create mode 100644 lux-jvm/source/luxc/lang/host/jvm/def.lux create mode 100644 lux-jvm/source/luxc/lang/host/jvm/inst.lux create mode 100644 lux-jvm/source/luxc/lang/synthesis/variable.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/case.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/common.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/expression.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/extension.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/function.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/loop.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/primitive.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/program.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/reference.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/runtime.lux create mode 100644 lux-jvm/source/luxc/lang/translation/jvm/structure.lux create mode 100644 lux-jvm/source/program.lux create mode 100644 lux-jvm/source/test/program.lux create mode 100644 lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux create mode 100644 lux-jvm/test/test/luxc/lang/synthesis/loop.lux create mode 100644 lux-jvm/test/test/luxc/lang/synthesis/procedure.lux create mode 100644 lux-jvm/test/test/luxc/lang/translation/js.lux create mode 100644 lux-jvm/test/test/luxc/lang/translation/jvm.lux create mode 100644 lux-r/project.clj create mode 100644 lux-r/source/luxc/lang/host/r.lux create mode 100644 lux-r/source/luxc/lang/synthesis/variable.lux create mode 100644 lux-r/source/luxc/lang/translation/r.lux create mode 100644 lux-r/source/luxc/lang/translation/r/case.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/expression.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/function.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/loop.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/primitive.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/reference.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/runtime.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/statement.jvm.lux create mode 100644 lux-r/source/luxc/lang/translation/r/structure.jvm.lux create mode 100644 lux-r/source/program.lux create mode 100644 lux-r/source/test/program.lux delete mode 100644 new-luxc/project.clj delete mode 100644 new-luxc/source/luxc/lang/directive/jvm.lux delete mode 100644 new-luxc/source/luxc/lang/host/jvm.lux delete mode 100644 new-luxc/source/luxc/lang/host/jvm/def.lux delete mode 100644 new-luxc/source/luxc/lang/host/jvm/inst.lux delete mode 100644 new-luxc/source/luxc/lang/host/r.lux delete mode 100644 new-luxc/source/luxc/lang/synthesis/variable.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/case.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/common.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/expression.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/extension.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/extension/common.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/extension/host.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/function.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/loop.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/primitive.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/program.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/reference.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/runtime.lux delete mode 100644 new-luxc/source/luxc/lang/translation/jvm/structure.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/case.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/expression.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/function.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/loop.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/reference.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/statement.jvm.lux delete mode 100644 new-luxc/source/luxc/lang/translation/r/structure.jvm.lux delete mode 100644 new-luxc/source/program.lux delete mode 100644 new-luxc/source/test/program.lux delete mode 100644 new-luxc/test/test/luxc/lang/analysis/host.jvm.lux delete mode 100644 new-luxc/test/test/luxc/lang/synthesis/loop.lux delete mode 100644 new-luxc/test/test/luxc/lang/synthesis/procedure.lux delete mode 100644 new-luxc/test/test/luxc/lang/translation/js.lux delete mode 100644 new-luxc/test/test/luxc/lang/translation/jvm.lux diff --git a/.gitignore b/.gitignore index 95dbbee14..0900603b4 100644 --- a/.gitignore +++ b/.gitignore @@ -16,11 +16,11 @@ pom.xml.asc /lux-lein/target -/new-luxc/target -/new-luxc/source/lux.lux -/new-luxc/source/lux -/new-luxc/source/program -/new-luxc/source/spec +/lux-jvm/target +/lux-jvm/source/lux.lux +/lux-jvm/source/lux +/lux-jvm/source/program +/lux-jvm/source/spec /lux-js/target /lux-js/source/lux.lux @@ -64,3 +64,9 @@ pom.xml.asc /lux-scheme/source/program /lux-scheme/source/spec +/lux-r/target +/lux-r/source/lux.lux +/lux-r/source/lux +/lux-r/source/program +/lux-r/source/spec + diff --git a/commands.md b/commands.md index f29b148e3..2108bb873 100644 --- a/commands.md +++ b/commands.md @@ -270,35 +270,68 @@ cd ~/lux/lux-scheme/ && java -jar target/program.jar build --source ~/lux/stdlib --- -# New compiler +# R compiler ## Test ``` -cd ~/lux/new-luxc/ && lein lux auto test -cd ~/lux/new-luxc/ && lein clean && lein lux auto test +cd ~/lux/lux-r/ && lein lux auto test +cd ~/lux/lux-r/ && lein clean && lein lux auto test ``` ## Build ``` -cd ~/lux/new-luxc/ && lein lux auto build -cd ~/lux/new-luxc/ && lein clean && lein lux auto build +cd ~/lux/lux-r/ && lein lux auto build +cd ~/lux/lux-r/ && lein clean && lein lux auto build ``` # REPL ``` -cd ~/lux/new-luxc/ && java -jar target/program.jar repl --source ~/lux/stdlib/source --target ~/lux/stdlib/target +cd ~/lux/lux-r/ && java -jar target/program.jar repl --source ~/lux/stdlib/source --target ~/lux/stdlib/target ``` # Try ``` -cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && lein clean && cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && lein clean && cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux -cd ~/lux/new-luxc/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target +cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux +cd ~/lux/lux-r/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target + +cd ~/lux/stdlib/target/ && java -jar program.jar +``` + +# JVM compiler + +## Test + +``` +cd ~/lux/lux-jvm/ && lein lux auto test +cd ~/lux/lux-jvm/ && lein clean && lein lux auto test +``` + +## Build + +``` +cd ~/lux/lux-jvm/ && lein lux auto build +cd ~/lux/lux-jvm/ && lein clean && lein lux auto build +``` + +# REPL + +``` +cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/source --target ~/lux/stdlib/target +``` + +# Try + +``` +cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux +cd ~/lux/lux-jvm/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target cd ~/lux/stdlib/target/ && java -jar program.jar ``` diff --git a/documentation/research/math.md b/documentation/research/math.md index 91c434dca..572cd064a 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -160,6 +160,7 @@ # Geometric Algebra | Clifford Algebra +1. [Projective Geometric Algebra Done Right](http://terathon.com/blog/projective-geometric-algebra-done-right/) 1. [Siggraph2019 Geometric Algebra](https://www.youtube.com/watch?v=tX4H_ctggYo) 1. [Introduction to Clifford Algebra](https://www.av8n.com/physics/clifford-intro.htm) 1. [An Introduction to Geometric Algebra over R^2](https://bitworking.org/news/ga/2d) diff --git a/lux-jvm/project.clj b/lux-jvm/project.clj new file mode 100644 index 000000000..dbff84a85 --- /dev/null +++ b/lux-jvm/project.clj @@ -0,0 +1,32 @@ +(def version "0.6.0-SNAPSHOT") +(def repo "https://github.com/LuxLang/lux") +(def sonatype "https://oss.sonatype.org") +(def sonatype-releases (str sonatype "/service/local/staging/deploy/maven2/")) +(def sonatype-snapshots (str sonatype "/content/repositories/snapshots/")) + +(defproject com.github.luxlang/lux-jvm #=(identity version) + :description "A JVM compiler for Lux." + :url ~repo + :license {:name "Lux License v0.1" + :url ~(str repo "/blob/master/license.txt")} + :plugins [[com.github.luxlang/lein-luxc ~version]] + :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] + ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] + :pom-addition [:developers [:developer + [:name "Eduardo Julian"] + [:url "https://github.com/eduardoejp"]]] + :repositories [["releases" ~sonatype-releases] + ["snapshots" ~sonatype-snapshots]] + :scm {:name "git" + :url ~(str repo ".git")} + + :dependencies [[com.github.luxlang/luxc-jvm ~version] + [com.github.luxlang/stdlib ~version] + ;; JVM Bytecode + [org.ow2.asm/asm-all "5.0.3"]] + + :manifest {"lux" ~version} + :source-paths ["source"] + :lux {:program "program" + :test "test/program"} + ) diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux new file mode 100644 index 000000000..27b1c8688 --- /dev/null +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -0,0 +1,538 @@ +(.module: + [lux #* + [host (#+ import:)] + [type (#+ :share)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)]] + [target + ["/" jvm]] + [data + [identity (#+ Identity)] + ["." product] + [number + ["." nat]] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." fold)] + ["." dictionary (#+ Dictionary)] + ["." row (#+ Row) ("#@." functor fold)]]] + [tool + [compiler + ["." phase] + [language + [lux + [synthesis (#+ Synthesis)] + ["." generation] + ["." directive] + [phase + ["." extension + ["." bundle] + [directive + ["./" lux]]]]]]]]] + [/// + [host + ["." jvm (#+ Inst) + ["_" inst]]]]) + +(import: #long org/objectweb/asm/Label + (new [])) + +(def: (literal literal) + (-> /.Literal Inst) + (case literal + (#/.Boolean value) (_.boolean value) + (#/.Int value) (_.int value) + (#/.Long value) (_.long value) + (#/.Double value) (_.double value) + (#/.Char value) (_.char value) + (#/.String value) (_.string value))) + +(def: (constant instruction) + (-> /.Constant Inst) + (case instruction + (#/.BIPUSH constant) (_.BIPUSH constant) + + (#/.SIPUSH constant) (_.SIPUSH constant) + + #/.ICONST_M1 _.ICONST_M1 + #/.ICONST_0 _.ICONST_0 + #/.ICONST_1 _.ICONST_1 + #/.ICONST_2 _.ICONST_2 + #/.ICONST_3 _.ICONST_3 + #/.ICONST_4 _.ICONST_4 + #/.ICONST_5 _.ICONST_5 + + #/.LCONST_0 _.LCONST_0 + #/.LCONST_1 _.LCONST_1 + + #/.FCONST_0 _.FCONST_0 + #/.FCONST_1 _.FCONST_1 + #/.FCONST_2 _.FCONST_2 + + #/.DCONST_0 _.DCONST_0 + #/.DCONST_1 _.DCONST_1 + + #/.ACONST_NULL _.NULL + + (#/.LDC literal) + (..literal literal) + )) + +(def: (int-arithmetic instruction) + (-> /.Int-Arithmetic Inst) + (case instruction + #/.IADD _.IADD + #/.ISUB _.ISUB + #/.IMUL _.IMUL + #/.IDIV _.IDIV + #/.IREM _.IREM + #/.INEG _.INEG)) + +(def: (long-arithmetic instruction) + (-> /.Long-Arithmetic Inst) + (case instruction + #/.LADD _.LADD + #/.LSUB _.LSUB + #/.LMUL _.LMUL + #/.LDIV _.LDIV + #/.LREM _.LREM + #/.LNEG _.LNEG)) + +(def: (float-arithmetic instruction) + (-> /.Float-Arithmetic Inst) + (case instruction + #/.FADD _.FADD + #/.FSUB _.FSUB + #/.FMUL _.FMUL + #/.FDIV _.FDIV + #/.FREM _.FREM + #/.FNEG _.FNEG)) + +(def: (double-arithmetic instruction) + (-> /.Double-Arithmetic Inst) + (case instruction + #/.DADD _.DADD + #/.DSUB _.DSUB + #/.DMUL _.DMUL + #/.DDIV _.DDIV + #/.DREM _.DREM + #/.DNEG _.DNEG)) + +(def: (arithmetic instruction) + (-> /.Arithmetic Inst) + (case instruction + (#/.Int-Arithmetic int-arithmetic) + (..int-arithmetic int-arithmetic) + + (#/.Long-Arithmetic long-arithmetic) + (..long-arithmetic long-arithmetic) + + (#/.Float-Arithmetic float-arithmetic) + (..float-arithmetic float-arithmetic) + + (#/.Double-Arithmetic double-arithmetic) + (..double-arithmetic double-arithmetic))) + +(def: (int-bitwise instruction) + (-> /.Int-Bitwise Inst) + (case instruction + #/.IOR _.IOR + #/.IXOR _.IXOR + #/.IAND _.IAND + #/.ISHL _.ISHL + #/.ISHR _.ISHR + #/.IUSHR _.IUSHR)) + +(def: (long-bitwise instruction) + (-> /.Long-Bitwise Inst) + (case instruction + #/.LOR _.LOR + #/.LXOR _.LXOR + #/.LAND _.LAND + #/.LSHL _.LSHL + #/.LSHR _.LSHR + #/.LUSHR _.LUSHR)) + +(def: (bitwise instruction) + (-> /.Bitwise Inst) + (case instruction + (#/.Int-Bitwise int-bitwise) + (..int-bitwise int-bitwise) + + (#/.Long-Bitwise long-bitwise) + (..long-bitwise long-bitwise))) + +(def: (conversion instruction) + (-> /.Conversion Inst) + (case instruction + #/.I2B _.I2B + #/.I2S _.I2S + #/.I2L _.I2L + #/.I2F _.I2F + #/.I2D _.I2D + #/.I2C _.I2C + + #/.L2I _.L2I + #/.L2F _.L2F + #/.L2D _.L2D + + #/.F2I _.F2I + #/.F2L _.F2L + #/.F2D _.F2D + + #/.D2I _.D2I + #/.D2L _.D2L + #/.D2F _.D2F)) + +(def: (array instruction) + (-> /.Array Inst) + (case instruction + #/.ARRAYLENGTH _.ARRAYLENGTH + + (#/.NEWARRAY type) (_.NEWARRAY type) + (#/.ANEWARRAY type) (_.ANEWARRAY type) + + #/.BALOAD _.BALOAD + #/.BASTORE _.BASTORE + + #/.SALOAD _.SALOAD + #/.SASTORE _.SASTORE + + #/.IALOAD _.IALOAD + #/.IASTORE _.IASTORE + + #/.LALOAD _.LALOAD + #/.LASTORE _.LASTORE + + #/.FALOAD _.FALOAD + #/.FASTORE _.FASTORE + + #/.DALOAD _.DALOAD + #/.DASTORE _.DASTORE + + #/.CALOAD _.CALOAD + #/.CASTORE _.CASTORE + + #/.AALOAD _.AALOAD + #/.AASTORE _.AASTORE)) + +(def: (object instruction) + (-> /.Object Inst) + (case instruction + (^template [ ] + ( class field-name field-type) + ( class field-name field-type)) + ([#/.GETSTATIC _.GETSTATIC] + [#/.PUTSTATIC _.PUTSTATIC] + [#/.GETFIELD _.GETFIELD] + [#/.PUTFIELD _.PUTFIELD]) + + (#/.NEW type) (_.NEW type) + + (#/.INSTANCEOF type) (_.INSTANCEOF type) + (#/.CHECKCAST type) (_.CHECKCAST type) + + (^template [ ] + ( class method-name method-type) + ( class method-name method-type)) + ([#/.INVOKEINTERFACE _.INVOKEINTERFACE] + [#/.INVOKESPECIAL _.INVOKESPECIAL] + [#/.INVOKESTATIC _.INVOKESTATIC] + [#/.INVOKEVIRTUAL _.INVOKEVIRTUAL]) + )) + +(def: (local-int instruction) + (-> /.Local-Int Inst) + (case instruction + (#/.ILOAD register) (_.ILOAD register) + (#/.ISTORE register) (_.ISTORE register))) + +(def: (local-long instruction) + (-> /.Local-Long Inst) + (case instruction + (#/.LLOAD register) (_.LLOAD register) + (#/.LSTORE register) (_.LSTORE register))) + +(def: (local-float instruction) + (-> /.Local-Float Inst) + (case instruction + (#/.FLOAD register) (_.FLOAD register) + (#/.FSTORE register) (_.FSTORE register))) + +(def: (local-double instruction) + (-> /.Local-Double Inst) + (case instruction + (#/.DLOAD register) (_.DLOAD register) + (#/.DSTORE register) (_.DSTORE register))) + +(def: (local-object instruction) + (-> /.Local-Object Inst) + (case instruction + (#/.ALOAD register) (_.ALOAD register) + (#/.ASTORE register) (_.ASTORE register))) + +(def: (local instruction) + (-> /.Local Inst) + (case instruction + (#/.Local-Int instruction) (..local-int instruction) + (#/.IINC register) (_.IINC register) + (#/.Local-Long instruction) (..local-long instruction) + (#/.Local-Float instruction) (..local-float instruction) + (#/.Local-Double instruction) (..local-double instruction) + (#/.Local-Object instruction) (..local-object instruction))) + +(def: (stack instruction) + (-> /.Stack Inst) + (case instruction + #/.DUP _.DUP + #/.DUP_X1 _.DUP_X1 + #/.DUP_X2 _.DUP_X2 + #/.DUP2 _.DUP2 + #/.DUP2_X1 _.DUP2_X1 + #/.DUP2_X2 _.DUP2_X2 + #/.SWAP _.SWAP + #/.POP _.POP + #/.POP2 _.POP2)) + +(def: (comparison instruction) + (-> /.Comparison Inst) + (case instruction + #/.LCMP _.LCMP + + #/.FCMPG _.FCMPG + #/.FCMPL _.FCMPL + + #/.DCMPG _.DCMPG + #/.DCMPL _.DCMPL)) + +(def: (branching instruction) + (-> (/.Branching org/objectweb/asm/Label) Inst) + (case instruction + (#/.IF_ICMPEQ label) (_.IF_ICMPEQ label) + (#/.IF_ICMPGE label) (_.IF_ICMPGE label) + (#/.IF_ICMPGT label) (_.IF_ICMPGT label) + (#/.IF_ICMPLE label) (_.IF_ICMPLE label) + (#/.IF_ICMPLT label) (_.IF_ICMPLT label) + (#/.IF_ICMPNE label) (_.IF_ICMPNE label) + (#/.IFEQ label) (_.IFEQ label) + (#/.IFGE label) (_.IFGE label) + (#/.IFGT label) (_.IFGT label) + (#/.IFLE label) (_.IFLE label) + (#/.IFLT label) (_.IFLT label) + (#/.IFNE label) (_.IFNE label) + + (#/.TABLESWITCH min max default labels) + (_.TABLESWITCH min max default labels) + + (#/.LOOKUPSWITCH default keys+labels) + (_.LOOKUPSWITCH default keys+labels) + + (#/.IF_ACMPEQ label) (_.IF_ACMPEQ label) + (#/.IF_ACMPNE label) (_.IF_ACMPNE label) + (#/.IFNONNULL label) (_.IFNONNULL label) + (#/.IFNULL label) (_.IFNULL label))) + +(def: (exception instruction) + (-> (/.Exception org/objectweb/asm/Label) Inst) + (case instruction + (#/.Try start end handler exception) (_.try start end handler exception) + #/.ATHROW _.ATHROW)) + +(def: (concurrency instruction) + (-> /.Concurrency Inst) + (case instruction + #/.MONITORENTER _.MONITORENTER + #/.MONITOREXIT _.MONITOREXIT)) + +(def: (return instruction) + (-> /.Return Inst) + (case instruction + #/.RETURN _.RETURN + #/.IRETURN _.IRETURN + #/.LRETURN _.LRETURN + #/.FRETURN _.FRETURN + #/.DRETURN _.DRETURN + #/.ARETURN _.ARETURN)) + +(def: (control instruction) + (-> (/.Control org/objectweb/asm/Label) Inst) + (case instruction + (#/.GOTO label) (_.GOTO label) + (#/.Branching instruction) (..branching instruction) + (#/.Exception instruction) (..exception instruction) + (#/.Concurrency instruction) (..concurrency instruction) + (#/.Return instruction) (..return instruction))) + +(def: (instruction instruction) + (-> (/.Instruction org/objectweb/asm/Label) Inst) + (case instruction + #/.NOP _.NOP + (#/.Constant instruction) (..constant instruction) + (#/.Arithmetic instruction) (..arithmetic instruction) + (#/.Bitwise instruction) (..bitwise instruction) + (#/.Conversion instruction) (..conversion instruction) + (#/.Array instruction) (..array instruction) + (#/.Object instruction) (..object instruction) + (#/.Local instruction) (..local instruction) + (#/.Stack instruction) (..stack instruction) + (#/.Comparison instruction) (..comparison instruction) + (#/.Control instruction) (..control instruction))) + +(type: Mapping + (Dictionary /.Label org/objectweb/asm/Label)) + +(type: (Re-labeler context) + (-> [Mapping (context /.Label)] + [Mapping (context org/objectweb/asm/Label)])) + +(def: (relabel [mapping label]) + (Re-labeler Identity) + (case (dictionary.get label mapping) + (#.Some label) + [mapping label] + + #.None + (let [label' (org/objectweb/asm/Label::new)] + [(dictionary.put label label' mapping) label']))) + +(def: (relabel-branching [mapping instruction]) + (Re-labeler /.Branching) + (case instruction + (^template [] + ( label) + (let [[mapping label] (..relabel [mapping label])] + [mapping ( label)])) + ([#/.IF_ICMPEQ] [#/.IF_ICMPGE] [#/.IF_ICMPGT] [#/.IF_ICMPLE] [#/.IF_ICMPLT] [#/.IF_ICMPNE] + [#/.IFEQ] [#/.IFNE] [#/.IFGE] [#/.IFGT] [#/.IFLE] [#/.IFLT] + + [#/.IF_ACMPEQ] [#/.IF_ACMPNE] [#/.IFNONNULL] [#/.IFNULL]) + + (#/.TABLESWITCH min max default labels) + (let [[mapping default] (..relabel [mapping default]) + [mapping labels] (list@fold (function (_ input [mapping output]) + (let [[mapping input] (..relabel [mapping input])] + [mapping (list& input output)])) + [mapping (list)] labels)] + [mapping (#/.TABLESWITCH min max default (list.reverse labels))]) + + (#/.LOOKUPSWITCH default keys+labels) + (let [[mapping default] (..relabel [mapping default]) + [mapping keys+labels] (list@fold (function (_ [expected input] [mapping output]) + (let [[mapping input] (..relabel [mapping input])] + [mapping (list& [expected input] output)])) + [mapping (list)] keys+labels)] + [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))]) + )) + +(def: (relabel-exception [mapping instruction]) + (Re-labeler /.Exception) + (case instruction + (#/.Try start end handler exception) + (let [[mapping start] (..relabel [mapping start]) + [mapping end] (..relabel [mapping end]) + [mapping handler] (..relabel [mapping handler])] + [mapping (#/.Try start end handler exception)]) + + #/.ATHROW + [mapping #/.ATHROW] + )) + +(def: (relabel-control [mapping instruction]) + (Re-labeler /.Control) + (case instruction + (^template [ ] + ( instruction) + (let [[mapping instruction] ( [mapping instruction])] + [mapping ( instruction)])) + ([#/.GOTO ..relabel] + [#/.Branching ..relabel-branching] + [#/.Exception ..relabel-exception]) + + (^template [] + ( instruction) + [mapping ( instruction)]) + ([#/.Concurrency] [#/.Return]) + )) + +(def: (relabel-instruction [mapping instruction]) + (Re-labeler /.Instruction) + (case instruction + #/.NOP [mapping #/.NOP] + + (^template [] + ( instruction) + [mapping ( instruction)]) + ([#/.Constant] + [#/.Arithmetic] + [#/.Bitwise] + [#/.Conversion] + [#/.Array] + [#/.Object] + [#/.Local] + [#/.Stack] + [#/.Comparison]) + + (#/.Control instruction) + (let [[mapping instruction] (..relabel-control [mapping instruction])] + [mapping (#/.Control instruction)]))) + +(def: (relabel-bytecode [mapping bytecode]) + (Re-labeler /.Bytecode) + (row@fold (function (_ input [mapping output]) + (let [[mapping input] (..relabel-instruction [mapping input])] + [mapping (row.add input output)])) + [mapping (row.row)] + bytecode)) + +(def: fresh + Mapping + (dictionary.new nat.hash)) + +(def: bytecode + (-> (/.Bytecode /.Label) Inst) + (|>> [..fresh] + ..relabel-bytecode + product.right + (row@map ..instruction) + row.to-list + _.fuse)) + +(type: Pseudo-Handler + (-> Text (List Synthesis) (Try (/.Bytecode /.Label)))) + +(def: (true-handler pseudo) + (-> Pseudo-Handler jvm.Handler) + (function (_ extension-name phase archive inputs) + (|> (pseudo extension-name inputs) + (:: try.monad map ..bytecode) + phase.lift))) + +(def: (def::generation extender) + (-> jvm.Extender + (directive.Handler jvm.Anchor jvm.Inst jvm.Definition)) + (function (handler extension-name phase archive inputsC+) + (case inputsC+ + (^ (list nameC valueC)) + (do phase.monad + [[_ _ name] (lux/.evaluate! archive Text nameC) + [_ _ pseudo-handlerV] (lux/.evaluate! archive ..Pseudo-Handler valueC) + _ (|> pseudo-handlerV + (:coerce ..Pseudo-Handler) + ..true-handler + (extension.install extender (:coerce Text name)) + directive.lift-generation) + _ (directive.lift-generation + (generation.log! (format "Generation " (%.text (:coerce Text name)))))] + (wrap directive.no-requirements)) + + _ + (phase.throw extension.invalid-syntax [extension-name %.code inputsC+])))) + +(def: #export (bundle extender) + (-> jvm.Extender + (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition)) + (|> bundle.empty + (dictionary.put "lux def generation" (..def::generation extender)))) diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux new file mode 100644 index 000000000..d957bdb1d --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -0,0 +1,131 @@ +(.module: + [lux (#- Definition Type) + [host (#+ import:)] + [abstract + monad] + [control + ["p" parser + ["s" code]]] + [data + [binary (#+ Binary)] + [collection + ["." list ("#/." functor)]]] + [macro + ["." code] + [syntax (#+ syntax:)]] + [target + [jvm + ["." type (#+ Type) + [category (#+ Class)]]]] + [tool + [compiler + [reference (#+ Register)] + [language + [lux + ["." generation]]] + [meta + [archive (#+ Archive)]]]]]) + +(import: org/objectweb/asm/MethodVisitor) + +(import: org/objectweb/asm/ClassWriter) + +(import: #long org/objectweb/asm/Label + (new [])) + +(type: #export Def + (-> ClassWriter ClassWriter)) + +(type: #export Inst + (-> MethodVisitor MethodVisitor)) + +(type: #export Label + org/objectweb/asm/Label) + +(type: #export Visibility + #Public + #Protected + #Private + #Default) + +(type: #export Version + #V1_1 + #V1_2 + #V1_3 + #V1_4 + #V1_5 + #V1_6 + #V1_7 + #V1_8) + +(type: #export ByteCode Binary) + +(type: #export Definition [Text ByteCode]) + +(type: #export Anchor [Label Register]) + +(type: #export Host + (generation.Host Inst Definition)) + +(template [ ] + [(type: #export + ( ..Anchor Inst Definition))] + + [State generation.State] + [Operation generation.Operation] + [Phase generation.Phase] + [Handler generation.Handler] + [Bundle generation.Bundle] + [Extender generation.Extender] + ) + +(type: #export (Generator i) + (-> Phase Archive i (Operation Inst))) + +(syntax: (config: {type s.local-identifier} + {none s.local-identifier} + {++ s.local-identifier} + {options (s.tuple (p.many s.local-identifier))}) + (let [g!type (code.local-identifier type) + g!none (code.local-identifier none) + g!tags+ (list/map code.local-tag options) + g!_left (code.local-identifier "_left") + g!_right (code.local-identifier "_right") + g!options+ (list/map (function (_ option) + (` (def: (~' #export) (~ (code.local-identifier option)) + (~ g!type) + (|> (~ g!none) + (set@ (~ (code.local-tag option)) #1))))) + options)] + (wrap (list& (` (type: (~' #export) (~ g!type) + (~ (code.record (list/map (function (_ tag) + [tag (` .Bit)]) + g!tags+))))) + + (` (def: (~' #export) (~ g!none) + (~ g!type) + (~ (code.record (list/map (function (_ tag) + [tag (` #0)]) + g!tags+))))) + + (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right)) + (-> (~ g!type) (~ g!type) (~ g!type)) + (~ (code.record (list/map (function (_ tag) + [tag (` (or (get@ (~ tag) (~ g!_left)) + (get@ (~ tag) (~ g!_right))))]) + g!tags+))))) + + g!options+)))) + +(config: Class-Config noneC ++C [finalC]) +(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM]) +(config: Field-Config noneF ++F [finalF staticF transientF volatileF]) + +(def: #export new-label + (-> Any Label) + (function (_ _) + (org/objectweb/asm/Label::new))) + +(def: #export (simple-class name) + (-> Text (Type Class)) + (type.class name (list))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux new file mode 100644 index 000000000..f274da61f --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -0,0 +1,298 @@ +(.module: + [lux (#- Type) + ["." host (#+ import: do-to)] + [control + ["." function]] + [data + ["." product] + [number + ["i" int]] + ["." text + ["%" format (#+ format)]] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [target + [jvm + [encoding + ["." name]] + ["." type (#+ Type Constraint) + [category (#+ Class Value Method)] + ["." signature] + ["." descriptor]]]]] + ["." //]) + +(def: signature (|>> type.signature signature.signature)) +(def: descriptor (|>> type.descriptor descriptor.descriptor)) +(def: class-name (|>> type.descriptor descriptor.class-name name.read)) + +(import: #long java/lang/Object) +(import: #long java/lang/String) + +(import: org/objectweb/asm/Opcodes + (#static ACC_PUBLIC int) + (#static ACC_PROTECTED int) + (#static ACC_PRIVATE int) + + (#static ACC_TRANSIENT int) + (#static ACC_VOLATILE int) + + (#static ACC_ABSTRACT int) + (#static ACC_FINAL int) + (#static ACC_STATIC int) + (#static ACC_SYNCHRONIZED int) + (#static ACC_STRICT int) + + (#static ACC_SUPER int) + (#static ACC_INTERFACE int) + + (#static V1_1 int) + (#static V1_2 int) + (#static V1_3 int) + (#static V1_4 int) + (#static V1_5 int) + (#static V1_6 int) + (#static V1_7 int) + (#static V1_8 int) + ) + +(import: org/objectweb/asm/FieldVisitor + (visitEnd [] void)) + +(import: org/objectweb/asm/MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void)) + +(import: org/objectweb/asm/ClassWriter + (#static COMPUTE_MAXS int) + (#static COMPUTE_FRAMES int) + (new [int]) + (visit [int int String String String [String]] void) + (visitEnd [] void) + (visitField [int String String String Object] FieldVisitor) + (visitMethod [int String String String [String]] MethodVisitor) + (toByteArray [] [byte])) + +(def: (string-array values) + (-> (List Text) (Array Text)) + (let [output (host.array String (list.size values))] + (exec (list@map (function (_ [idx value]) + (host.array-write idx value output)) + (list.enumerate values)) + output))) + +(def: (version-flag version) + (-> //.Version Int) + (case version + #//.V1_1 (Opcodes::V1_1) + #//.V1_2 (Opcodes::V1_2) + #//.V1_3 (Opcodes::V1_3) + #//.V1_4 (Opcodes::V1_4) + #//.V1_5 (Opcodes::V1_5) + #//.V1_6 (Opcodes::V1_6) + #//.V1_7 (Opcodes::V1_7) + #//.V1_8 (Opcodes::V1_8))) + +(def: (visibility-flag visibility) + (-> //.Visibility Int) + (case visibility + #//.Public (Opcodes::ACC_PUBLIC) + #//.Protected (Opcodes::ACC_PROTECTED) + #//.Private (Opcodes::ACC_PRIVATE) + #//.Default +0)) + +(def: (class-flags config) + (-> //.Class-Config Int) + ($_ i.+ + (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0))) + +(def: (method-flags config) + (-> //.Method-Config Int) + ($_ i.+ + (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0))) + +(def: (field-flags config) + (-> //.Field-Config Int) + ($_ i.+ + (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0) + (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0) + (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0) + (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0))) + +(def: param-signature + (-> (Type Class) Text) + (|>> ..signature (format ":"))) + +(def: (formal-param [name super interfaces]) + (-> Constraint Text) + (format name + (param-signature super) + (|> interfaces + (list@map param-signature) + (text.join-with "")))) + +(def: (constraints-signature constraints super interfaces) + (-> (List Constraint) (Type Class) (List (Type Class)) + Text) + (let [formal-params (if (list.empty? constraints) + "" + (format "<" + (|> constraints + (list@map formal-param) + (text.join-with "")) + ">"))] + (format formal-params + (..signature super) + (|> interfaces + (list@map ..signature) + (text.join-with ""))))) + +(def: class-computes + Int + ($_ i.+ + (ClassWriter::COMPUTE_MAXS) + ## (ClassWriter::COMPUTE_FRAMES) + )) + +(def: binary-name (|>> name.internal name.read)) + +(template [ ] + [(def: #export ( version visibility config name constraints super interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints super interfaces) + (..class-name super) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer)))] + + [class +0] + [abstract (Opcodes::ACC_ABSTRACT)] + ) + +(def: $Object + (Type Class) + (type.class "java.lang.Object" (list))) + +(def: #export (interface version visibility config name constraints interfaces + definitions) + (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def + (host.type [byte])) + (let [writer (|> (do-to (ClassWriter::new class-computes) + (ClassWriter::visit (version-flag version) + ($_ i.+ + (Opcodes::ACC_SUPER) + (Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + (..binary-name name) + (constraints-signature constraints $Object interfaces) + (..class-name $Object) + (|> interfaces + (list@map ..class-name) + string-array))) + definitions) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer))) + +(def: #export (method visibility config name type then) + (-> //.Visibility //.Method-Config Text (Type Method) //.Inst + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitCode =method) + _ (then =method) + _ (MethodVisitor::visitMaxs +0 +0 =method) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (abstract-method visibility config name type) + (-> //.Visibility //.Method-Config Text (Type Method) + //.Def) + (function (_ writer) + (let [=method (ClassWriter::visitMethod ($_ i.+ + (visibility-flag visibility) + (method-flags config) + (Opcodes::ACC_ABSTRACT)) + (..binary-name name) + (..descriptor type) + (..signature type) + (string-array (list)) + writer) + _ (MethodVisitor::visitEnd =method)] + writer))) + +(def: #export (field visibility config name type) + (-> //.Visibility //.Field-Config Text (Type Value) //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor type) + (..signature type) + (host.null) + writer) + (FieldVisitor::visitEnd))] + writer))) + +(template [ ] + [(def: #export ( visibility config name value) + (-> //.Visibility //.Field-Config Text //.Def) + (function (_ writer) + (let [=field (do-to (ClassWriter::visitField ($_ i.+ + (visibility-flag visibility) + (field-flags config)) + (..binary-name name) + (..descriptor ) + (..signature ) + ( value) + writer) + (FieldVisitor::visitEnd))] + writer)))] + + [boolean-field Bit type.boolean function.identity] + [byte-field Int type.byte host.long-to-byte] + [short-field Int type.short host.long-to-short] + [int-field Int type.int host.long-to-int] + [long-field Int type.long function.identity] + [float-field Frac type.float host.double-to-float] + [double-field Frac type.double function.identity] + [char-field Nat type.char (|>> .int host.long-to-int host.int-to-char)] + [string-field Text (type.class "java.lang.String" (list)) function.identity] + ) + +(def: #export (fuse defs) + (-> (List //.Def) //.Def) + (case defs + #.Nil + function.identity + + (#.Cons singleton #.Nil) + singleton + + (#.Cons head tail) + (function.compose (fuse tail) head))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux new file mode 100644 index 000000000..b673c7d7e --- /dev/null +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -0,0 +1,464 @@ +(.module: + [lux (#- Type int char) + ["." host (#+ import: do-to)] + [abstract + [monad (#+ do)]] + [control + ["." function] + ["." try] + ["p" parser + ["s" code]]] + [data + ["." product] + ["." maybe] + [number + ["n" nat] + ["i" int]] + [collection + ["." list ("#@." functor)]]] + [macro + ["." code] + ["." template] + [syntax (#+ syntax:)]] + [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)) +(def: descriptor (|>> type.descriptor descriptor.descriptor)) +(def: reflection (|>> type.reflection reflection.reflection)) + +## [Host] +(import: #long java/lang/Object) +(import: #long java/lang/String) + +(syntax: (declare {codes (p.many s.local-identifier)}) + (|> codes + (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int))))) + wrap)) + +(`` (import: #long org/objectweb/asm/Opcodes + (#static NOP int) + + ## Conversion + (~~ (declare D2F D2I D2L + F2D F2I F2L + I2B I2C I2D I2F I2L I2S + L2D L2F L2I)) + + ## Primitive + (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE + T_BYTE T_SHORT T_INT T_LONG)) + + ## Class + (~~ (declare CHECKCAST NEW INSTANCEOF)) + + ## Stack + (~~ (declare DUP DUP_X1 DUP_X2 + DUP2 DUP2_X1 DUP2_X2 + POP POP2 + SWAP)) + + ## Jump + (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT + IF_ICMPNE IF_ICMPGE IF_ICMPLE + IF_ACMPEQ IF_ACMPNE IFNULL IFNONNULL + IFEQ IFNE IFLT IFLE IFGT IFGE + GOTO)) + + (~~ (declare BIPUSH SIPUSH)) + (~~ (declare 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)) + (#static ACONST_NULL int) + + ## Var + (~~ (declare IINC + ILOAD LLOAD FLOAD DLOAD ALOAD + ISTORE LSTORE FSTORE DSTORE ASTORE)) + + ## Arithmetic + (~~ (declare IADD ISUB IMUL IDIV IREM INEG + LADD LSUB LMUL LDIV LREM LNEG LCMP + FADD FSUB FMUL FDIV FREM FNEG FCMPG FCMPL + DADD DSUB DMUL DDIV DREM DNEG DCMPG DCMPL)) + + ## Bit-wise + (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR + LAND LOR LXOR LSHL LSHR LUSHR)) + + ## Array + (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY + AALOAD AASTORE + BALOAD BASTORE + SALOAD SASTORE + IALOAD IASTORE + LALOAD LASTORE + FALOAD FASTORE + DALOAD DASTORE + CALOAD CASTORE)) + + ## Member + (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD + INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE)) + + (#static ATHROW int) + + ## Concurrency + (~~ (declare MONITORENTER MONITOREXIT)) + + ## Return + (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN)) + )) + +(import: #long org/objectweb/asm/Label + (new [])) + +(import: #long org/objectweb/asm/MethodVisitor + (visitCode [] void) + (visitMaxs [int int] void) + (visitEnd [] void) + (visitInsn [int] void) + (visitLdcInsn [java/lang/Object] void) + (visitFieldInsn [int java/lang/String java/lang/String java/lang/String] void) + (visitTypeInsn [int java/lang/String] void) + (visitVarInsn [int int] void) + (visitIntInsn [int int] void) + (visitMethodInsn [int java/lang/String java/lang/String java/lang/String boolean] void) + (visitLabel [org/objectweb/asm/Label] void) + (visitJumpInsn [int org/objectweb/asm/Label] void) + (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void) + (visitLookupSwitchInsn [org/objectweb/asm/Label [int] [org/objectweb/asm/Label]] void) + (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void) + ) + +## [Insts] +(def: #export make-label + (All [s] (Operation s org/objectweb/asm/Label)) + (function (_ state) + (#try.Success [state (org/objectweb/asm/Label::new)]))) + +(def: #export (with-label action) + (All [a] (-> (-> org/objectweb/asm/Label a) a)) + (action (org/objectweb/asm/Label::new))) + +(template [ ] + [(def: #export ( value) + (-> Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLdcInsn ( value)))))] + + [boolean Bit function.identity] + [int Int host.long-to-int] + [long Int function.identity] + [double Frac function.identity] + [char Nat (|>> .int host.long-to-int host.int-to-char)] + [string Text function.identity] + ) + +(template: (!prefix short) + (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short]))))) + +(template [] + [(def: #export + Inst + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))] + + [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] + ) + +(def: #export NULL + Inst + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL))))) + +(template [] + [(def: #export ( constant) + (-> Int Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix ) constant))))] + + [BIPUSH] + [SIPUSH] + ) + +(template [] + [(def: #export + Inst + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))] + + [NOP] + + ## Stack + [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2] + [POP] [POP2] + [SWAP] + + ## Conversions + [D2F] [D2I] [D2L] + [F2D] [F2I] [F2L] + [I2B] [I2C] [I2D] [I2F] [I2L] [I2S] + [L2D] [L2F] [L2I] + + ## Integer arithmetic + [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG] + + ## Integer bitwise + [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR] + + ## Long arithmetic + [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG] + [LCMP] + + ## Long bitwise + [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] + + ## Float arithmetic + [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL] + + ## Double arithmetic + [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG] + [DCMPG] [DCMPL] + + ## Array + [ARRAYLENGTH] + [AALOAD] [AASTORE] + [BALOAD] [BASTORE] + [SALOAD] [SASTORE] + [IALOAD] [IASTORE] + [LALOAD] [LASTORE] + [FALOAD] [FASTORE] + [DALOAD] [DASTORE] + [CALOAD] [CASTORE] + + ## Exceptions + [ATHROW] + + ## Concurrency + [MONITORENTER] [MONITOREXIT] + + ## Return + [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN] + ) + +(type: #export Register Nat) + +(template [] + [(def: #export ( register) + (-> Register Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix ) (.int register)))))] + + [IINC] + [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD] + [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE] + ) + +(template [ ] + [(def: #export ( class field type) + (-> (Type Class) Text (Type Value) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitFieldInsn () (..class-name class) field (..descriptor type)))))] + + [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC] + [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC] + + [PUTFIELD org/objectweb/asm/Opcodes::PUTFIELD] + [GETFIELD org/objectweb/asm/Opcodes::GETFIELD] + ) + +(template [ +] + [(`` (template [ ] + [(def: #export ( class) + (-> (Type ) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTypeInsn () (..class-name class)))))] + + (~~ (template.splice +))))] + + [Object + [[CHECKCAST org/objectweb/asm/Opcodes::CHECKCAST] + [ANEWARRAY org/objectweb/asm/Opcodes::ANEWARRAY]]] + + [Class + [[NEW org/objectweb/asm/Opcodes::NEW] + [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]] + ) + +(def: #export (NEWARRAY type) + (-> (Type Primitive) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY) + (`` (cond (~~ (template [ ] + [(type@= type) ()] + + [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN] + [type.byte org/objectweb/asm/Opcodes::T_BYTE] + [type.short org/objectweb/asm/Opcodes::T_SHORT] + [type.int org/objectweb/asm/Opcodes::T_INT] + [type.long org/objectweb/asm/Opcodes::T_LONG] + [type.float org/objectweb/asm/Opcodes::T_FLOAT] + [type.double org/objectweb/asm/Opcodes::T_DOUBLE] + [type.char org/objectweb/asm/Opcodes::T_CHAR])) + ## else + (undefined))))))) + +(template [ ] + [(def: #export ( class method-name method) + (-> (Type Class) Text (Type Method) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitMethodInsn () + (..class-name class) + method-name + (|> method type.descriptor descriptor.descriptor) + ))))] + + [INVOKESTATIC org/objectweb/asm/Opcodes::INVOKESTATIC false] + [INVOKEVIRTUAL org/objectweb/asm/Opcodes::INVOKEVIRTUAL false] + [INVOKESPECIAL org/objectweb/asm/Opcodes::INVOKESPECIAL false] + [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE true] + ) + +(template [] + [(def: #export ( @where) + (-> //.Label Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix ) @where))))] + + [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] + [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE] + [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL] + [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] + [GOTO] + ) + +(def: #export (LOOKUPSWITCH default keys+labels) + (-> //.Label (List [Int //.Label]) Inst) + (function (_ visitor) + (let [keys+labels (list.sort (function (_ left right) + (i.< (product.left left) (product.left right))) + keys+labels) + array-size (list.size keys+labels) + keys-array (host.array int array-size) + labels-array (host.array org/objectweb/asm/Label array-size) + _ (loop [idx 0] + (if (n.< array-size idx) + (let [[key label] (maybe.assume (list.nth idx keys+labels))] + (exec + (host.array-write idx (host.long-to-int key) keys-array) + (host.array-write idx label labels-array) + (recur (inc idx)))) + []))] + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array))))) + +(def: #export (TABLESWITCH min max default labels) + (-> Int Int //.Label (List //.Label) Inst) + (function (_ visitor) + (let [num-labels (list.size labels) + labels-array (host.array org/objectweb/asm/Label num-labels) + _ (loop [idx 0] + (if (n.< num-labels idx) + (exec (host.array-write idx + (maybe.assume (list.nth idx labels)) + labels-array) + (recur (inc idx))) + []))] + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array))))) + +(def: #export (try @from @to @handler exception) + (-> //.Label //.Label //.Label (Type Class) Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception))))) + +(def: #export (label @label) + (-> //.Label Inst) + (function (_ visitor) + (do-to visitor + (org/objectweb/asm/MethodVisitor::visitLabel @label)))) + +(def: #export (array elementT) + (-> (Type Value) Inst) + (case (type.primitive? elementT) + (#.Left elementT) + (ANEWARRAY elementT) + + (#.Right elementT) + (NEWARRAY elementT))) + +(template [ ] + [(def: ( type) + (-> (Type Primitive) Text) + (`` (cond (~~ (template [ ] + [(type@= type) ] + + [type.boolean ] + [type.byte ] + [type.short ] + [type.int ] + [type.long ] + [type.float ] + [type.double ] + [type.char ])) + ## else + (undefined))))] + + [primitive-wrapper + box.boolean box.byte box.short box.int + box.long box.float box.double box.char] + [primitive-unwrap + "booleanValue" "byteValue" "shortValue" "intValue" + "longValue" "floatValue" "doubleValue" "charValue"] + ) + +(def: #export (wrap type) + (-> (Type Primitive) Inst) + (let [wrapper (type.class (primitive-wrapper type) (list))] + (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)])))) + +(def: #export (unwrap type) + (-> (Type Primitive) Inst) + (let [wrapper (type.class (primitive-wrapper type) (list))] + (|>> (CHECKCAST wrapper) + (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)]))))) + +(def: #export (fuse insts) + (-> (List Inst) Inst) + (case insts + #.Nil + function.identity + + (#.Cons singleton #.Nil) + singleton + + (#.Cons head tail) + (function.compose (fuse tail) head))) diff --git a/lux-jvm/source/luxc/lang/synthesis/variable.lux b/lux-jvm/source/luxc/lang/synthesis/variable.lux new file mode 100644 index 000000000..f6a45b02e --- /dev/null +++ b/lux-jvm/source/luxc/lang/synthesis/variable.lux @@ -0,0 +1,98 @@ +(.module: + lux + (lux (data [number] + (coll [list "list/" Fold Monoid] + ["s" set]))) + (luxc (lang ["la" analysis] + ["ls" synthesis] + [".L" variable #+ Variable]))) + +(def: (bound-vars path) + (-> ls.Path (List Variable)) + (case path + (#ls.BindP register) + (list (.int register)) + + (^or (#ls.SeqP pre post) (#ls.AltP pre post)) + (list/compose (bound-vars pre) (bound-vars post)) + + _ + (list))) + +(def: (path-bodies path) + (-> ls.Path (List ls.Synthesis)) + (case path + (#ls.ExecP body) + (list body) + + (#ls.SeqP pre post) + (path-bodies post) + + (#ls.AltP pre post) + (list/compose (path-bodies pre) (path-bodies post)) + + _ + (list))) + +(def: (non-arg? arity var) + (-> ls.Arity Variable Bit) + (and (variableL.local? var) + (n/> arity (.nat var)))) + +(type: Tracker (s.Set Variable)) + +(def: init-tracker Tracker (s.new number.Hash)) + +(def: (unused-vars current-arity bound exprS) + (-> ls.Arity (List Variable) ls.Synthesis (List Variable)) + (let [tracker (loop [exprS exprS + tracker (list/fold s.add init-tracker bound)] + (case exprS + (#ls.Variable var) + (if (non-arg? current-arity var) + (s.remove var tracker) + tracker) + + (#ls.Variant tag last? memberS) + (recur memberS tracker) + + (#ls.Tuple membersS) + (list/fold recur tracker membersS) + + (#ls.Call funcS argsS) + (list/fold recur (recur funcS tracker) argsS) + + (^or (#ls.Recur argsS) + (#ls.Procedure name argsS)) + (list/fold recur tracker argsS) + + (#ls.Let offset inputS outputS) + (|> tracker (recur inputS) (recur outputS)) + + (#ls.If testS thenS elseS) + (|> tracker (recur testS) (recur thenS) (recur elseS)) + + (#ls.Loop offset initsS bodyS) + (recur bodyS (list/fold recur tracker initsS)) + + (#ls.Case inputS outputPS) + (let [tracker' (list/fold s.add + (recur inputS tracker) + (bound-vars outputPS))] + (list/fold recur tracker' (path-bodies outputPS))) + + (#ls.Function arity env bodyS) + (list/fold s.remove tracker env) + + _ + tracker + ))] + (s.to-list tracker))) + +## (def: (optimize-register-use current-arity [pathS bodyS]) +## (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis]) +## (let [bound (bound-vars pathS) +## unused (unused-vars current-arity bound bodyS) +## adjusted (adjust-vars unused bound)] +## [(|> pathS (clean-pattern adjusted) simplify-pattern) +## (clean-expression adjusted bodyS)])) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux new file mode 100644 index 000000000..141e70184 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -0,0 +1,182 @@ +(.module: + [lux (#- Module Definition) + ["." host (#+ 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 + ["." generation]]] + ["." meta + [io (#+ lux-context)] + [archive + [descriptor (#+ Module)] + ["." artifact]]]]]] + [/// + [host + ["." jvm (#+ Inst Definition Host State) + ["." def] + ["." inst]]]] + ) + +(import: #long java/lang/reflect/Field + (get [#? java/lang/Object] #try #? java/lang/Object)) + +(import: #long (java/lang/Class a) + (getField [java/lang/String] #try java/lang/reflect/Field)) + +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) + +(import: #long java/lang/ClassLoader) + +(type: #export ByteCode Binary) + +(def: #export value-field Text "_value") +(def: #export $Value (type.class "java.lang.Object" (list))) + +(exception: #export (cannot-load {class Text} {error Text}) + (exception.report + ["Class" class] + ["Error" error])) + +(exception: #export (invalid-field {class Text} {field Text} {error Text}) + (exception.report + ["Class" class] + ["Field" field] + ["Error" error])) + +(exception: #export (invalid-value {class Text}) + (exception.report + ["Class" class])) + +(def: (class-value class-name class) + (-> Text (java/lang/Class java/lang/Object) (Try Any)) + (case (java/lang/Class::getField ..value-field class) + (#try.Success field) + (case (java/lang/reflect/Field::get #.None field) + (#try.Success ?value) + (case ?value + (#.Some value) + (#try.Success value) + + #.None + (exception.throw ..invalid-value class-name)) + + (#try.Failure error) + (exception.throw ..cannot-load [class-name error])) + + (#try.Failure error) + (exception.throw ..invalid-field [class-name ..value-field error]))) + +(def: class-path-separator ".") + +(def: #export bytecode-name + (-> Text Text) + (text.replace-all ..class-path-separator .module-separator)) + +(def: #export (class-name [module-id artifact-id]) + (-> generation.Context Text) + (format lux-context + ..class-path-separator (%.nat meta.version) + ..class-path-separator (%.nat module-id) + ..class-path-separator (%.nat artifact-id))) + +(def: (evaluate! library loader eval-class valueI) + (-> Library java/lang/ClassLoader Text Inst (Try [Any Definition])) + (let [bytecode-name (..bytecode-name eval-class) + bytecode (def.class #jvm.V1_6 + #jvm.Public jvm.noneC + bytecode-name + (list) $Value + (list) + (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) + ..value-field ..$Value) + (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) + "" + (type.method [(list) type.void (list)]) + (|>> valueI + (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value) + inst.RETURN))))] + (io.run (do (try.with io.monad) + [_ (loader.store eval-class bytecode library) + class (loader.load eval-class loader) + value (:: io.monad wrap (..class-value eval-class class))] + (wrap [value + [eval-class bytecode]]))))) + +(def: (execute! library loader temp-label [class-name class-bytecode]) + (-> Library java/lang/ClassLoader Text Definition (Try Any)) + (io.run (do (try.with io.monad) + [existing-class? (|> (atom.read library) + (:: io.monad map (dictionary.contains? class-name)) + (try.lift io.monad) + (: (IO (Try Bit)))) + _ (if existing-class? + (wrap []) + (loader.store class-name class-bytecode library))] + (loader.load class-name loader)))) + +(def: (define! library loader context valueI) + (-> Library java/lang/ClassLoader generation.Context Inst (Try [Text Any Definition])) + (let [class-name (..class-name context)] + (do try.monad + [[value definition] (evaluate! library loader class-name valueI)] + (wrap [class-name value definition])))) + +(def: #export host + (IO Host) + (io (let [library (loader.new-library []) + loader (loader.memory library)] + (: Host + (structure + (def: (evaluate! temp-label valueI) + (:: try.monad map product.left + (..evaluate! library loader (text.replace-all " " "$" temp-label) valueI))) + + (def: execute! + (..execute! library loader)) + + (def: define! + (..define! library loader)) + + (def: (ingest context bytecode) + [(..class-name context) bytecode]) + + (def: (re-learn context [_ bytecode]) + (io.run + (loader.store (..class-name context) bytecode library))) + + (def: (re-load context [_ bytecode]) + (io.run + (do (try.with io.monad) + [#let [class-name (..class-name context)] + _ (loader.store class-name bytecode library) + class (loader.load class-name loader)] + (:: io.monad wrap (..class-value class-name class)))))))))) + +(def: #export $Variant (type.array ..$Value)) +(def: #export $Tuple (type.array ..$Value)) +(def: #export $Runtime (type.class (..class-name [0 0]) (list))) +(def: #export $Function (type.class (..class-name [0 1]) (list))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux new file mode 100644 index 000000000..0d8aaa91e --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -0,0 +1,239 @@ +(.module: + [lux (#- Type if let case) + [abstract + [monad (#+ do)]] + [control + ["." function] + ["ex" exception (#+ exception:)]] + [data + [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 + ["$" jvm (#+ Label Inst Operation Phase Generator) + ["_" inst]]]]] + ["." // + ["." runtime]]) + +(def: (pop-altI stack-depth) + (-> Nat Inst) + (.case stack-depth + 0 function.identity + 1 _.POP + 2 _.POP2 + _ ## (n.> 2) + (|>> _.POP2 + (pop-altI (n.- 2 stack-depth))))) + +(def: peekI + Inst + (|>> _.DUP + (_.int +0) + _.AALOAD)) + +(def: pushI + Inst + (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list runtime.$Stack //.$Value) runtime.$Stack (list)]))) + +(def: popI + (|>> (_.int +1) + _.AALOAD + (_.CHECKCAST runtime.$Stack))) + +(def: (path' stack-depth @else @end phase archive path) + (-> Nat Label Label Phase Archive Path (Operation Inst)) + (.case path + #synthesis.Pop + (operation@wrap ..popI) + + (#synthesis.Bind register) + (operation@wrap (|>> peekI + (_.ASTORE register))) + + (^ (synthesis.path/bit value)) + (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] + (|>> peekI + (_.unwrap type.boolean) + (jumpI @else)))) + + (^ (synthesis.path/i64 value)) + (operation@wrap (|>> peekI + (_.unwrap type.long) + (_.long (.int value)) + _.LCMP + (_.IFNE @else))) + + (^ (synthesis.path/f64 value)) + (operation@wrap (|>> peekI + (_.unwrap type.double) + (_.double value) + _.DCMPL + (_.IFNE @else))) + + (^ (synthesis.path/text value)) + (operation@wrap (|>> peekI + (_.string value) + (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) + "equals" + (type.method [(list //.$Value) type.boolean (list)])) + (_.IFEQ @else))) + + (#synthesis.Then bodyS) + (do phase.monad + [bodyI (phase archive bodyS)] + (wrap (|>> (pop-altI stack-depth) + bodyI + (_.GOTO @end)))) + + (^template [ ] + (^ ( idx)) + (operation@wrap (<| _.with-label (function (_ @success)) + _.with-label (function (_ @fail)) + (|>> peekI + (_.CHECKCAST //.$Variant) + (_.int (.int ( idx))) + + (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) + pushI)))) + ([synthesis.side/left _.NULL function.identity] + [synthesis.side/right (_.string "") .inc]) + + (^ (synthesis.member/left lefts)) + (operation@wrap (.let [accessI (.case lefts + 0 + _.AALOAD + + lefts + (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))] + (|>> peekI + (_.CHECKCAST //.$Tuple) + (_.int (.int lefts)) + accessI + pushI))) + + (^ (synthesis.member/right lefts)) + (operation@wrap (|>> peekI + (_.CHECKCAST //.$Tuple) + (_.int (.int lefts)) + (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])) + pushI)) + + ## Extra optimization + (^ (synthesis.path/seq + (synthesis.member/left 0) + (synthesis.!bind-top register thenP))) + (do phase.monad + [then! (path' stack-depth @else @end phase archive thenP)] + (wrap (|>> peekI + (_.CHECKCAST //.$Tuple) + (_.int +0) + _.AALOAD + (_.ASTORE register) + then!))) + + ## Extra optimization + (^template [ ] + (^ (synthesis.path/seq + ( lefts) + (synthesis.!bind-top register thenP))) + (do phase.monad + [then! (path' stack-depth @else @end phase archive thenP)] + (wrap (|>> peekI + (_.CHECKCAST //.$Tuple) + (_.int (.int lefts)) + (_.INVOKESTATIC //.$Runtime (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])) + (_.ASTORE register) + then!)))) + ([synthesis.member/left "tuple_left"] + [synthesis.member/right "tuple_right"]) + + (#synthesis.Alt leftP rightP) + (do phase.monad + [@alt-else _.make-label + leftI (path' (inc stack-depth) @alt-else @end phase archive leftP) + rightI (path' stack-depth @else @end phase archive rightP)] + (wrap (|>> _.DUP + leftI + (_.label @alt-else) + _.POP + rightI))) + + (#synthesis.Seq leftP rightP) + (do phase.monad + [leftI (path' stack-depth @else @end phase archive leftP) + rightI (path' stack-depth @else @end phase archive rightP)] + (wrap (|>> leftI + rightI))) + )) + +(def: (path @end phase archive path) + (-> Label Phase Archive Path (Operation Inst)) + (do phase.monad + [@else _.make-label + pathI (..path' 1 @else @end phase archive path)] + (wrap (|>> pathI + (_.label @else) + _.POP + (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) type.void (list)])) + _.NULL + (_.GOTO @end))))) + +(def: #export (if phase archive [testS thenS elseS]) + (Generator [Synthesis Synthesis Synthesis]) + (do phase.monad + [testI (phase archive testS) + thenI (phase archive thenS) + elseI (phase archive elseS)] + (wrap (<| _.with-label (function (_ @else)) + _.with-label (function (_ @end)) + (|>> testI + (_.unwrap type.boolean) + (_.IFEQ @else) + thenI + (_.GOTO @end) + (_.label @else) + elseI + (_.label @end)))))) + +(def: #export (let phase archive [inputS register exprS]) + (Generator [Synthesis Nat Synthesis]) + (do phase.monad + [inputI (phase archive inputS) + exprI (phase archive exprS)] + (wrap (|>> inputI + (_.ASTORE register) + exprI)))) + +(def: #export (case phase archive [valueS path]) + (Generator [Synthesis Path]) + (do phase.monad + [@end _.make-label + valueI (phase archive valueS) + pathI (..path @end phase archive path)] + (wrap (|>> _.NULL + valueI + pushI + pathI + (_.label @end))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/common.lux new file mode 100644 index 000000000..6cd7f4f2f --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/common.lux @@ -0,0 +1,72 @@ +(.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]]] + ] + ## [luxc + ## [lang + ## [host + ## ["." jvm + ## [type]]]]] + ) + +## (def: #export (with-artifacts action) +## (All [a] (-> (Meta a) (Meta [Artifacts a]))) +## (function (_ state) +## (case (action (update@ #.host +## (|>> (:coerce Host) +## (set@ #artifacts (dictionary.new text.hash)) +## (:coerce Nothing)) +## state)) +## (#try.Success [state' output]) +## (#try.Success [(update@ #.host +## (|>> (:coerce Host) +## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts))) +## (:coerce Nothing)) +## state') +## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts)) +## output]]) + +## (#try.Failure error) +## (#try.Failure error)))) + +## (def: #export (load-definition state) +## (-> Lux (-> Name Binary (Try Any))) +## (function (_ (^@ def-name [def-module def-name]) def-bytecode) +## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name))) +## class-name (format (text.replace-all "/" "." def-module) "." normal-name)] +## (<| (macro.run state) +## (do macro.monad +## [_ (..store-class class-name def-bytecode) +## class (..load-class class-name)] +## (case (do try.monad +## [field (Class::getField [..value-field] class)] +## (Field::get [#.None] field)) +## (#try.Success (#.Some def-value)) +## (wrap def-value) + +## (#try.Success #.None) +## (phase.throw invalid-definition-value (%name def-name)) + +## (#try.Failure error) +## (phase.throw cannot-load-definition +## (format "Definition: " (%name def-name) "\n" +## "Error:\n" +## error)))))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux new file mode 100644 index 000000000..144e35f9b --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux @@ -0,0 +1,72 @@ +(.module: + [lux #* + [tool + [compiler + [language + [lux + ["." synthesis] + [phase + ["." extension]]]]]]] + [luxc + [lang + [host + [jvm (#+ Phase)]]]] + [// + ["." common] + ["." primitive] + ["." structure] + ["." reference] + ["." case] + ["." loop] + ["." function]]) + +(def: #export (translate archive synthesis) + Phase + (case synthesis + (^ (synthesis.bit value)) + (primitive.bit value) + + (^ (synthesis.i64 value)) + (primitive.i64 value) + + (^ (synthesis.f64 value)) + (primitive.f64 value) + + (^ (synthesis.text value)) + (primitive.text value) + + (^ (synthesis.variant data)) + (structure.variant translate archive data) + + (^ (synthesis.tuple members)) + (structure.tuple translate archive members) + + (^ (synthesis.variable variable)) + (reference.variable archive variable) + + (^ (synthesis.constant constant)) + (reference.constant archive constant) + + (^ (synthesis.branch/let data)) + (case.let translate archive data) + + (^ (synthesis.branch/if data)) + (case.if translate archive data) + + (^ (synthesis.branch/case data)) + (case.case translate archive data) + + (^ (synthesis.loop/recur data)) + (loop.recur translate archive data) + + (^ (synthesis.loop/scope data)) + (loop.scope translate archive data) + + (^ (synthesis.function/apply data)) + (function.call translate archive data) + + (^ (synthesis.function/abstraction data)) + (function.function translate archive data) + + (#synthesis.Extension extension) + (extension.apply archive translate extension))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux new file mode 100644 index 000000000..9066dd156 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux @@ -0,0 +1,16 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [//// + [host + [jvm (#+ Bundle)]]] + ["." / #_ + ["#." common] + ["#." host]]) + +(def: #export bundle + Bundle + (dictionary.merge /common.bundle + /host.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 new file mode 100644 index 000000000..383415c0a --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -0,0 +1,388 @@ +(.module: + [lux (#- Type) + [abstract + ["." monad (#+ do)]] + [control + ["." try] + ["<>" parser + ["" synthesis (#+ Parser)]]] + [data + ["." product] + [number + ["f" frac]] + [collection + ["." list ("#@." monad)] + ["." dictionary]]] + [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]]]]]]] + [host (#+ import:)]] + [luxc + [lang + [host + ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase) + ["_" inst]]]]] + ["." /// + ["." runtime]]) + +(def: #export (custom [parser handler]) + (All [s] + (-> [(Parser s) + (-> Text Phase Archive s (Operation Inst))] + Handler)) + (function (_ extension-name phase archive input) + (case (.run parser input) + (#try.Success input') + (handler extension-name phase archive input') + + (#try.Failure error) + (phase.throw extension.invalid-syntax [extension-name %synthesis input])))) + +(import: java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double)) + +(def: $String (type.class "java.lang.String" (list))) +(def: $CharSequence (type.class "java.lang.CharSequence" (list))) +(def: $System (type.class "java.lang.System" (list))) +(def: $Object (type.class "java.lang.Object" (list))) + +(def: lux-intI Inst (|>> _.I2L (_.wrap type.long))) +(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I)) +(def: check-stringI Inst (_.CHECKCAST $String)) + +(def: (predicateI tester) + (-> (-> Label Inst) + Inst) + (let [$Boolean (type.class "java.lang.Boolean" (list))] + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> (tester @then) + (_.GETSTATIC $Boolean "FALSE" $Boolean) + (_.GOTO @end) + (_.label @then) + (_.GETSTATIC $Boolean "TRUE" $Boolean) + (_.label @end) + )))) + +(def: unitI Inst (_.string synthesis.unit)) + +## TODO: Get rid of this ASAP +(def: lux::syntax-char-case! + (..custom [($_ <>.and + .any + .any + (<>.some (.tuple ($_ <>.and + (.tuple (<>.many .i64)) + .any)))) + (function (_ extension-name phase archive [input else conditionals]) + (<| _.with-label (function (_ @end)) + _.with-label (function (_ @else)) + (do {@ phase.monad} + [inputG (phase archive input) + elseG (phase archive else) + conditionalsG+ (: (Operation (List [(List [Int Label]) + Inst])) + (monad.map @ (function (_ [chars branch]) + (do @ + [branchG (phase archive branch)] + (wrap (<| _.with-label (function (_ @branch)) + [(list@map (function (_ char) + [(.int char) @branch]) + chars) + (|>> (_.label @branch) + branchG + (_.GOTO @end))])))) + conditionals)) + #let [table (|> conditionalsG+ + (list@map product.left) + list@join) + conditionalsG (|> conditionalsG+ + (list@map product.right) + _.fuse)]] + (wrap (|>> inputG (_.unwrap type.long) _.L2I + (_.LOOKUPSWITCH @else table) + conditionalsG + (_.label @else) + elseG + (_.label @end) + )))))])) + +(def: (lux::is [referenceI sampleI]) + (Binary Inst) + (|>> referenceI + sampleI + (predicateI _.IF_ACMPEQ))) + +(def: (lux::try riskyI) + (Unary Inst) + (|>> riskyI + (_.CHECKCAST ///.$Function) + (_.INVOKESTATIC ///.$Runtime "try" runtime.try))) + +(template [ ] + [(def: ( [maskI inputI]) + (Binary Inst) + (|>> inputI (_.unwrap type.long) + maskI (_.unwrap type.long) + (_.wrap type.long)))] + + [i64::and _.LAND] + [i64::or _.LOR] + [i64::xor _.LXOR] + ) + +(template [ ] + [(def: ( [shiftI inputI]) + (Binary Inst) + (|>> inputI (_.unwrap type.long) + shiftI jvm-intI + + (_.wrap type.long)))] + + [i64::left-shift _.LSHL] + [i64::arithmetic-right-shift _.LSHR] + [i64::logical-right-shift _.LUSHR] + ) + +(template [ ] + [(def: ( _) + (Nullary Inst) + (|>> (_.wrap )))] + + [f64::smallest (_.double (Double::MIN_VALUE)) type.double] + [f64::min (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double] + [f64::max (_.double (Double::MAX_VALUE)) type.double] + ) + +(template [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI (_.unwrap ) + paramI (_.unwrap ) + + (_.wrap )))] + + [i64::+ type.long _.LADD] + [i64::- type.long _.LSUB] + [i64::* type.long _.LMUL] + [i64::/ type.long _.LDIV] + [i64::% type.long _.LREM] + + [f64::+ type.double _.DADD] + [f64::- type.double _.DSUB] + [f64::* type.double _.DMUL] + [f64::/ type.double _.DDIV] + [f64::% type.double _.DREM] + ) + +(template [ ] + [(template [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI (_.unwrap ) + paramI (_.unwrap ) + + (_.int ) + (predicateI _.IF_ICMPEQ)))] + + [ +0] + [ -1])] + + [i64::= i64::< type.long _.LCMP] + [f64::= f64::< type.double _.DCMPG] + ) + +(template [ ] + [(def: ( inputI) + (Unary Inst) + (|>> inputI ))] + + [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)] + [i64::char (_.unwrap type.long) + ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))] + + [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)] + [f64::encode (_.unwrap type.double) + (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))] + [f64::decode ..check-stringI + (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))] + ) + +(def: (text::size inputI) + (Unary Inst) + (|>> inputI + ..check-stringI + (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)])) + lux-intI)) + +(template [ ] + [(def: ( [paramI subjectI]) + (Binary Inst) + (|>> subjectI + paramI + ))] + + [text::= (<|) (<|) + (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)])) + (_.wrap type.boolean)] + [text::< ..check-stringI ..check-stringI + (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)])) + (predicateI _.IFLT)] + [text::char ..check-stringI jvm-intI + (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)])) + lux-intI] + ) + +(def: (text::concat [leftI rightI]) + (Binary Inst) + (|>> leftI ..check-stringI + rightI ..check-stringI + (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)])))) + +(def: (text::clip [startI endI subjectI]) + (Trinary Inst) + (|>> subjectI ..check-stringI + startI jvm-intI + endI jvm-intI + (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)])))) + +(def: index-method (type.method [(list $String type.int) type.int (list)])) +(def: (text::index [startI partI textI]) + (Trinary Inst) + (<| _.with-label (function (_ @not-found)) + _.with-label (function (_ @end)) + (|>> textI ..check-stringI + partI ..check-stringI + startI jvm-intI + (_.INVOKEVIRTUAL $String "indexOf" index-method) + _.DUP + (_.int -1) + (_.IF_ICMPEQ @not-found) + lux-intI + runtime.someI + (_.GOTO @end) + (_.label @not-found) + _.POP + runtime.noneI + (_.label @end)))) + +(def: string-method (type.method [(list $String) type.void (list)])) +(def: (io::log messageI) + (Unary Inst) + (let [$PrintStream (type.class "java.io.PrintStream" (list))] + (|>> (_.GETSTATIC $System "out" $PrintStream) + messageI + ..check-stringI + (_.INVOKEVIRTUAL $PrintStream "println" string-method) + unitI))) + +(def: (io::error messageI) + (Unary Inst) + (let [$Error (type.class "java.lang.Error" (list))] + (|>> (_.NEW $Error) + _.DUP + messageI + ..check-stringI + (_.INVOKESPECIAL $Error "" string-method) + _.ATHROW))) + +(def: (io::exit codeI) + (Unary Inst) + (|>> codeI jvm-intI + (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)])) + _.NULL)) + +(def: (io::current-time _) + (Nullary Inst) + (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)])) + (_.wrap type.long))) + +(def: bundle::lux + Bundle + (|> (: Bundle bundle.empty) + (bundle.install "syntax char case!" lux::syntax-char-case!) + (bundle.install "is" (binary lux::is)) + (bundle.install "try" (unary lux::try)))) + +(def: bundle::i64 + Bundle + (<| (bundle.prefix "i64") + (|> (: Bundle bundle.empty) + (bundle.install "and" (binary i64::and)) + (bundle.install "or" (binary i64::or)) + (bundle.install "xor" (binary i64::xor)) + (bundle.install "left-shift" (binary i64::left-shift)) + (bundle.install "logical-right-shift" (binary i64::logical-right-shift)) + (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift)) + (bundle.install "=" (binary i64::=)) + (bundle.install "<" (binary i64::<)) + (bundle.install "+" (binary i64::+)) + (bundle.install "-" (binary i64::-)) + (bundle.install "*" (binary i64::*)) + (bundle.install "/" (binary i64::/)) + (bundle.install "%" (binary i64::%)) + (bundle.install "f64" (unary i64::f64)) + (bundle.install "char" (unary i64::char))))) + +(def: bundle::f64 + Bundle + (<| (bundle.prefix "f64") + (|> (: Bundle bundle.empty) + (bundle.install "+" (binary f64::+)) + (bundle.install "-" (binary f64::-)) + (bundle.install "*" (binary f64::*)) + (bundle.install "/" (binary f64::/)) + (bundle.install "%" (binary f64::%)) + (bundle.install "=" (binary f64::=)) + (bundle.install "<" (binary f64::<)) + (bundle.install "smallest" (nullary f64::smallest)) + (bundle.install "min" (nullary f64::min)) + (bundle.install "max" (nullary f64::max)) + (bundle.install "i64" (unary f64::i64)) + (bundle.install "encode" (unary f64::encode)) + (bundle.install "decode" (unary f64::decode))))) + +(def: bundle::text + Bundle + (<| (bundle.prefix "text") + (|> (: Bundle bundle.empty) + (bundle.install "=" (binary text::=)) + (bundle.install "<" (binary text::<)) + (bundle.install "concat" (binary text::concat)) + (bundle.install "index" (trinary text::index)) + (bundle.install "size" (unary text::size)) + (bundle.install "char" (binary text::char)) + (bundle.install "clip" (trinary text::clip))))) + +(def: bundle::io + Bundle + (<| (bundle.prefix "io") + (|> (: Bundle bundle.empty) + (bundle.install "log" (unary io::log)) + (bundle.install "error" (unary io::error)) + (bundle.install "exit" (unary io::exit)) + (bundle.install "current-time" (nullary io::current-time))))) + +(def: #export bundle + Bundle + (<| (bundle.prefix "lux") + (|> bundle::lux + (dictionary.merge bundle::i64) + (dictionary.merge bundle::f64) + (dictionary.merge bundle::text) + (dictionary.merge bundle::io)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux new file mode 100644 index 000000000..7b90a8e4f --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -0,0 +1,1047 @@ +(.module: + [lux (#- Type primitive int char type) + [host (#+ import:)] + [abstract + ["." monad (#+ do)]] + [control + ["." exception (#+ exception:)] + ["." function] + ["<>" parser ("#@." monad) + ["" text] + ["" synthesis (#+ Parser)]]] + [data + ["." product] + ["." maybe] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [number + ["." nat]] + [collection + ["." list ("#@." monad)] + ["." dictionary (#+ Dictionary)] + ["." set]]] + [target + [jvm + ["." type (#+ Type Typed Argument) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)] + ["." box] + ["." reflection] + ["." signature] + ["." parser]]]] + [tool + [compiler + ["." reference (#+ Variable)] + ["." phase ("#@." monad)] + [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] + [analysis + ["/" jvm]]]]]]]]] + [luxc + [lang + [host + ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase) + ["_" inst] + ["_." def]]]]] + ["." // #_ + [common (#+ custom)] + ["/#" // + ["#." reference] + ["#." function]]]) + +(template [ ] + [(def: #export + (Parser (Type )) + (.embed .text))] + + [var Var parser.var] + [class Class parser.class] + [object Object parser.object] + [value Value parser.value] + [return Return parser.return] + ) + +(exception: #export (not-an-object-array {arrayJT (Type Array)}) + (exception.report + ["JVM Type" (|> arrayJT type.signature signature.signature)])) + +(def: #export object-array + (Parser (Type Object)) + (do <>.monad + [arrayJT (.embed parser.array .text)] + (case (parser.array? arrayJT) + (#.Some elementJT) + (case (parser.object? elementJT) + (#.Some elementJT) + (wrap elementJT) + + #.None + (<>.fail (exception.construct ..not-an-object-array arrayJT))) + + #.None + (undefined)))) + +(template [ ] + [(def: + Inst + )] + + [L2S (|>> _.L2I _.I2S)] + [L2B (|>> _.L2I _.I2B)] + [L2C (|>> _.L2I _.I2C)] + ) + +(template [ ] + [(def: ( inputI) + (Unary Inst) + (if (is? _.NOP ) + inputI + (|>> inputI + )))] + + [_.D2F conversion::double-to-float] + [_.D2I conversion::double-to-int] + [_.D2L conversion::double-to-long] + [_.F2D conversion::float-to-double] + [_.F2I conversion::float-to-int] + [_.F2L conversion::float-to-long] + [_.I2B conversion::int-to-byte] + [_.I2C conversion::int-to-char] + [_.I2D conversion::int-to-double] + [_.I2F conversion::int-to-float] + [_.I2L conversion::int-to-long] + [_.I2S conversion::int-to-short] + [_.L2D conversion::long-to-double] + [_.L2F conversion::long-to-float] + [_.L2I conversion::long-to-int] + [..L2S conversion::long-to-short] + [..L2B conversion::long-to-byte] + [..L2C conversion::long-to-char] + [_.I2B conversion::char-to-byte] + [_.I2S conversion::char-to-short] + [_.NOP conversion::char-to-int] + [_.I2L conversion::char-to-long] + [_.I2L conversion::byte-to-long] + [_.I2L conversion::short-to-long] + ) + +(def: conversion + Bundle + (<| (bundle.prefix "conversion") + (|> (: Bundle bundle.empty) + (bundle.install "double-to-float" (unary conversion::double-to-float)) + (bundle.install "double-to-int" (unary conversion::double-to-int)) + (bundle.install "double-to-long" (unary conversion::double-to-long)) + (bundle.install "float-to-double" (unary conversion::float-to-double)) + (bundle.install "float-to-int" (unary conversion::float-to-int)) + (bundle.install "float-to-long" (unary conversion::float-to-long)) + (bundle.install "int-to-byte" (unary conversion::int-to-byte)) + (bundle.install "int-to-char" (unary conversion::int-to-char)) + (bundle.install "int-to-double" (unary conversion::int-to-double)) + (bundle.install "int-to-float" (unary conversion::int-to-float)) + (bundle.install "int-to-long" (unary conversion::int-to-long)) + (bundle.install "int-to-short" (unary conversion::int-to-short)) + (bundle.install "long-to-double" (unary conversion::long-to-double)) + (bundle.install "long-to-float" (unary conversion::long-to-float)) + (bundle.install "long-to-int" (unary conversion::long-to-int)) + (bundle.install "long-to-short" (unary conversion::long-to-short)) + (bundle.install "long-to-byte" (unary conversion::long-to-byte)) + (bundle.install "long-to-char" (unary conversion::long-to-char)) + (bundle.install "char-to-byte" (unary conversion::char-to-byte)) + (bundle.install "char-to-short" (unary conversion::char-to-short)) + (bundle.install "char-to-int" (unary conversion::char-to-int)) + (bundle.install "char-to-long" (unary conversion::char-to-long)) + (bundle.install "byte-to-long" (unary conversion::byte-to-long)) + (bundle.install "short-to-long" (unary conversion::short-to-long)) + ))) + +(template [ ] + [(def: ( [xI yI]) + (Binary Inst) + (|>> xI + yI + ))] + + [int::+ _.IADD] + [int::- _.ISUB] + [int::* _.IMUL] + [int::/ _.IDIV] + [int::% _.IREM] + [int::and _.IAND] + [int::or _.IOR] + [int::xor _.IXOR] + [int::shl _.ISHL] + [int::shr _.ISHR] + [int::ushr _.IUSHR] + + [long::+ _.LADD] + [long::- _.LSUB] + [long::* _.LMUL] + [long::/ _.LDIV] + [long::% _.LREM] + [long::and _.LAND] + [long::or _.LOR] + [long::xor _.LXOR] + [long::shl _.LSHL] + [long::shr _.LSHR] + [long::ushr _.LUSHR] + + [float::+ _.FADD] + [float::- _.FSUB] + [float::* _.FMUL] + [float::/ _.FDIV] + [float::% _.FREM] + + [double::+ _.DADD] + [double::- _.DSUB] + [double::* _.DMUL] + [double::/ _.DDIV] + [double::% _.DREM] + ) + +(def: $Boolean (type.class box.boolean (list))) +(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean)) +(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean)) + +(template [ ] + [(def: ( [xI yI]) + (Binary Inst) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI + yI + ( @then) + falseI + (_.GOTO @end) + (_.label @then) + trueI + (_.label @end))))] + + [int::= _.IF_ICMPEQ] + [int::< _.IF_ICMPLT] + + [char::= _.IF_ICMPEQ] + [char::< _.IF_ICMPLT] + ) + +(template [ ] + [(def: ( [xI yI]) + (Binary Inst) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI + yI + + (_.int ) + (_.IF_ICMPEQ @then) + falseI + (_.GOTO @end) + (_.label @then) + trueI + (_.label @end))))] + + [long::= _.LCMP +0] + [long::< _.LCMP -1] + + [float::= _.FCMPG +0] + [float::< _.FCMPG -1] + + [double::= _.DCMPG +0] + [double::< _.DCMPG -1] + ) + +(def: int + Bundle + (<| (bundle.prefix (reflection.reflection reflection.int)) + (|> (: Bundle bundle.empty) + (bundle.install "+" (binary int::+)) + (bundle.install "-" (binary int::-)) + (bundle.install "*" (binary int::*)) + (bundle.install "/" (binary int::/)) + (bundle.install "%" (binary int::%)) + (bundle.install "=" (binary int::=)) + (bundle.install "<" (binary int::<)) + (bundle.install "and" (binary int::and)) + (bundle.install "or" (binary int::or)) + (bundle.install "xor" (binary int::xor)) + (bundle.install "shl" (binary int::shl)) + (bundle.install "shr" (binary int::shr)) + (bundle.install "ushr" (binary int::ushr)) + ))) + +(def: long + Bundle + (<| (bundle.prefix (reflection.reflection reflection.long)) + (|> (: Bundle bundle.empty) + (bundle.install "+" (binary long::+)) + (bundle.install "-" (binary long::-)) + (bundle.install "*" (binary long::*)) + (bundle.install "/" (binary long::/)) + (bundle.install "%" (binary long::%)) + (bundle.install "=" (binary long::=)) + (bundle.install "<" (binary long::<)) + (bundle.install "and" (binary long::and)) + (bundle.install "or" (binary long::or)) + (bundle.install "xor" (binary long::xor)) + (bundle.install "shl" (binary long::shl)) + (bundle.install "shr" (binary long::shr)) + (bundle.install "ushr" (binary long::ushr)) + ))) + +(def: float + Bundle + (<| (bundle.prefix (reflection.reflection reflection.float)) + (|> (: Bundle bundle.empty) + (bundle.install "+" (binary float::+)) + (bundle.install "-" (binary float::-)) + (bundle.install "*" (binary float::*)) + (bundle.install "/" (binary float::/)) + (bundle.install "%" (binary float::%)) + (bundle.install "=" (binary float::=)) + (bundle.install "<" (binary float::<)) + ))) + +(def: double + Bundle + (<| (bundle.prefix (reflection.reflection reflection.double)) + (|> (: Bundle bundle.empty) + (bundle.install "+" (binary double::+)) + (bundle.install "-" (binary double::-)) + (bundle.install "*" (binary double::*)) + (bundle.install "/" (binary double::/)) + (bundle.install "%" (binary double::%)) + (bundle.install "=" (binary double::=)) + (bundle.install "<" (binary double::<)) + ))) + +(def: char + Bundle + (<| (bundle.prefix (reflection.reflection reflection.char)) + (|> (: Bundle bundle.empty) + (bundle.install "=" (binary char::=)) + (bundle.install "<" (binary char::<)) + ))) + +(def: (primitive-array-length-handler jvm-primitive) + (-> (Type Primitive) Handler) + (..custom + [.any + (function (_ extension-name generate archive arrayS) + (do phase.monad + [arrayI (generate archive arrayS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array jvm-primitive)) + _.ARRAYLENGTH))))])) + +(def: array::length::object + Handler + (..custom + [($_ <>.and ..object-array .any) + (function (_ extension-name generate archive [elementJT arrayS]) + (do phase.monad + [arrayI (generate archive arrayS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + _.ARRAYLENGTH))))])) + +(def: (new-primitive-array-handler jvm-primitive) + (-> (Type Primitive) Handler) + (function (_ extension-name generate archive inputs) + (case inputs + (^ (list lengthS)) + (do phase.monad + [lengthI (generate archive lengthS)] + (wrap (|>> lengthI + (_.array jvm-primitive)))) + + _ + (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + +(def: array::new::object + Handler + (..custom + [($_ <>.and ..object .any) + (function (_ extension-name generate archive [objectJT lengthS]) + (do phase.monad + [lengthI (generate archive lengthS)] + (wrap (|>> lengthI + (_.ANEWARRAY objectJT)))))])) + +(def: (read-primitive-array-handler jvm-primitive loadI) + (-> (Type Primitive) Inst Handler) + (function (_ extension-name generate archive inputs) + (case inputs + (^ (list idxS arrayS)) + (do phase.monad + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array jvm-primitive)) + idxI + loadI))) + + _ + (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + +(def: array::read::object + Handler + (..custom + [($_ <>.and ..object-array .any .any) + (function (_ extension-name generate archive [elementJT idxS arrayS]) + (do phase.monad + [arrayI (generate archive arrayS) + idxI (generate archive idxS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + idxI + _.AALOAD))))])) + +(def: (write-primitive-array-handler jvm-primitive storeI) + (-> (Type Primitive) Inst Handler) + (function (_ extension-name generate archive inputs) + (case inputs + (^ (list idxS valueS arrayS)) + (do phase.monad + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array jvm-primitive)) + _.DUP + idxI + valueI + storeI))) + + _ + (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))) + +(def: array::write::object + Handler + (..custom + [($_ <>.and ..object-array .any .any .any) + (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) + (do phase.monad + [arrayI (generate archive arrayS) + idxI (generate archive idxS) + valueI (generate archive valueS)] + (wrap (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + _.DUP + idxI + valueI + _.AASTORE))))])) + +(def: array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (dictionary.merge (<| (bundle.prefix "length") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short)) + (bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int)) + (bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long)) + (bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float)) + (bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double)) + (bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char)) + (bundle.install "object" array::length::object)))) + (dictionary.merge (<| (bundle.prefix "new") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short)) + (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int)) + (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long)) + (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float)) + (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double)) + (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.char)) + (bundle.install "object" array::new::object)))) + (dictionary.merge (<| (bundle.prefix "read") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.BALOAD)) + (bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.BALOAD)) + (bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.SALOAD)) + (bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.IALOAD)) + (bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.LALOAD)) + (bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.FALOAD)) + (bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.DALOAD)) + (bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.CALOAD)) + (bundle.install "object" array::read::object)))) + (dictionary.merge (<| (bundle.prefix "write") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.BASTORE)) + (bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.BASTORE)) + (bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.SASTORE)) + (bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.IASTORE)) + (bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.LASTORE)) + (bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.FASTORE)) + (bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.DASTORE)) + (bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.CASTORE)) + (bundle.install "object" array::write::object)))) + ))) + +(def: (object::null _) + (Nullary Inst) + _.NULL) + +(def: (object::null? objectI) + (Unary Inst) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> objectI + (_.IFNULL @then) + falseI + (_.GOTO @end) + (_.label @then) + trueI + (_.label @end)))) + +(def: (object::synchronized [monitorI exprI]) + (Binary Inst) + (|>> monitorI + _.DUP + _.MONITORENTER + exprI + _.SWAP + _.MONITOREXIT)) + +(def: (object::throw exceptionI) + (Unary Inst) + (|>> exceptionI + _.ATHROW)) + +(def: $Class (type.class "java.lang.Class" (list))) + +(def: (object::class extension-name generate archive inputs) + Handler + (case inputs + (^ (list (synthesis.text class))) + (do phase.monad + [] + (wrap (|>> (_.string class) + (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)]))))) + + _ + (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) + +(def: object::instance? + Handler + (..custom + [($_ <>.and .text .any) + (function (_ extension-name generate archive [class objectS]) + (do phase.monad + [objectI (generate archive objectS)] + (wrap (|>> objectI + (_.INSTANCEOF (type.class class (list))) + (_.wrap type.boolean)))))])) + +(def: (object::cast extension-name generate archive inputs) + Handler + (case inputs + (^ (list (synthesis.text from) (synthesis.text to) valueS)) + (do phase.monad + [valueI (generate archive valueS)] + (`` (cond (~~ (template [ ] + [(and (text@= (reflection.reflection (type.reflection )) + from) + (text@= + to)) + (wrap (|>> valueI (_.wrap ))) + + (and (text@= + from) + (text@= (reflection.reflection (type.reflection )) + to)) + (wrap (|>> valueI (_.unwrap )))] + + [box.boolean type.boolean] + [box.byte type.byte] + [box.short type.short] + [box.int type.int] + [box.long type.long] + [box.float type.float] + [box.double type.double] + [box.char type.char])) + ## else + (wrap valueI)))) + + _ + (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))) + +(def: object-bundle + Bundle + (<| (bundle.prefix "object") + (|> (: Bundle bundle.empty) + (bundle.install "null" (nullary object::null)) + (bundle.install "null?" (unary object::null?)) + (bundle.install "synchronized" (binary object::synchronized)) + (bundle.install "throw" (unary object::throw)) + (bundle.install "class" object::class) + (bundle.install "instance?" object::instance?) + (bundle.install "cast" object::cast) + ))) + +(def: primitives + (Dictionary Text (Type Primitive)) + (|> (list [(reflection.reflection reflection.boolean) type.boolean] + [(reflection.reflection reflection.byte) type.byte] + [(reflection.reflection reflection.short) type.short] + [(reflection.reflection reflection.int) type.int] + [(reflection.reflection reflection.long) type.long] + [(reflection.reflection reflection.float) type.float] + [(reflection.reflection reflection.double) type.double] + [(reflection.reflection reflection.char) type.char]) + (dictionary.from-list text.hash))) + +(def: get::static + Handler + (..custom + [($_ <>.and .text .text .text) + (function (_ extension-name generate archive [class field unboxed]) + (do phase.monad + [] + (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (wrap (_.GETSTATIC (type.class class (list)) field primitive)) + + #.None + (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))])) + +(def: put::static + Handler + (..custom + [($_ <>.and .text .text .text .any) + (function (_ extension-name generate archive [class field unboxed valueS]) + (do phase.monad + [valueI (generate archive valueS) + #let [$class (type.class class (list))]] + (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (wrap (|>> valueI + (_.PUTSTATIC $class field primitive) + (_.string synthesis.unit))) + + #.None + (wrap (|>> valueI + (_.CHECKCAST $class) + (_.PUTSTATIC $class field $class) + (_.string synthesis.unit))))))])) + +(def: get::virtual + Handler + (..custom + [($_ <>.and .text .text .text .any) + (function (_ extension-name generate archive [class field unboxed objectS]) + (do phase.monad + [objectI (generate archive objectS) + #let [$class (type.class class (list)) + getI (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.GETFIELD $class field primitive) + + #.None + (_.GETFIELD $class field (type.class unboxed (list))))]] + (wrap (|>> objectI + (_.CHECKCAST $class) + getI))))])) + +(def: put::virtual + Handler + (..custom + [($_ <>.and .text .text .text .any .any) + (function (_ extension-name generate archive [class field unboxed valueS objectS]) + (do phase.monad + [valueI (generate archive valueS) + objectI (generate archive objectS) + #let [$class (type.class class (list)) + putI (case (dictionary.get unboxed ..primitives) + (#.Some primitive) + (_.PUTFIELD $class field primitive) + + #.None + (let [$unboxed (type.class unboxed (list))] + (|>> (_.CHECKCAST $unboxed) + (_.PUTFIELD $class field $unboxed))))]] + (wrap (|>> objectI + (_.CHECKCAST $class) + _.DUP + valueI + putI))))])) + +(type: Input (Typed Synthesis)) + +(def: input + (Parser Input) + (.tuple (<>.and ..value .any))) + +(def: (generate-input generate archive [valueT valueS]) + (-> Phase Archive Input + (Operation (Typed Inst))) + (do phase.monad + [valueI (generate archive valueS)] + (case (type.primitive? valueT) + (#.Right valueT) + (wrap [valueT valueI]) + + (#.Left valueT) + (wrap [valueT (|>> valueI + (_.CHECKCAST valueT))])))) + +(def: voidI (_.string synthesis.unit)) + +(def: (prepare-output outputT) + (-> (Type Return) Inst) + (case (type.void? outputT) + (#.Right outputT) + ..voidI + + (#.Left outputT) + function.identity)) + +(def: invoke::static + Handler + (..custom + [($_ <>.and ..class .text ..return (<>.some ..input)) + (function (_ extension-name generate archive [class method outputT inputsTS]) + (do {@ phase.monad} + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + (wrap (|>> (_.fuse (list@map product.right inputsTI)) + (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)])) + (prepare-output outputT)))))])) + +(template [ ] + [(def: + Handler + (..custom + [($_ <>.and ..class .text ..return .any (<>.some ..input)) + (function (_ extension-name generate archive [class method outputT objectS inputsTS]) + (do {@ phase.monad} + [objectI (generate archive objectS) + inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + (wrap (|>> objectI + (_.CHECKCAST class) + (_.fuse (list@map product.right inputsTI)) + ( class method + (type.method [(list@map product.left inputsTI) + outputT + (list)])) + (prepare-output outputT)))))]))] + + [invoke::virtual _.INVOKEVIRTUAL] + [invoke::special _.INVOKESPECIAL] + [invoke::interface _.INVOKEINTERFACE] + ) + +(def: invoke::constructor + Handler + (..custom + [($_ <>.and ..class (<>.some ..input)) + (function (_ extension-name generate archive [class inputsTS]) + (do {@ phase.monad} + [inputsTI (monad.map @ (generate-input generate archive) inputsTS)] + (wrap (|>> (_.NEW class) + _.DUP + (_.fuse (list@map product.right inputsTI)) + (_.INVOKESPECIAL class "" (type.method [(list@map product.left inputsTI) type.void (list)]))))))])) + +(def: member + Bundle + (<| (bundle.prefix "member") + (|> (: Bundle bundle.empty) + (dictionary.merge (<| (bundle.prefix "get") + (|> (: Bundle bundle.empty) + (bundle.install "static" get::static) + (bundle.install "virtual" get::virtual)))) + (dictionary.merge (<| (bundle.prefix "put") + (|> (: Bundle bundle.empty) + (bundle.install "static" put::static) + (bundle.install "virtual" put::virtual)))) + (dictionary.merge (<| (bundle.prefix "invoke") + (|> (: Bundle bundle.empty) + (bundle.install "static" invoke::static) + (bundle.install "virtual" invoke::virtual) + (bundle.install "special" invoke::special) + (bundle.install "interface" invoke::interface) + (bundle.install "constructor" invoke::constructor)))) + ))) + +(def: annotation-parameter + (Parser (/.Annotation-Parameter Synthesis)) + (.tuple (<>.and .text .any))) + +(def: annotation + (Parser (/.Annotation Synthesis)) + (.tuple (<>.and .text (<>.some ..annotation-parameter)))) + +(def: argument + (Parser Argument) + (.tuple (<>.and .text ..value))) + +(def: overriden-method-definition + (Parser [Environment (/.Overriden-Method Synthesis)]) + (.tuple (do <>.monad + [_ (.text! /.overriden-tag) + ownerT ..class + name .text + strict-fp? .bit + annotations (.tuple (<>.some ..annotation)) + vars (.tuple (<>.some ..var)) + self-name .text + arguments (.tuple (<>.some ..argument)) + returnT ..return + exceptionsT (.tuple (<>.some ..class)) + [environment body] (.function 1 + (.tuple .any))] + (wrap [environment + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + body]])))) + +(def: (normalize-path normalize) + (-> (-> Synthesis Synthesis) + (-> Path Path)) + (function (recur path) + (case path + (^ (synthesis.path/then bodyS)) + (synthesis.path/then (normalize bodyS)) + + (^template [] + (^ ( leftP rightP)) + ( (recur leftP) (recur rightP))) + ([#synthesis.Alt] + [#synthesis.Seq]) + + (^template [] + (^ ( value)) + path) + ([#synthesis.Pop] + [#synthesis.Test] + [#synthesis.Bind] + [#synthesis.Access])))) + +(def: (normalize-method-body mapping) + (-> (Dictionary Variable Variable) Synthesis Synthesis) + (function (recur body) + (case body + (^template [] + (^ ( value)) + body) + ([#synthesis.Primitive] + [synthesis.constant]) + + (^ (synthesis.variant [lefts right? sub])) + (synthesis.variant [lefts right? (recur sub)]) + + (^ (synthesis.tuple members)) + (synthesis.tuple (list@map recur members)) + + (^ (synthesis.variable var)) + (|> mapping + (dictionary.get var) + (maybe.default var) + synthesis.variable) + + (^ (synthesis.branch/case [inputS pathS])) + (synthesis.branch/case [(recur inputS) (normalize-path recur pathS)]) + + (^ (synthesis.branch/let [inputS register outputS])) + (synthesis.branch/let [(recur inputS) register (recur outputS)]) + + (^ (synthesis.branch/if [testS thenS elseS])) + (synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)]) + + (^ (synthesis.loop/scope [offset initsS+ bodyS])) + (synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)]) + + (^ (synthesis.loop/recur updatesS+)) + (synthesis.loop/recur (list@map recur updatesS+)) + + (^ (synthesis.function/abstraction [environment arity bodyS])) + (synthesis.function/abstraction [(|> environment (list@map (function (_ local) + (|> mapping + (dictionary.get local) + (maybe.default local))))) + arity + bodyS]) + + (^ (synthesis.function/apply [functionS inputsS+])) + (synthesis.function/apply [(recur functionS) (list@map recur inputsS+)]) + + (#synthesis.Extension [name inputsS+]) + (#synthesis.Extension [name (list@map recur inputsS+)])))) + +(def: $Object (type.class "java.lang.Object" (list))) + +(def: (anonymous-init-method env) + (-> Environment (Type Method)) + (type.method [(list.repeat (list.size env) $Object) + type.void + (list)])) + +(def: (with-anonymous-init class env super-class inputsTI) + (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def) + (let [store-capturedI (|> env + list.size + list.indices + (list@map (.function (_ register) + (|>> (_.ALOAD 0) + (_.ALOAD (inc register)) + (_.PUTFIELD class (///reference.foreign-name register) $Object)))) + _.fuse)] + (_def.method #$.Public $.noneM "" (anonymous-init-method env) + (|>> (_.ALOAD 0) + ((_.fuse (list@map product.right inputsTI))) + (_.INVOKESPECIAL super-class "" (type.method [(list@map product.left inputsTI) type.void (list)])) + store-capturedI + _.RETURN)))) + +(def: (anonymous-instance archive class env) + (-> Archive (Type Class) Environment (Operation Inst)) + (do {@ phase.monad} + [captureI+ (monad.map @ (///reference.variable archive) env)] + (wrap (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + (_.INVOKESPECIAL class "" (anonymous-init-method env)))))) + +(def: (returnI returnT) + (-> (Type Return) Inst) + (case (type.void? returnT) + (#.Right returnT) + _.RETURN + + (#.Left returnT) + (case (type.primitive? returnT) + (#.Left returnT) + (|>> (_.CHECKCAST returnT) + _.ARETURN) + + (#.Right returnT) + (cond (or (:: type.equivalence = type.boolean returnT) + (:: type.equivalence = type.byte returnT) + (:: type.equivalence = type.short returnT) + (:: type.equivalence = type.int returnT) + (:: type.equivalence = type.char returnT)) + _.IRETURN + + (:: type.equivalence = type.long returnT) + _.LRETURN + + (:: type.equivalence = type.float returnT) + _.FRETURN + + ## (:: type.equivalence = type.double returnT) + _.DRETURN)))) + +(def: class::anonymous + Handler + (..custom + [($_ <>.and + ..class + (.tuple (<>.some ..class)) + (.tuple (<>.some ..input)) + (.tuple (<>.some ..overriden-method-definition))) + (function (_ extension-name generate archive [super-class super-interfaces + inputsTS + overriden-methods]) + (do {@ phase.monad} + [[context _] (generation.with-new-context archive (wrap [])) + #let [[module-id artifact-id] context + anonymous-class-name (///.class-name context) + class (type.class anonymous-class-name (list)) + total-environment (|> overriden-methods + ## Get all the environments. + (list@map product.left) + ## Combine them. + list@join + ## Remove duplicates. + (set.from-list reference.hash) + set.to-list) + global-mapping (|> total-environment + ## Give them names as "foreign" variables. + list.enumerate + (list@map (function (_ [id capture]) + [capture (#reference.Foreign id)])) + (dictionary.from-list reference.hash)) + normalized-methods (list@map (function (_ [environment + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + body]]) + (let [local-mapping (|> environment + list.enumerate + (list@map (function (_ [foreign-id capture]) + [(#reference.Foreign foreign-id) + (|> global-mapping + (dictionary.get capture) + maybe.assume)])) + (dictionary.from-list reference.hash))] + [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + (normalize-method-body local-mapping body)])) + overriden-methods)] + inputsTI (monad.map @ (generate-input generate archive) inputsTS) + method-definitions (|> normalized-methods + (monad.map @ (function (_ [ownerT name + strict-fp? annotations vars + self-name arguments returnT exceptionsT + bodyS]) + (do @ + [bodyG (generation.with-context artifact-id + (generate archive bodyS))] + (wrap (_def.method #$.Public + (if strict-fp? + ($_ $.++M $.finalM $.strictM) + $.finalM) + name + (type.method [(list@map product.right arguments) + returnT + exceptionsT]) + (|>> bodyG (returnI returnT))))))) + (:: @ map _def.fuse)) + _ (generation.save! true ["" (%.nat artifact-id)] + [anonymous-class-name + (_def.class #$.V1_6 #$.Public $.finalC + anonymous-class-name (list) + super-class super-interfaces + (|>> (///function.with-environment total-environment) + (..with-anonymous-init class total-environment super-class inputsTI) + method-definitions))])] + (anonymous-instance archive class total-environment)))])) + +(def: bundle::class + Bundle + (<| (bundle.prefix "class") + (|> (: Bundle bundle.empty) + (bundle.install "anonymous" class::anonymous) + ))) + +(def: #export bundle + Bundle + (<| (bundle.prefix "jvm") + (|> ..conversion + (dictionary.merge ..int) + (dictionary.merge ..long) + (dictionary.merge ..float) + (dictionary.merge ..double) + (dictionary.merge ..char) + (dictionary.merge ..array) + (dictionary.merge ..object-bundle) + (dictionary.merge ..member) + (dictionary.merge ..bundle::class) + ))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux new file mode 100644 index 000000000..888ad9545 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -0,0 +1,331 @@ +(.module: + [lux (#- Type function) + [abstract + ["." monad (#+ do)]] + [control + [pipe (#+ when> new>)] + ["." function]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [number + ["n" nat] + ["i" int]] + [collection + ["." list ("#@." functor monoid)]]] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]] + [tool + [compiler + [arity (#+ Arity)] + [reference (#+ Register)] + ["." phase] + [language + [lux + [analysis (#+ Environment)] + [synthesis (#+ Synthesis Abstraction Apply)] + ["." generation]]] + [meta + [archive (#+ Archive)]]]]] + [luxc + [lang + [host + ["$" jvm (#+ Label Inst Def Operation Phase Generator) + ["." def] + ["_" inst]]]]] + ["." // + ["#." runtime] + ["." reference]]) + +(def: arity-field Text "arity") + +(def: (poly-arg? arity) + (-> Arity Bit) + (n.> 1 arity)) + +(def: (captured-args env) + (-> Environment (List (Type Value))) + (list.repeat (list.size env) //.$Value)) + +(def: (init-method env arity) + (-> Environment Arity (Type Method)) + (if (poly-arg? arity) + (type.method [(list.concat (list (captured-args env) + (list type.int) + (list.repeat (dec arity) //.$Value))) + type.void + (list)]) + (type.method [(captured-args env) type.void (list)]))) + +(def: (implementation-method arity) + (type.method [(list.repeat arity //.$Value) //.$Value (list)])) + +(def: get-amount-of-partialsI + Inst + (|>> (_.ALOAD 0) + (_.GETFIELD //.$Function //runtime.partials-field type.int))) + +(def: (load-fieldI class field) + (-> (Type Class) Text Inst) + (|>> (_.ALOAD 0) + (_.GETFIELD class field //.$Value))) + +(def: (inputsI start amount) + (-> Register Nat Inst) + (|> (list.n/range start (n.+ start (dec amount))) + (list@map _.ALOAD) + _.fuse)) + +(def: (applysI start amount) + (-> Register Nat Inst) + (let [max-args (n.min amount //runtime.num-apply-variants) + later-applysI (if (n.> //runtime.num-apply-variants amount) + (applysI (n.+ //runtime.num-apply-variants start) (n.- //runtime.num-apply-variants amount)) + function.identity)] + (|>> (_.CHECKCAST //.$Function) + (inputsI start max-args) + (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature max-args)) + later-applysI))) + +(def: (inc-intI by) + (-> Nat Inst) + (|>> (_.int (.int by)) + _.IADD)) + +(def: (nullsI amount) + (-> Nat Inst) + (|> _.NULL + (list.repeat amount) + _.fuse)) + +(def: (instance archive class arity env) + (-> Archive (Type Class) Arity Environment (Operation Inst)) + (do {@ phase.monad} + [captureI+ (monad.map @ (reference.variable archive) env) + #let [argsI (if (poly-arg? arity) + (|> (nullsI (dec arity)) + (list (_.int +0)) + _.fuse) + function.identity)]] + (wrap (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + argsI + (_.INVOKESPECIAL class "" (init-method env arity)))))) + +(def: (reset-method return) + (-> (Type Class) (Type Method)) + (type.method [(list) return (list)])) + +(def: (with-reset class arity env) + (-> (Type Class) Arity Environment Def) + (def.method #$.Public $.noneM "reset" (reset-method class) + (if (poly-arg? arity) + (let [env-size (list.size env) + captureI (|> (case env-size + 0 (list) + _ (list.n/range 0 (dec env-size))) + (list@map (.function (_ source) + (|>> (_.ALOAD 0) + (_.GETFIELD class (reference.foreign-name source) //.$Value)))) + _.fuse) + argsI (|> (nullsI (dec arity)) + (list (_.int +0)) + _.fuse)] + (|>> (_.NEW class) + _.DUP + captureI + argsI + (_.INVOKESPECIAL class "" (init-method env arity)) + _.ARETURN)) + (|>> (_.ALOAD 0) + _.ARETURN)))) + +(def: (with-implementation arity @begin bodyI) + (-> Nat Label Inst Def) + (def.method #$.Public $.strictM "impl" (implementation-method arity) + (|>> (_.label @begin) + bodyI + _.ARETURN))) + +(def: function-init-method + (type.method [(list type.int) type.void (list)])) + +(def: (function-init arity env-size) + (-> Arity Nat Inst) + (if (n.= 1 arity) + (|>> (_.int +0) + (_.INVOKESPECIAL //.$Function "" function-init-method)) + (|>> (_.ILOAD (inc env-size)) + (_.INVOKESPECIAL //.$Function "" function-init-method)))) + +(def: (with-init class env arity) + (-> (Type Class) Environment Arity Def) + (let [env-size (list.size env) + offset-partial (: (-> Nat Nat) + (|>> inc (n.+ env-size))) + store-capturedI (|> (case env-size + 0 (list) + _ (list.n/range 0 (dec env-size))) + (list@map (.function (_ register) + (|>> (_.ALOAD 0) + (_.ALOAD (inc register)) + (_.PUTFIELD class (reference.foreign-name register) //.$Value)))) + _.fuse) + store-partialI (if (poly-arg? arity) + (|> (list.n/range 0 (n.- 2 arity)) + (list@map (.function (_ idx) + (let [register (offset-partial idx)] + (|>> (_.ALOAD 0) + (_.ALOAD (inc register)) + (_.PUTFIELD class (reference.partial-name idx) //.$Value))))) + _.fuse) + function.identity)] + (def.method #$.Public $.noneM "" (init-method env arity) + (|>> (_.ALOAD 0) + (function-init arity env-size) + store-capturedI + store-partialI + _.RETURN)))) + +(def: (with-apply class env function-arity @begin bodyI apply-arity) + (-> (Type Class) Environment Arity Label Inst Arity + Def) + (let [num-partials (dec function-arity) + @default ($.new-label []) + @labels (list@map $.new-label (list.repeat num-partials [])) + over-extent (|> (.int function-arity) (i.- (.int apply-arity))) + casesI (|> (list@compose @labels (list @default)) + (list.zip2 (list.n/range 0 num-partials)) + (list@map (.function (_ [stage @label]) + (let [load-partialsI (if (n.> 0 stage) + (|> (list.n/range 0 (dec stage)) + (list@map (|>> reference.partial-name (load-fieldI class))) + _.fuse) + function.identity)] + (cond (i.= over-extent (.int stage)) + (|>> (_.label @label) + (_.ALOAD 0) + (when> [(new> (n.> 0 stage) [])] + [(_.INVOKEVIRTUAL class "reset" (reset-method class))]) + load-partialsI + (inputsI 1 apply-arity) + (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity)) + _.ARETURN) + + (i.> over-extent (.int stage)) + (let [args-to-completion (|> function-arity (n.- stage)) + args-left (|> apply-arity (n.- args-to-completion))] + (|>> (_.label @label) + (_.ALOAD 0) + (_.INVOKEVIRTUAL class "reset" (reset-method class)) + load-partialsI + (inputsI 1 args-to-completion) + (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity)) + (applysI (inc args-to-completion) args-left) + _.ARETURN)) + + ## (i.< over-extent (.int stage)) + (let [env-size (list.size env) + load-capturedI (|> (case env-size + 0 (list) + _ (list.n/range 0 (dec env-size))) + (list@map (|>> reference.foreign-name (load-fieldI class))) + _.fuse)] + (|>> (_.label @label) + (_.NEW class) + _.DUP + load-capturedI + get-amount-of-partialsI + (inc-intI apply-arity) + load-partialsI + (inputsI 1 apply-arity) + (nullsI (|> num-partials (n.- apply-arity) (n.- stage))) + (_.INVOKESPECIAL class "" (init-method env function-arity)) + _.ARETURN)) + )))) + _.fuse)] + (def.method #$.Public $.noneM //runtime.apply-method (//runtime.apply-signature apply-arity) + (|>> get-amount-of-partialsI + (_.TABLESWITCH +0 (|> num-partials dec .int) + @default @labels) + casesI + )))) + +(def: #export with-environment + (-> Environment Def) + (|>> list.enumerate + (list@map (.function (_ [env-idx env-source]) + (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value))) + def.fuse)) + +(def: (with-partial arity) + (-> Arity Def) + (if (poly-arg? arity) + (|> (list.n/range 0 (n.- 2 arity)) + (list@map (.function (_ idx) + (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value))) + def.fuse) + function.identity)) + +(def: #export (with-function archive @begin class env arity bodyI) + (-> Archive Label Text Environment Arity Inst + (Operation [Def Inst])) + (let [classD (type.class class (list)) + applyD (: Def + (if (poly-arg? arity) + (|> (n.min arity //runtime.num-apply-variants) + (list.n/range 1) + (list@map (with-apply classD env arity @begin bodyI)) + (list& (with-implementation arity @begin bodyI)) + def.fuse) + (def.method #$.Public $.strictM //runtime.apply-method (//runtime.apply-signature 1) + (|>> (_.label @begin) + bodyI + _.ARETURN)))) + functionD (: Def + (|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity)) + (with-environment env) + (with-partial arity) + (with-init classD env arity) + (with-reset classD arity env) + applyD + ))] + (do phase.monad + [instanceI (instance archive classD arity env)] + (wrap [functionD instanceI])))) + +(def: #export (function generate archive [env arity bodyS]) + (Generator Abstraction) + (do phase.monad + [@begin _.make-label + [function-context bodyI] (generation.with-new-context archive + (generation.with-anchor [@begin 1] + (generate archive bodyS))) + #let [function-class (//.class-name function-context)] + [functionD instanceI] (with-function archive @begin function-class env arity bodyI) + _ (generation.save! true ["" (%.nat (product.right function-context))] + [function-class + (def.class #$.V1_6 #$.Public $.finalC + function-class (list) + //.$Function (list) + functionD)])] + (wrap instanceI))) + +(def: #export (call generate archive [functionS argsS]) + (Generator Apply) + (do {@ phase.monad} + [functionI (generate archive functionS) + argsI (monad.map @ (generate archive) argsS) + #let [applyI (|> argsI + (list.split-all //runtime.num-apply-variants) + (list@map (.function (_ chunkI+) + (|>> (_.CHECKCAST //.$Function) + (_.fuse chunkI+) + (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature (list.size chunkI+)))))) + _.fuse)]] + (wrap (|>> functionI + applyI)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux new file mode 100644 index 000000000..1f2168fed --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -0,0 +1,81 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + [number + ["n" nat]] + [collection + ["." list ("#/." functor monoid)]]] + [tool + [compiler + [reference (#+ Register)] + ["." phase] + [language + [lux + ["." synthesis (#+ Synthesis)] + ["." generation]]]]]] + [luxc + [lang + [host + [jvm (#+ Inst Operation Phase Generator) + ["_" inst]]]]] + ["." //]) + +(def: (invariant? register changeS) + (-> Register Synthesis Bit) + (case changeS + (^ (synthesis.variable/local var)) + (n.= register var) + + _ + false)) + +(def: #export (recur translate archive argsS) + (Generator (List Synthesis)) + (do {@ phase.monad} + [[@begin start] generation.anchor + #let [end (|> argsS list.size dec (n.+ start)) + pairs (list.zip2 (list.n/range start end) + argsS)] + ## It may look weird that first I compile the values separately, + ## and then I compile the stores/allocations. + ## It must be done that way in order to avoid a potential bug. + ## Let's say that you'll recur with 2 expressions: X and Y. + ## If Y depends on the value of X, and you don't compile values + ## and stores separately, then by the time Y is evaluated, it + ## will refer to the new value of X, instead of the old value, as + ## should be the case. + valuesI+ (monad.map @ (function (_ [register argS]) + (: (Operation Inst) + (if (invariant? register argS) + (wrap function.identity) + (translate archive argS)))) + pairs) + #let [storesI+ (list/map (function (_ [register argS]) + (: Inst + (if (invariant? register argS) + function.identity + (_.ASTORE register)))) + (list.reverse pairs))]] + (wrap (|>> (_.fuse valuesI+) + (_.fuse storesI+) + (_.GOTO @begin))))) + +(def: #export (scope translate archive [start initsS+ iterationS]) + (Generator [Nat (List Synthesis) Synthesis]) + (do {@ phase.monad} + [@begin _.make-label + initsI+ (monad.map @ (translate archive) initsS+) + iterationI (generation.with-anchor [@begin start] + (translate archive iterationS)) + #let [initializationI (|> (list.enumerate initsI+) + (list/map (function (_ [register initI]) + (|>> initI + (_.ASTORE (n.+ start register))))) + _.fuse)]] + (wrap (|>> initializationI + (_.label @begin) + iterationI)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux new file mode 100644 index 000000000..873c363bd --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -0,0 +1,30 @@ +(.module: + [lux (#- i64) + [target + [jvm + ["." type]]] + [tool + [compiler + [phase ("operation@." monad)]]]] + [luxc + [lang + [host + ["." jvm (#+ Inst Operation) + ["_" inst]]]]]) + +(def: #export bit + (-> Bit (Operation Inst)) + (let [Boolean (type.class "java.lang.Boolean" (list))] + (function (_ value) + (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) + +(template [ ] + [(def: #export ( value) + (-> (Operation Inst)) + (let [loadI (|> value )] + (operation@wrap (|>> loadI ))))] + + [i64 (I64 Any) (<| _.long .int) (_.wrap type.long)] + [f64 Frac _.double (_.wrap type.double)] + [text Text _.string (<|)] + ) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux new file mode 100644 index 000000000..7ac897009 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -0,0 +1,82 @@ +(.module: + [lux #* + [target + [jvm + ["$t" type]]]] + [luxc + [lang + [host + ["_" jvm + ["$d" def] + ["$i" inst]]] + [translation + ["." jvm + ["." runtime]]]]]) + +(def: #export class "LuxProgram") + +(def: ^Object ($t.class "java.lang.Object" (list))) + +(def: #export (program programI) + (-> _.Inst _.Definition) + (let [nilI runtime.noneI + num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) + decI (|>> ($i.int +1) $i.ISUB) + headI (|>> $i.DUP + ($i.ALOAD 0) + $i.SWAP + $i.AALOAD + $i.SWAP + $i.DUP_X2 + $i.POP) + pairI (|>> ($i.int +2) + ($i.ANEWARRAY ..^Object) + $i.DUP_X1 + $i.SWAP + ($i.int +0) + $i.SWAP + $i.AASTORE + $i.DUP_X1 + $i.SWAP + ($i.int +1) + $i.SWAP + $i.AASTORE) + consI (|>> ($i.int +1) + ($i.string "") + $i.DUP2_X1 + $i.POP2 + runtime.variantI) + prepare-input-listI (<| $i.with-label (function (_ @loop)) + $i.with-label (function (_ @end)) + (|>> nilI + num-inputsI + ($i.label @loop) + decI + $i.DUP + ($i.IFLT @end) + headI + pairI + consI + $i.SWAP + ($i.GOTO @loop) + ($i.label @end) + $i.POP)) + feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)) + run-ioI (|>> ($i.CHECKCAST jvm.$Function) + $i.NULL + ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))) + main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list)))) + $t.void + (list)])] + [..class + ($d.class #_.V1_6 + #_.Public _.finalC + ..class + (list) ..^Object + (list) + (|>> ($d.method #_.Public _.staticM "main" main-type + (|>> programI + prepare-input-listI + feed-inputsI + run-ioI + $i.RETURN))))])) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux new file mode 100644 index 000000000..6bcf4a2e5 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux @@ -0,0 +1,65 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [data + [text + ["%" format (#+ format)]]] + [target + [jvm + ["." type]]] + [tool + [compiler + ["." reference (#+ Register Variable)] + ["." phase ("operation@." monad)] + [meta + [archive (#+ Archive)]] + [language + [lux + ["." generation]]]]]] + [luxc + [lang + [host + [jvm (#+ Inst Operation) + ["_" inst]]]]] + ["." // + ["#." runtime]]) + +(template [ ] + [(def: #export + (-> Nat Text) + (|>> %.nat (format )))] + + [foreign-name "f"] + [partial-name "p"] + ) + +(def: (foreign archive variable) + (-> Archive Register (Operation Inst)) + (do {@ phase.monad} + [class-name (:: @ map //.class-name + (generation.context archive))] + (wrap (|>> (_.ALOAD 0) + (_.GETFIELD (type.class class-name (list)) + (|> variable .nat foreign-name) + //.$Value))))) + +(def: local + (-> Register Inst) + (|>> _.ALOAD)) + +(def: #export (variable archive variable) + (-> Archive Variable (Operation Inst)) + (case variable + (#reference.Local variable) + (operation@wrap (local variable)) + + (#reference.Foreign variable) + (foreign archive variable))) + +(def: #export (constant archive name) + (-> Archive Name (Operation Inst)) + (do {@ phase.monad} + [class-name (:: @ map //.class-name + (generation.remember archive name))] + (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux new file mode 100644 index 000000000..a657a7a38 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -0,0 +1,387 @@ +(.module: + [lux (#- Type) + [abstract + [monad (#+ do)]] + [data + [binary (#+ Binary)] + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)] + ["." row]]] + ["." math] + [target + [jvm + ["." type (#+ Type) + ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] + ["." reflection]]]] + [tool + [compiler (#+ Output) + [arity (#+ Arity)] + ["." phase] + [language + [lux + ["." synthesis] + ["." generation]]] + [meta + [archive + ["." artifact (#+ Registry)]]]]]] + [luxc + [lang + [host + ["$" jvm (#+ Label Inst Def Operation) + ["$d" def] + ["_" inst]]]]] + ["." // (#+ ByteCode)]) + +(def: $Text (type.class "java.lang.String" (list))) +(def: #export $Tag type.int) +(def: #export $Flag (type.class "java.lang.Object" (list))) +(def: #export $Value (type.class "java.lang.Object" (list))) +(def: #export $Index type.int) +(def: #export $Stack (type.array $Value)) +(def: $Throwable (type.class "java.lang.Throwable" (list))) + +(def: nullary-init-methodT + (type.method [(list) type.void (list)])) + +(def: throw-methodT + (type.method [(list) type.void (list)])) + +(def: #export logI + Inst + (let [PrintStream (type.class "java.io.PrintStream" (list)) + outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream) + printI (function (_ method) + (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)])))] + (|>> outI (_.string "LOG: ") (printI "print") + outI _.SWAP (printI "println")))) + +(def: variant-method + (type.method [(list $Tag $Flag $Value) //.$Variant (list)])) + +(def: #export variantI + Inst + (_.INVOKESTATIC //.$Runtime "variant_make" variant-method)) + +(def: #export leftI + Inst + (|>> (_.int +0) + _.NULL + _.DUP2_X1 + _.POP2 + variantI)) + +(def: #export rightI + Inst + (|>> (_.int +1) + (_.string "") + _.DUP2_X1 + _.POP2 + variantI)) + +(def: #export someI Inst rightI) + +(def: #export noneI + Inst + (|>> (_.int +0) + _.NULL + (_.string synthesis.unit) + variantI)) + +(def: (tryI unsafeI) + (-> Inst Inst) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list))) + (_.label @from) + unsafeI + someI + _.ARETURN + (_.label @to) + (_.label @handler) + noneI + _.ARETURN))) + +(def: #export partials-field Text "partials") +(def: #export apply-method Text "apply") +(def: #export num-apply-variants Nat 8) + +(def: #export (apply-signature arity) + (-> Arity (Type Method)) + (type.method [(list.repeat arity $Value) $Value (list)])) + +(def: adt-methods + Def + (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE) + store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE) + store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)] + (|>> ($d.method #$.Public $.staticM "variant_make" + (type.method [(list $Tag $Flag $Value) //.$Variant (list)]) + (|>> (_.int +3) + (_.ANEWARRAY $Value) + store-tagI + store-flagI + store-valueI + _.ARETURN))))) + +(def: frac-methods + Def + (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)]) + (tryI + (|>> (_.ALOAD 0) + (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)])) + (_.wrap type.double)))) + )) + +(def: (illegal-state-exception message) + (-> Text Inst) + (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))] + (|>> (_.NEW IllegalStateException) + _.DUP + (_.string message) + (_.INVOKESPECIAL IllegalStateException "" (type.method [(list $Text) type.void (list)]))))) + +(def: pm-methods + Def + (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH) + last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB) + leftsI (_.ILOAD 1) + left-indexI leftsI + sub-leftsI (|>> leftsI + last-rightI + _.ISUB) + sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple)) + recurI (: (-> Label Inst) + (function (_ @loop) + (|>> sub-leftsI (_.ISTORE 1) + sub-tupleI (_.ASTORE 0) + (_.GOTO @loop))))] + (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT + (|>> (illegal-state-exception "Invalid expression for pattern-matching.") + _.ATHROW)) + ($d.method #$.Public $.staticM "apply_fail" throw-methodT + (|>> (illegal-state-exception "Error while applying function.") + _.ATHROW)) + ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)]) + (|>> (_.int +2) + (_.ANEWARRAY $Value) + _.DUP + (_.int +1) + (_.ALOAD 0) + _.AASTORE + _.DUP + (_.int +0) + (_.ALOAD 1) + _.AASTORE + _.ARETURN)) + ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)]) + (<| _.with-label (function (_ @loop)) + _.with-label (function (_ @perfect-match!)) + _.with-label (function (_ @tags-match!)) + _.with-label (function (_ @maybe-nested)) + _.with-label (function (_ @mismatch!)) + (let [$variant (_.ALOAD 0) + $tag (_.ILOAD 1) + $last? (_.ALOAD 2) + + variant-partI (: (-> Nat Inst) + (function (_ idx) + (|>> (_.int (.int idx)) _.AALOAD))) + ::tag (: Inst + (|>> (variant-partI 0) (_.unwrap type.int))) + ::last? (variant-partI 1) + ::value (variant-partI 2) + + super-nested-tag (|>> _.SWAP ## variant::tag, tag + _.ISUB) + super-nested (|>> super-nested-tag ## super-tag + $variant ::last? ## super-tag, super-last + $variant ::value ## super-tag, super-last, super-value + ..variantI) + + update-$tag _.ISUB + update-$variant (|>> $variant ::value + (_.CHECKCAST //.$Variant) + (_.ASTORE 0)) + iterate! (: (-> Label Inst) + (function (_ @loop) + (|>> update-$variant + update-$tag + (_.GOTO @loop)))) + + not-found _.NULL]) + (|>> $tag ## tag + (_.label @loop) + $variant ::tag ## tag, variant::tag + _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag + _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag + $last? (_.IFNULL @mismatch!) ## tag, variant::tag + super-nested ## super-variant + _.ARETURN + (_.label @tags-match!) ## tag, variant::tag + $last? ## tag, variant::tag, last? + $variant ::last? ## tag, variant::tag, last?, variant::last? + (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag + (_.label @maybe-nested) ## tag, variant::tag + $variant ::last? ## tag, variant::tag, variant::last? + (_.IFNULL @mismatch!) ## tag, variant::tag + (iterate! @loop) + (_.label @perfect-match!) ## tag, variant::tag + ## _.POP2 + $variant ::value + _.ARETURN + (_.label @mismatch!) ## tag, variant::tag + ## _.POP2 + not-found + _.ARETURN))) + ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)]) + (<| _.with-label (function (_ @loop)) + _.with-label (function (_ @recursive)) + (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)]) + (|>> (_.label @loop) + leftsI last-rightI (_.IF_ICMPGE @recursive) + left-accessI + _.ARETURN + (_.label @recursive) + ## Recursive + (recurI @loop)))) + ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)]) + (<| _.with-label (function (_ @loop)) + _.with-label (function (_ @not-tail)) + _.with-label (function (_ @slice)) + (let [right-indexI (|>> leftsI + (_.int +1) + _.IADD) + right-accessI (|>> (_.ALOAD 0) + _.SWAP + _.AALOAD) + sub-rightI (|>> (_.ALOAD 0) + right-indexI + tuple-sizeI + (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange" + (type.method [(list //.$Tuple $Index $Index) + //.$Tuple + (list)])))]) + (|>> (_.label @loop) + last-rightI right-indexI + _.DUP2 (_.IF_ICMPNE @not-tail) + ## _.POP + right-accessI + _.ARETURN + (_.label @not-tail) + (_.IF_ICMPGT @slice) + ## Must recurse + (recurI @loop) + (_.label @slice) + sub-rightI + _.ARETURN + ))) + ))) + +(def: #export try (type.method [(list //.$Function) //.$Variant (list)])) + +(def: io-methods + Def + (let [StringWriter (type.class "java.io.StringWriter" (list)) + PrintWriter (type.class "java.io.PrintWriter" (list)) + string-writerI (|>> (_.NEW StringWriter) + _.DUP + (_.INVOKESPECIAL StringWriter "" nullary-init-methodT)) + print-writerI (|>> (_.NEW PrintWriter) + _.SWAP + _.DUP2 + _.POP + _.SWAP + (_.boolean true) + (_.INVOKESPECIAL PrintWriter "" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + )] + (|>> ($d.method #$.Public $.staticM "try" ..try + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler $Throwable) + (_.label @from) + (_.ALOAD 0) + _.NULL + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1)) + rightI + _.ARETURN + (_.label @to) + (_.label @handler) + string-writerI ## TW + _.DUP2 ## TWTW + print-writerI ## TWTP + (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW + (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS + _.SWAP _.POP leftI + _.ARETURN))) + ))) + +(def: reflection + (All [category] + (-> (Type (<| Return' Value' category)) Text)) + (|>> type.reflection reflection.reflection)) + +(def: translate-runtime + (Operation [Text Binary]) + (let [runtime-class (..reflection //.$Runtime) + bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime-class (list) (type.class "java.lang.Object" (list)) (list) + (|>> adt-methods + frac-methods + pm-methods + io-methods)) + payload ["0" bytecode]] + (do phase.monad + [_ (generation.execute! runtime-class [runtime-class bytecode]) + _ (generation.save! false ["" "0"] payload)] + (wrap payload)))) + +(def: translate-function + (Operation [Text Binary]) + (let [applyI (|> (list.n/range 2 num-apply-variants) + (list@map (function (_ arity) + ($d.method #$.Public $.noneM apply-method (apply-signature arity) + (let [preI (|> (list.n/range 0 (dec arity)) + (list@map _.ALOAD) + _.fuse)] + (|>> preI + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity))) + (_.CHECKCAST //.$Function) + (_.ALOAD arity) + (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1)) + _.ARETURN))))) + (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1))) + $d.fuse) + $Object (type.class "java.lang.Object" (list)) + function-class (..reflection //.$Function) + bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function-class (list) $Object (list) + (|>> ($d.field #$.Public $.finalF partials-field type.int) + ($d.method #$.Public $.noneM "" (type.method [(list type.int) type.void (list)]) + (|>> (_.ALOAD 0) + (_.INVOKESPECIAL $Object "" nullary-init-methodT) + (_.ALOAD 0) + (_.ILOAD 1) + (_.PUTFIELD //.$Function partials-field type.int) + _.RETURN)) + applyI)) + payload ["1" bytecode]] + (do phase.monad + [_ (generation.execute! function-class [function-class bytecode]) + _ (generation.save! false ["" "1"] payload)] + (wrap payload)))) + +(def: #export translate + (Operation [Registry Output]) + (do phase.monad + [runtime-payload ..translate-runtime + function-payload ..translate-function] + (wrap [(|> artifact.empty + artifact.resource + product.right + artifact.resource + product.right) + (row.row runtime-payload + function-payload)]))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux new file mode 100644 index 000000000..46f87142a --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -0,0 +1,79 @@ +(.module: + [lux (#- Type) + [abstract + ["." monad (#+ do)]] + [control + ["ex" exception (#+ exception:)]] + [data + [number + ["n" nat]] + [text + ["%" format (#+ format)]] + [collection + ["." list]]] + [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 + [jvm (#+ Inst Operation Phase Generator) + ["_" inst]]]]] + ["." // + ["#." runtime]]) + +(exception: #export (not-a-tuple {size Nat}) + (ex.report ["Expected size" ">= 2"] + ["Actual size" (%.nat size)])) + +(def: #export (tuple generate archive members) + (Generator (List Synthesis)) + (do {@ phase.monad} + [#let [size (list.size members)] + _ (phase.assert not-a-tuple size + (n.>= 2 size)) + membersI (|> members + list.enumerate + (monad.map @ (function (_ [idx member]) + (do @ + [memberI (generate archive member)] + (wrap (|>> _.DUP + (_.int (.int idx)) + memberI + _.AASTORE))))) + (:: @ map _.fuse))] + (wrap (|>> (_.int (.int size)) + (_.array //runtime.$Value) + membersI)))) + +(def: (flagI right?) + (-> Bit Inst) + (if right? + (_.string "") + _.NULL)) + +(def: #export (variant generate archive [lefts right? member]) + (Generator [Nat Bit Synthesis]) + (do phase.monad + [memberI (generate archive member)] + (wrap (|>> (_.int (.int (if right? + (.inc lefts) + lefts))) + (flagI right?) + memberI + (_.INVOKESTATIC //.$Runtime + "variant_make" + (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value) + //.$Variant + (list)])))))) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux new file mode 100644 index 000000000..e2cf047e9 --- /dev/null +++ b/lux-jvm/source/program.lux @@ -0,0 +1,180 @@ +(.module: + [lux (#- Definition) + ["@" target] + ["." host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + [parser + [cli (#+ program:)]] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + [array (#+ Array)] + ["." dictionary]]] + [world + ["." file]] + [target + [jvm + [bytecode (#+ Bytecode)]]] + [tool + [compiler + [default + ["." platform (#+ Platform)]] + [language + [lux + [analysis + ["." macro (#+ Expander)]] + [phase + [extension (#+ Phase Bundle Operation Handler Extender) + ["." analysis #_ + ["#" jvm]] + ["." generation #_ + ["#" jvm]] + ## ["." directive #_ + ## ["#" jvm]] + ] + [generation + ["." jvm #_ + ## ["." runtime (#+ Anchor Definition)] + ["." packager] + ## ["#/." host] + ]]]]]]]] + [program + ["/" compositor + ["/." cli] + ["/." static]]] + [luxc + [lang + [host + ["_" jvm]] + ["." directive #_ + ["#" jvm]] + [translation + ["." jvm + ["." runtime] + ["." expression] + ["#/." program] + ["translation" extension]]]]]) + +(import: #long java/lang/reflect/Method + (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) + +(import: #long (java/lang/Class c) + (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)) + +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) + +(def: _object-class + (java/lang/Class java/lang/Object) + (host.class-for java/lang/Object)) + +(def: _apply2-args + (Array (java/lang/Class java/lang/Object)) + (|> (host.array (java/lang/Class java/lang/Object) 2) + (host.array-write 0 _object-class) + (host.array-write 1 _object-class))) + +(def: _apply4-args + (Array (java/lang/Class java/lang/Object)) + (|> (host.array (java/lang/Class java/lang/Object) 4) + (host.array-write 0 _object-class) + (host.array-write 1 _object-class) + (host.array-write 2 _object-class) + (host.array-write 3 _object-class))) + +(def: #export (expander macro inputs lux) + Expander + (do try.monad + [apply-method (|> macro + (:coerce java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod "apply" _apply2-args))] + (:coerce (Try (Try [Lux (List Code)])) + (java/lang/reflect/Method::invoke + (:coerce java/lang/Object macro) + (|> (host.array java/lang/Object 2) + (host.array-write 0 (:coerce java/lang/Object inputs)) + (host.array-write 1 (:coerce java/lang/Object lux))) + apply-method)))) + +(def: #export platform + ## (IO (Platform Anchor (Bytecode Any) Definition)) + (IO (Platform _.Anchor _.Inst _.Definition)) + (do io.monad + [## host jvm/host.host + host jvm.host] + (wrap {#platform.&file-system (file.async file.system) + #platform.host host + ## #platform.phase jvm.generate + #platform.phase expression.translate + ## #platform.runtime runtime.generate + #platform.runtime runtime.translate + #platform.write product.right}))) + +(def: extender + Extender + ## TODO: Stop relying on coercions ASAP. + (<| (:coerce Extender) + (function (@self handler)) + (:coerce Handler) + (function (@self name phase)) + (:coerce Phase) + (function (@self parameters)) + (:coerce Operation) + (function (@self state)) + (:coerce Try) + try.assume + (:coerce Try) + (do try.monad + [method (|> handler + (:coerce java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod "apply" _apply4-args))] + (java/lang/reflect/Method::invoke + (:coerce java/lang/Object handler) + (|> (host.array java/lang/Object 4) + (host.array-write 0 (:coerce java/lang/Object name)) + (host.array-write 1 (:coerce java/lang/Object phase)) + (host.array-write 2 (:coerce java/lang/Object parameters)) + (host.array-write 3 (:coerce java/lang/Object state))) + method)))) + +(def: (target service) + (-> /cli.Service /cli.Target) + (case service + (^or (#/cli.Compilation [sources libraries target module]) + (#/cli.Interpretation [sources libraries target module]) + (#/cli.Export [sources target])) + target)) + +(def: (declare-success! _) + (-> Any (Promise Any)) + (promise.future (io.exit +0))) + +(program: [{service /cli.service}] + (let [jar-path (format (..target service) (:: file.system separator) "program.jar")] + (exec (do promise.monad + [_ (/.compiler {#/static.host @.jvm + #/static.host-module-extension ".jvm" + #/static.target (..target service) + #/static.artifact-extension ".class"} + ..expander + analysis.bundle + ..platform + ## generation.bundle + translation.bundle + (directive.bundle ..extender) + jvm/program.program + ..extender + service + [(packager.package jvm/program.class) jar-path])] + (..declare-success! [])) + (io.io [])))) diff --git a/lux-jvm/source/test/program.lux b/lux-jvm/source/test/program.lux new file mode 100644 index 000000000..270f9005d --- /dev/null +++ b/lux-jvm/source/test/program.lux @@ -0,0 +1,18 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + ["." io] + [parser + [cli (#+ program:)]]]] + [spec + ["." compositor]] + {1 + ["." /]}) + +(program: args + (<| io.io + _.run! + ## (_.times 100) + (_.seed 1985013625126912890) + (compositor.spec /.jvm /.bundle /.expander /.program))) diff --git a/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux b/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux new file mode 100644 index 000000000..f9905c8bc --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/analysis/host.jvm.lux @@ -0,0 +1,549 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + pipe] + [data + ["e" error] + ["." product] + ["." maybe] + [text ("text/" Equivalence) + format] + [collection + ["." array] + [list ("list/" Fold)] + ["dict" dictionary]]] + [math + ["r" random "r/" Monad]] + ["." type] + [macro (#+ Monad) + ["." code]] + [compiler + ["." default + [".L" init] + [phase + [analysis + [".A" type]] + [extension + [analysis + [".AE" host]]]]]] + test] + [/// + ["_." primitive]]) + +(template [ ] + [(def: ( procedure params output-type) + (-> Text (List Code) Type Bit) + (|> (do Monad + [## runtime-bytecode @runtime.translate + ] + (default.with-scope + (typeA.with-type output-type + (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))) + (analysis.with-current-module "") + (macro.run (initL.compiler [])) + (case> (#e.Success _) + + + (#e.Error error) + )))] + + [success #1 #0] + [failure #0 #1] + ) + +(template [ ] + [(def: ( syntax output-type) + (-> Code Type Bit) + (|> (do Monad + [## runtime-bytecode @runtime.translate + ] + (default.with-scope + (typeA.with-type output-type + (_primitive.analyse syntax)))) + (analysis.with-current-module "") + (macro.run (initL.compiler [])) + (case> (#e.Success _) + + + (#e.Error error) + )))] + + [success' #1 #0] + [failure' #0 #1] + ) + +(context: "Conversions [double + float]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert double-to-float" "java.lang.Double" hostAE.Float] + ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer] + ["jvm convert double-to-long" "java.lang.Double" hostAE.Long] + ["jvm convert float-to-double" "java.lang.Float" hostAE.Double] + ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer] + ["jvm convert float-to-long" "java.lang.Float" hostAE.Long] + )] + ($_ seq + + ))) + +(context: "Conversions [int]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte] + ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character] + ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double] + ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float] + ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long] + ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short] + )] + ($_ seq + + ))) + +(context: "Conversions [long]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert long-to-double" "java.lang.Long" hostAE.Double] + ["jvm convert long-to-float" "java.lang.Long" hostAE.Float] + ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer] + ["jvm convert long-to-short" "java.lang.Long" hostAE.Short] + ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte] + )] + ($_ seq + + ))) + +(context: "Conversions [char + byte + short]." + (with-expansions [ (template [ ] + [(test (format " SUCCESS") + (success (list (' ("lux coerce" (+0 (+0)) []))) )) + (test (format " FAILURE") + (failure (list (' [])) ))] + + ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte] + ["jvm convert char-to-short" "java.lang.Character" hostAE.Short] + ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer] + ["jvm convert char-to-long" "java.lang.Character" hostAE.Long] + ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long] + ["jvm convert short-to-long" "java.lang.Short" hostAE.Long] + )] + ($_ seq + + ))) + +(template [ ] + [(context: (format "Arithmetic " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " +") ] + [(format "jvm " " -") ] + [(format "jvm " " *") ] + [(format "jvm " " /") ] + [(format "jvm " " %") ] + )] + ($_ seq + + ))) + + (context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + ))) + + (context: (format "Bitwise " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " and") ] + [(format "jvm " " or") ] + [(format "jvm " " xor") ] + [(format "jvm " " shl") "java.lang.Integer" ] + [(format "jvm " " shr") "java.lang.Integer" ] + [(format "jvm " " ushr") "java.lang.Integer" ] + )] + ($_ seq + + )))] + + + ["int" "java.lang.Integer" hostAE.Integer] + ["long" "java.lang.Long" hostAE.Long] + ) + +(template [ ] + [(context: (format "Arithmetic " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " +") ] + [(format "jvm " " -") ] + [(format "jvm " " *") ] + [(format "jvm " " /") ] + [(format "jvm " " %") ] + )] + ($_ seq + + ))) + + (context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + )))] + + + ["float" "java.lang.Float" hostAE.Float] + ["double" "java.lang.Double" hostAE.Double] + ) + +(template [ ] + [(context: (format "Order " "[" "].") + (with-expansions [ (template [ ] + [(test + (success + (list (' ("lux coerce" (+0 (+0)) [])) + (' ("lux coerce" (+0 (+0)) []))) + ))] + + [(format "jvm " " =") hostAE.Boolean] + [(format "jvm " " <") hostAE.Boolean] + )] + ($_ seq + + )))] + + + ["char" "java.lang.Character" hostAE.Character] + ) + +(def: array-type + (r.Random [Text Text]) + (let [entries (dict.entries hostAE.boxes) + num-entries (list.size entries)] + (do r.Monad + [choice (|> r.nat (:: @ map (n/% (inc num-entries)))) + #let [[unboxed boxed] (: [Text Text] + (|> entries + (list.nth choice) + (maybe.default ["java.lang.Object" "java.lang.Object"])))]] + (wrap [unboxed boxed])))) + +(context: "Array." + (<| (times +100) + (do @ + [#let [cap (|>> (n/% +10) (n/max +1))] + [unboxed boxed] array-type + size (|> r.nat (:: @ map cap)) + idx (|> r.nat (:: @ map (n/% size))) + level (|> r.nat (:: @ map cap)) + #let [unboxedT (#.Primitive unboxed (list)) + arrayT (#.Primitive "#Array" (list unboxedT)) + arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0))) + ("jvm array new" (~ (code.nat size))))) + boxedT (#.Primitive boxed (list)) + boxedTC (` (+0 (~ (code.text boxed)) (+0))) + multi-arrayT (list/fold (function (_ _ innerT) + (|> innerT (list) (#.Primitive "#Array"))) + boxedT + (list.n/range +1 level))]] + ($_ seq + (test "jvm array new" + (success "jvm array new" + (list (code.nat size)) + arrayT)) + (test "jvm array new (no nesting)" + (failure "jvm array new" + (list (code.nat size)) + unboxedT)) + (test "jvm array new (nested/multi-level)" + (success "jvm array new" + (list (code.nat size)) + multi-arrayT)) + (test "jvm array length" + (success "jvm array length" + (list arrayC) + Nat)) + (test "jvm array read" + (success' (` ("jvm object cast" + ("jvm array read" (~ arrayC) (~ (code.nat idx))))) + boxedT)) + (test "jvm array write" + (success "jvm array write" + (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) []))) + arrayT)) + )))) + +(def: throwables + (List Text) + (list "java.lang.Throwable" + "java.lang.Error" + "java.io.IOError" + "java.lang.VirtualMachineError" + "java.lang.Exception" + "java.io.IOException" + "java.lang.RuntimeException")) + +(context: "Object." + (<| (times +100) + (do @ + [[unboxed boxed] array-type + [!unboxed !boxed] (|> array-type + (r.filter (function (_ [!unboxed !boxed]) + (not (text/= boxed !boxed))))) + #let [boxedT (#.Primitive boxed (list)) + boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0)) + ("jvm object null"))) + !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0)) + ("jvm object null"))) + unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0)) + ("jvm object null")))] + throwable (|> r.nat + (:: @ map (n/% (inc (list.size throwables)))) + (:: @ map (function (_ idx) + (|> throwables + (list.nth idx) + (maybe.default "java.lang.Object"))))) + #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0)) + ("jvm object null")))]] + ($_ seq + (test "jvm object null" + (success "jvm object null" + (list) + (#.Primitive boxed (list)))) + (test "jvm object null (no primitives)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object null" + (list) + (#.Primitive unboxed (list))))) + (test "jvm object null?" + (success "jvm object null?" + (list boxedC) + Bit)) + (test "jvm object synchronized" + (success "jvm object synchronized" + (list boxedC boxedC) + boxedT)) + (test "jvm object synchronized (no primitives)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object synchronized" + (list unboxedC boxedC) + boxedT))) + (test "jvm object throw" + (or (text/= "java.lang.Object" throwable) + (success "jvm object throw" + (list throwableC) + Nothing))) + (test "jvm object class" + (success "jvm object class" + (list (code.text boxed)) + (#.Primitive "java.lang.Class" (list boxedT)))) + (test "jvm object instance?" + (success "jvm object instance?" + (list (code.text boxed) + boxedC) + Bit)) + (test "jvm object instance? (lineage)" + (success "jvm object instance?" + (list (' "java.lang.Object") + boxedC) + Bit)) + (test "jvm object instance? (no lineage)" + (or (text/= "java.lang.Object" boxed) + (failure "jvm object instance?" + (list (code.text boxed) + !boxedC) + Bit))) + )))) + +(context: "Member [Static Field]." + ($_ seq + (test "jvm member static get" + (success "jvm member static get" + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.io.PrintStream" (list)))) + (test "jvm member static get (inheritance out)" + (success "jvm member static get" + (list (code.text "java.lang.System") + (code.text "out")) + (#.Primitive "java.lang.Object" (list)))) + (test "jvm member static put" + (success "jvm member static put" + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") + (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0)) + ("jvm object null")))) + Any)) + (test "jvm member static put (final)" + (failure "jvm member static put" + (list (code.text "java.lang.System") + (code.text "out") + (`' ("lux check" (+0 "java.io.PrintStream" (+0)) + ("jvm object null")))) + Any)) + (test "jvm member static put (inheritance in)" + (success "jvm member static put" + (list (code.text "java.awt.datatransfer.DataFlavor") + (code.text "allHtmlFlavor") + (`' ("jvm object cast" + ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0)) + ("jvm object null"))))) + Any)) + )) + +(context: "Member [Virtual Field]." + ($_ seq + (test "jvm member virtual get" + (success "jvm member virtual get" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.String" (list)))) + (test "jvm member virtual get (inheritance out)" + (success "jvm member virtual get" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.Object" (list)))) + (test "jvm member virtual put" + (success "jvm member virtual put" + (list (code.text "org.omg.CORBA.ValueMember") + (code.text "id") + (`' ("lux check" (+0 "java.lang.String" (+0)) + ("jvm object null"))) + (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0)) + ("jvm object null")))) + (primitive "org.omg.CORBA.ValueMember"))) + (test "jvm member virtual put (final)" + (failure "jvm member virtual put" + (list (code.text "javax.swing.text.html.parser.DTD") + (code.text "applet") + (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0)) + ("jvm object null"))) + (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0)) + ("jvm object null")))) + (primitive "javax.swing.text.html.parser.DTD"))) + (test "jvm member virtual put (inheritance in)" + (success "jvm member virtual put" + (list (code.text "java.awt.GridBagConstraints") + (code.text "insets") + (`' ("jvm object cast" + ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0)) + ("jvm object null")))) + (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0)) + ("jvm object null")))) + (primitive "java.awt.GridBagConstraints"))) + )) + +(context: "Boxing/Unboxing." + ($_ seq + (test "jvm member static get" + (success "jvm member static get" + (list (code.text "java.util.GregorianCalendar") + (code.text "AD")) + (#.Primitive "java.lang.Integer" (list)))) + (test "jvm member virtual get" + (success "jvm member virtual get" + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") + (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) + ("jvm object null")))) + (#.Primitive "java.lang.Integer" (list)))) + (test "jvm member virtual put" + (success "jvm member virtual put" + (list (code.text "javax.accessibility.AccessibleAttributeSequence") + (code.text "startIndex") + (`' ("jvm object cast" + ("lux check" (+0 "java.lang.Integer" (+0)) + ("jvm object null")))) + (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0)) + ("jvm object null")))) + (primitive "javax.accessibility.AccessibleAttributeSequence"))) + )) + +(context: "Member [Method]." + (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0)) + +123)) + intC (`' ("jvm convert long-to-int" (~ longC))) + stringC (' ("lux coerce" (+0 "java.lang.String" (+0)) + "YOLO")) + objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0))) + ("jvm member invoke constructor" "java.util.ArrayList" + ["int" ("jvm object cast" (~ intC))])))] + ($_ seq + (test "jvm member invoke static" + (success' (` ("jvm member invoke static" + "java.lang.Long" "decode" + ["java.lang.String" (~ stringC)])) + (#.Primitive "java.lang.Long" (list)))) + (test "jvm member invoke virtual" + (success' (` ("jvm object cast" + ("jvm member invoke virtual" + "java.lang.Object" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke special" + (success' (` ("jvm object cast" + ("jvm member invoke special" + "java.lang.Long" "equals" + ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke interface" + (success' (` ("jvm object cast" + ("jvm member invoke interface" + "java.util.Collection" "add" + ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))]))) + (#.Primitive "java.lang.Boolean" (list)))) + (test "jvm member invoke constructor" + (success' (` ("jvm member invoke constructor" + "java.util.ArrayList" + ["int" ("jvm object cast" (~ intC))])) + (All [a] (#.Primitive "java.util.ArrayList" (list a))))) + ))) diff --git a/lux-jvm/test/test/luxc/lang/synthesis/loop.lux b/lux-jvm/test/test/luxc/lang/synthesis/loop.lux new file mode 100644 index 000000000..c6efa7dbf --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/synthesis/loop.lux @@ -0,0 +1,162 @@ +(.module: + lux + (lux [io] + (control [monad #+ do]) + (data [bit "bit/" Eq] + [number] + (coll [list "list/" Functor Fold] + (set ["set" unordered])) + text/format) + (macro [code]) + ["r" math/random "r/" Monad] + test) + (luxc (lang ["la" analysis] + ["ls" synthesis] + (synthesis [".S" expression] + [".S" loop]) + [".L" extension])) + (// common)) + +(def: (does-recursion? arity exprS) + (-> ls.Arity ls.Synthesis Bit) + (loop [exprS exprS] + (case exprS + (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))]) + (loop [pathS pathS] + (case pathS + (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))]) + (or (recur leftS) + (recur rightS)) + + (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))]) + (recur rightS) + + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) + (does-recursion? arity bodyS) + + _ + #0)) + + (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) + (n/= arity (list.size argsS)) + + (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) + (recur bodyS) + + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) + (or (recur thenS) + (recur elseS)) + + _ + #0 + ))) + +(def: (gen-body arity output) + (-> Nat la.Analysis (r.Random la.Analysis)) + (r.either (r.either (r/wrap output) + (do r.Monad + [inputA (|> r.nat (:: @ map code.nat)) + num-cases (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + tests (|> (r.set number.Hash num-cases r.nat) + (:: @ map (|>> set.to-list (list/map code.nat)))) + #let [bad-bodies (list.repeat num-cases (' []))] + good-body (gen-body arity output) + where-to-set (|> r.nat (:: @ map (n/% num-cases))) + #let [bodies (list.concat (list (list.take where-to-set bad-bodies) + (list good-body) + (list.drop (n/inc where-to-set) bad-bodies)))]] + (wrap (` ("lux case" (~ inputA) + (~ (code.record (list.zip2 tests bodies)))))))) + (r.either (do r.Monad + [valueS r.bit + output' (gen-body (n/inc arity) output)] + (wrap (` ("lux case" (~ (code.bit valueS)) + {("lux case bind" (~ (code.nat arity))) (~ output')})))) + (do r.Monad + [valueS r.bit + then|else r.bit + output' (gen-body arity output) + #let [thenA (if then|else output' (' [])) + elseA (if (not then|else) output' (' []))]] + (wrap (` ("lux case" (~ (code.bit valueS)) + {(~ (code.bit then|else)) (~ thenA) + (~ (code.bit (not then|else))) (~ elseA)}))))) + )) + +(def: (make-function arity body) + (-> ls.Arity la.Analysis la.Analysis) + (case arity + +0 body + _ (` ("lux function" [] (~ (make-function (n/dec arity) body)))))) + +(def: gen-recursion + (r.Random [Bit Nat la.Analysis]) + (do r.Monad + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bit + outputS (if recur? + (wrap (la.apply (list.repeat arity (' [])) (la.var 0))) + (do @ + [plus-or-minus? r.bit + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) (la.var 0))))) + bodyS (gen-body arity outputS)] + (wrap [recur? arity (make-function arity bodyS)]))) + +(def: gen-loop + (r.Random [Bit Nat la.Analysis]) + (do r.Monad + [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) + recur? r.bit + self-ref? r.bit + #let [selfA (la.var 0) + argA (if self-ref? selfA (' []))] + outputS (if recur? + (wrap (la.apply (list.repeat arity argA) selfA)) + (do @ + [plus-or-minus? r.bit + how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1)))) + #let [shift (if plus-or-minus? n/+ n/-)]] + (wrap (la.apply (list.repeat (shift how-much arity) (' [])) selfA)))) + bodyS (gen-body arity outputS)] + (wrap [(and recur? (not self-ref?)) + arity + (make-function arity bodyS)]))) + +(context: "Recursion." + (<| (times +100) + (do @ + [[prediction arity analysis] gen-recursion] + ($_ seq + (test "Can accurately identify (and then reify) tail recursion." + (case (expressionS.synthesize extensionL.no-syntheses + analysis) + (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat _arity)] [_ (#.Tuple _env)] _body))]) + (|> _body + (does-recursion? arity) + (bit/= prediction) + (and (n/= arity _arity))) + + _ + #0)))))) + +(context: "Loop." + (<| (times +100) + (do @ + [[prediction arity analysis] gen-recursion] + ($_ seq + (test "Can reify loops." + (case (expressionS.synthesize extensionL.no-syntheses + (la.apply (list.repeat arity (' [])) analysis)) + (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat in_register)] [_ (#.Tuple _inits)] _body))]) + (and (n/= arity (list.size _inits)) + (not (loopS.contains-self-reference? _body))) + + (^ [_ (#.Form (list& [_ (#.Text "lux call")] + [_ (#.Form (list [_ (#.Text "lux function")] _arity _env _bodyS))] + argsS))]) + (loopS.contains-self-reference? _bodyS) + + _ + #0)))))) diff --git a/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux b/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux new file mode 100644 index 000000000..ab6c9de6f --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/synthesis/procedure.lux @@ -0,0 +1,34 @@ +(.module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data [text "text/" Eq] + [product] + (coll [list])) + ["r" math/random "r/" Monad] + test) + (luxc (lang ["la" analysis] + ["ls" synthesis] + (synthesis [".S" expression]) + [".L" extension])) + (// common)) + +(context: "Procedures" + (<| (times +100) + (do @ + [num-args (|> r.nat (:: @ map (n/% +10))) + nameA (r.text +5) + argsA (r.list num-args gen-primitive)] + ($_ seq + (test "Can synthesize procedure calls." + (|> (expressionS.synthesize extensionL.no-syntheses + (la.procedure nameA argsA)) + (case> (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) + (and (text/= nameA procedure) + (list.every? (product.uncurry corresponds?) + (list.zip2 argsA argsS))) + + _ + #0))) + )))) diff --git a/lux-jvm/test/test/luxc/lang/translation/js.lux b/lux-jvm/test/test/luxc/lang/translation/js.lux new file mode 100644 index 000000000..83108c594 --- /dev/null +++ b/lux-jvm/test/test/luxc/lang/translation/js.lux @@ -0,0 +1,160 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data ["e" error] + text/format + [number] + (coll [list "list/" Functor] + [set])) + [math] + ["r" math/random] + (macro [code]) + test) + (luxc (lang [synthesis #+ Synthesis])) + (test/luxc common)) + +(def: upper-alpha-ascii + (r.Random Nat) + (|> r.nat (:: r.Functor map (|>> (n/% +91) (n/max +65))))) + +(def: (test-primitive-identity synthesis) + (-> Synthesis Bit) + (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis)))) + (case> (#e.Success valueV) + (:coerce Bit valueV) + + _ + #0))) + +(type: Check (-> (e.Error Any) Bit)) + +(template [ 
 <=>]
+  [(def: ( angle)
+     (->  Check)
+     (|>> (case> (#e.Success valueV)
+                 (<=> (
 angle) (:coerce  valueV))
+                 
+                 (#e.Error error)
+                 #0)))]
+
+  [sin-check    Frac math.sin f/=]
+  [length-check Nat  id       n/=]
+  )
+
+(context: "[JS] Primitives."
+  ($_ seq
+      (test "Null is equal to itself."
+            (test-primitive-identity (` ("js null"))))
+      (test "Undefined is equal to itself."
+            (test-primitive-identity (` ("js undefined"))))
+      (test "Object comparison is by reference, not by value."
+            (not (test-primitive-identity (` ("js object")))))
+      (test "Values are equal to themselves."
+            (test-primitive-identity (` ("js global" "Math"))))
+      (<| (times +100)
+          (do @
+            [value r.int
+             #let [frac-value (int-to-frac value)]]
+            (test "Can call primitive functions."
+                  (|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
+                      (sin-check frac-value)))))
+      ))
+
+(context: "[JS] Objects."
+  (<| (times +100)
+      (do @
+        [field (:: @ map code.text (r.text' upper-alpha-ascii +5))
+         value r.int
+         #let [empty-object (` ("js object"))
+               object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
+               frac-value (int-to-frac value)]]
+        ($_ seq
+            (test "Cannot get non-existing fields from objects."
+                  (|> (run-js (` ("js object get" (~ field) (~ empty-object))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:coerce (Maybe Int) valueV) #.None])
+                             #1
+
+                             _
+                             #0)))
+            (test "Can get fields from objects."
+                  (|> (run-js (` ("js object get" (~ field) (~ object))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:coerce (Maybe Int) valueV) (#.Some valueV)])
+                             (i/= value (:coerce Int valueV))
+
+                             _
+                             #0)))
+            (test "Can delete fields from objects."
+                  (|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
+                                (` ("js object get" (~ field) (~ post-delete)))))
+                      (case> (^multi (#e.Success valueV)
+                                     [(:coerce (Maybe Int) valueV) #.None])
+                             #1
+
+                             _
+                             #0)))
+            (test "Can instance new objects."
+                  (let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
+                    (|> (run-js (` ("lux frac +" (~ base) 0.0)))
+                        (case> (#e.Success valueV)
+                               (f/= frac-value (:coerce Frac valueV))
+
+                               (#e.Error error)
+                               #0))))
+            (test "Can call methods on objects."
+                  (|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
+                      (sin-check frac-value)))
+            ))))
+
+(context: "[JS] Arrays."
+  (<| (times +100)
+      (do @
+        [length (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% length)))
+         overwrite r.nat
+         elems (|> (r.set number.Hash length r.nat)
+                   (:: @ map set.to-list))
+         #let [arrayS (` ("js array literal" (~+ (list/map code.nat elems))))]]
+        ($_ seq
+            (test "Can get the length of an array."
+                  (|> (run-js (` ("js array length" (~ arrayS))))
+                      (length-check length)))
+            (test "Can get an element from an array."
+                  (|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
+                      (case> (^multi (#e.Success elemV)
+                                     [[(list.nth idx elems) (:coerce (Maybe Nat) elemV)]
+                                      [(#.Some reference) (#.Some sample)]])
+                             (n/= reference sample)
+
+                             _
+                             #0)))
+            (test "Can write an element into an array."
+                  (let [idxS (code.nat idx)
+                        overwriteS (code.nat overwrite)]
+                    (|> (run-js (` ("js array read" (~ idxS)
+                                    ("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
+                        (case> (^multi (#e.Success elemV)
+                                       [(:coerce (Maybe Nat) elemV)
+                                        (#.Some sample)])
+                               (n/= overwrite sample)
+
+                               _
+                               #0))))
+            (test "Can delete an element from an array."
+                  (let [idxS (code.nat idx)
+                        deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
+                    (and (|> (run-js (` ("js array length" (~ deleteS))))
+                             (length-check length))
+                         (|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
+                             (case> (^multi (#e.Success elemV)
+                                            [(:coerce (Maybe Nat) elemV)
+                                             #.None])
+                                    #1
+
+                                    _
+                                    #0))
+                         )))
+            ))))
diff --git a/lux-jvm/test/test/luxc/lang/translation/jvm.lux b/lux-jvm/test/test/luxc/lang/translation/jvm.lux
new file mode 100644
index 000000000..7c97b1e78
--- /dev/null
+++ b/lux-jvm/test/test/luxc/lang/translation/jvm.lux
@@ -0,0 +1,641 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [maybe]
+             ["e" error]
+             [bit]
+             [bit "bit/" Eq]
+             [number "int/" Number Codec]
+             [text "text/" Eq]
+             text/format
+             (coll [list]))
+       ["r" math/random "r/" Monad]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang [".L" host]
+              ["ls" synthesis]
+              (translation (jvm [".T" expression]
+                                [".T" eval]
+                                [".T" runtime]))))
+  (test/luxc common))
+
+(context: "Conversions [Part 1]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (i/% 128)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (with-expansions [<2step> (template [     ]
+                                    [(test (format  " / " )
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (~ ( ))   (`)))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success valueT)
+                                                      (  (:coerce  valueT))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["jvm convert double-to-float" "jvm convert float-to-double" code.frac frac-sample Frac f/=]
+                                    ["jvm convert double-to-int"   "jvm convert int-to-double" code.frac frac-sample Frac f/=]
+                                    ["jvm convert double-to-long"  "jvm convert long-to-double" code.frac frac-sample Frac f/=]
+
+                                    ["jvm convert long-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                                    ["jvm convert long-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
+                                    )]
+          ($_ seq
+              <2step>
+              )))))
+
+(context: "Conversions [Part 2]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (`` ($_ seq
+                (~~ (template [      ]
+                      [(test (format  " / "  " / " )
+                             (|> (do macro.Monad
+                                   [sampleI (expressionT.translate (|> (~ ( ))    (`)))]
+                                   (evalT.eval sampleI))
+                                 (lang.with-current-module "")
+                                 (macro.run (io.run init-jvm))
+                                 (case> (#e.Success valueT)
+                                        (  (:coerce  valueT))
+
+                                        (#e.Error error)
+                                        #0)))]
+
+                      ["jvm convert long-to-int"   "jvm convert int-to-char"  "jvm convert char-to-long"  code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-byte"  "jvm convert byte-to-long"  code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long"   code.int int-sample Int i/=]
+                      ["jvm convert long-to-int"   "jvm convert int-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
+                      ))
+                )))))
+
+(context: "Conversions [Part 3]"
+  (<| (times +100)
+      (do @
+        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
+         #let [frac-sample (int-to-frac int-sample)]]
+        (`` ($_ seq
+                (~~ (template [       ]
+                      [(test (format  " / "  " / " )
+                             (|> (do macro.Monad
+                                   [sampleI (expressionT.translate (|> (~ ( ))     (`)))]
+                                   (evalT.eval sampleI))
+                                 (lang.with-current-module "")
+                                 (macro.run (io.run init-jvm))
+                                 (case> (#e.Success valueT)
+                                        (  (:coerce  valueT))
+
+                                        (#e.Error error)
+                                        #0)))]
+
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
+                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
+                      ))
+                )))))
+
+(def: gen-nat
+  (r.Random Nat)
+  (|> r.nat
+      (r/map (n/% +128))
+      (r.filter (|>> (n/= +0) not))))
+
+(def: gen-int
+  (r.Random Int)
+  (|> gen-nat (r/map nat-to-int)))
+
+(def: gen-frac
+  (r.Random Frac)
+  (|> gen-int (r/map int-to-frac)))
+
+(template [      <+> <-> <*>  <%> 
 ]
+  [(context: (format "Arithmetic ["  "]")
+     (<| (times +100)
+         (do @
+           [param 
+            #let [subject ( param)]]
+           (with-expansions [ (template [ ]
+                                       [(test 
+                                              (|> (do macro.Monad
+                                                    [sampleI (expressionT.translate ( ((code.text )
+                                                                                             (
 ( subject))
+                                                                                             (
 ( param)))))]
+                                                    (evalT.eval sampleI))
+                                                  (lang.with-current-module "")
+                                                  (macro.run (io.run init-jvm))
+                                                  (case> (#e.Success valueT)
+                                                         ( ( param subject)
+                                                                 (:coerce  valueT))
+
+                                                         (#e.Error error)
+                                                         #0)))]
+
+                                       [(format "jvm "  " +") <+>]
+                                       [(format "jvm "  " -") <->]
+                                       [(format "jvm "  " *") <*>]
+                                       [(format "jvm "  " /") ]
+                                       [(format "jvm "  " %") <%>]
+                                       )]
+             ($_ seq
+                 
+                 )))))]
+
+  ["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"]
+  ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% id id]
+  ["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"]
+  ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id]
+  )
+
+(template [  ]
+  [(context: (format "Bit-wise ["  "] { Combiners ]")
+     (<| (times +100)
+         (do @
+           [param gen-nat
+            subject gen-nat]
+           (`` ($_ seq
+                   (~~ (template [ ]
+                         [(test 
+                                (|> (do macro.Monad
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (code.nat subject))
+                                                                               ( (code.nat param)))))]
+                                      (evalT.eval sampleI))
+                                    (lang.with-current-module "")
+                                    (macro.run (io.run init-jvm))
+                                    (case> (#e.Success valueT)
+                                           (n/= ( param subject)
+                                                (:coerce Nat valueT))
+
+                                           (#e.Error error)
+                                           #0)))]
+
+                         [(format "jvm "  " and") bit.and]
+                         [(format "jvm "  " or") bit.or]
+                         [(format "jvm "  " xor") bit.xor]
+                         ))
+                   )))))]
+
+  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
+  ["long" id id]
+  )
+
+(template [  ]
+  [(context: (format "Bit-wise ["  "] { Shifters }")
+     (<| (times +100)
+         (do @
+           [param gen-nat
+            subject gen-nat
+            #let [shift (n/% +10 param)]]
+           (`` ($_ seq
+                   (~~ (template [     
]
+                         [(test 
+                                (|> (do macro.Monad
+                                      [sampleI (expressionT.translate ( ((code.text )
+                                                                               ( (
 subject))
+                                                                               ("jvm convert long-to-int" (code.nat shift)))))]
+                                      (evalT.eval sampleI))
+                                    (lang.with-current-module "")
+                                    (macro.run (io.run init-jvm))
+                                    (case> (#e.Success valueT)
+                                           ( ( shift ( subject))
+                                                   (:coerce  valueT))
+
+                                           (#e.Error error)
+                                           #0)))]
+
+                         [(format "jvm "  " shl") bit.left-shift Nat n/= id code.nat]
+                         [(format "jvm "  " shr") bit.arithmetic-right-shift Int i/= nat-to-int (|>> nat-to-int code.int)]
+                         [(format "jvm "  " ushr") bit.logical-right-shift Nat n/= id code.nat]
+                         ))
+                   )))))]
+
+  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
+  ["long" id id]
+  )
+
+(template [   <=> <<> 
]
+  [(context: (format "Order ["  "]")
+     (<| (times +100)
+         (do @
+           [param 
+            subject ]
+           (with-expansions [ (template [ ]
+                                       [(test 
+                                              (|> (do macro.Monad
+                                                    [sampleI (expressionT.translate ((code.text )
+                                                                                     (
 ( subject))
+                                                                                     (
 ( param))))]
+                                                    (evalT.eval sampleI))
+                                                  (lang.with-current-module "")
+                                                  (macro.run (io.run init-jvm))
+                                                  (case> (#e.Success valueT)
+                                                         (bit/= ( param subject)
+                                                                (:coerce Bit valueT))
+
+                                                         (#e.Error error)
+                                                         #0)))]
+
+                                       [(format "jvm "  " =") <=>]
+                                       [(format "jvm "  " <") <<>]
+                                       )]
+             ($_ seq
+                 
+                 )))))]
+
+  ["int" gen-int code.int i/= i/< "jvm convert long-to-int"]
+  ["long" gen-int code.int i/= i/< id]
+  ["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"]
+  ["double" gen-frac code.frac f/= f/< id]
+  ["char" gen-int code.int i/= i/< "jvm convert long-to-char"]
+  )
+
+(def: (jvm//array//new dimension class size)
+  (-> Nat Text Nat ls.Synthesis)
+  (` ("jvm array new" (~ (code.nat dimension)) (~ (code.text class)) (~ (code.nat size)))))
+
+(def: (jvm//array//write class idx inputS arrayS)
+  (-> Text Nat ls.Synthesis ls.Synthesis ls.Synthesis)
+  (` ("jvm array write" (~ (code.text class)) (~ (code.nat idx)) (~ inputS) (~ arrayS))))
+
+(def: (jvm//array//read class idx arrayS)
+  (-> Text Nat ls.Synthesis ls.Synthesis)
+  (` ("jvm array read" (~ (code.text class)) (~ (code.nat idx)) (~ arrayS))))
+
+(context: "Array [Part 1]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% size)))
+         valueZ r.bit
+         valueB gen-int
+         valueS gen-int
+         valueI gen-int
+         valueL r.int
+         valueF gen-frac
+         valueD r.frac
+         valueC gen-int]
+        (with-expansions [ (template [     ]
+                                    [(test 
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
+                                                                                     (jvm//array//write  idx )
+                                                                                     (jvm//array//read  idx)
+                                                                                     ))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success outputZ)
+                                                      (  (:coerce  outputZ))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["boolean" Bit valueZ bit/= (code.bit valueZ)
+                                     id]
+                                    ["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`))
+                                     "jvm convert byte-to-long"]
+                                    ["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`))
+                                     "jvm convert short-to-long"]
+                                    ["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`))
+                                     "jvm convert int-to-long"]
+                                    ["long" Int valueL i/= (code.int valueL)
+                                     id]
+                                    ["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`))
+                                     "jvm convert float-to-double"]
+                                    ["double" Frac valueD f/= (code.frac valueD)
+                                     id]
+                                    )]
+          ($_ seq
+              
+              )))))
+
+(context: "Array [Part 2]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         idx (|> r.nat (:: @ map (n/% size)))
+         valueZ r.bit
+         valueB gen-int
+         valueS gen-int
+         valueI gen-int
+         valueL r.int
+         valueF gen-frac
+         valueD r.frac
+         valueC gen-int]
+        (with-expansions [ (template [     ]
+                                    [(test 
+                                           (|> (do macro.Monad
+                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
+                                                                                     (jvm//array//write  idx )
+                                                                                     (jvm//array//read  idx)
+                                                                                     ))]
+                                                 (evalT.eval sampleI))
+                                               (lang.with-current-module "")
+                                               (macro.run (io.run init-jvm))
+                                               (case> (#e.Success outputT)
+                                                      (  (:coerce  outputT))
+
+                                                      (#e.Error error)
+                                                      #0)))]
+
+                                    ["char" Int valueC i/=
+                                     (|> (code.int valueC) (~) "jvm convert long-to-int" "jvm convert int-to-char" (`))
+                                     "jvm convert char-to-long"]
+                                    ["java.lang.Long" Int valueL i/=
+                                     (code.int valueL)
+                                     id]
+                                    )]
+          ($_ seq
+              
+              (test "java.lang.Double (level 1)"
+                    (|> (do macro.Monad
+                          [#let [inner (|> ("jvm array new" +0 "java.lang.Double" (~ (code.nat size)))
+                                           ("jvm array write" "java.lang.Double" (~ (code.nat idx)) (~ (code.frac valueD)))
+                                           (`))]
+                           sampleI (expressionT.translate (|> ("jvm array new" +1 "java.lang.Double" (~ (code.nat size)))
+                                                              ("jvm array write" "#Array" (~ (code.nat idx)) (~ inner))
+                                                              ("jvm array read" "#Array" (~ (code.nat idx)))
+                                                              ("jvm array read" "java.lang.Double" (~ (code.nat idx)))
+                                                              (`)))]
+                          (evalT.eval sampleI))
+                        (lang.with-current-module "")
+                        (macro.run (io.run init-jvm))
+                        (case> (#e.Success outputT)
+                               (f/= valueD (:coerce Frac outputT))
+
+                               (#e.Error error)
+                               #0)))
+              (test "jvm array length"
+                    (|> (do macro.Monad
+                          [sampleI (expressionT.translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code.nat size))))))]
+                          (evalT.eval sampleI))
+                        (lang.with-current-module "")
+                        (macro.run (io.run init-jvm))
+                        (case> (#e.Success outputT)
+                               (n/= size (:coerce Nat outputT))
+
+                               (#e.Error error)
+                               #0)))
+              )))))
+
+(host.import: java/lang/Class
+  (getName [] String))
+
+(def: classes
+  (List Text)
+  (list "java.lang.Object" "java.lang.Class"
+        "java.lang.String" "java.lang.Number"))
+
+(def: instances
+  (List [Text (r.Random ls.Synthesis)])
+  (let [gen-boolean (|> r.bit (:: r.Functor map code.bit))
+        gen-integer (|> r.int (:: r.Functor map code.int))
+        gen-double (|> r.frac (:: r.Functor map code.frac))
+        gen-string (|> (r.text +5) (:: r.Functor map code.text))]
+    (list ["java.lang.Boolean" gen-boolean]
+          ["java.lang.Long" gen-integer]
+          ["java.lang.Double" gen-double]
+          ["java.lang.String" gen-string]
+          ["java.lang.Object" (r.either (r.either gen-boolean
+                                                  gen-integer)
+                                        (r.either gen-double
+                                                  gen-string))])))
+
+(context: "Object."
+  (<| (times +100)
+      (do @
+        [#let [num-classes (list.size classes)]
+         #let [num-instances (list.size instances)]
+         class-idx (|> r.nat (:: @ map (n/% num-classes)))
+         instance-idx (|> r.nat (:: @ map (n/% num-instances)))
+         exception-message (r.text +5)
+         #let [class (maybe.assume (list.nth class-idx classes))
+               [instance-class instance-gen] (maybe.assume (list.nth instance-idx instances))
+               exception-message$ (` ["java.lang.String" (~ (code.text exception-message))])]
+         sample r.int
+         monitor r.int
+         instance instance-gen]
+        ($_ seq
+            (test "jvm object null"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object null?" ("jvm object null"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object null?"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object null?" (~ (code.int sample)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (not (:coerce Bit outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object synchronized"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object synchronized" (~ (code.int monitor)) (~ (code.int sample)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= sample (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object throw"
+                  (|> (do macro.Monad
+                        [_ runtimeT.translate
+                         sampleI (expressionT.translate (` ("lux try" ("lux function" +1 []
+                                                                       ("jvm object throw" ("jvm member invoke constructor"
+                                                                                            "java.lang.Throwable"
+                                                                                            (~ exception-message$)))))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (case (:coerce (e.Error Any) outputT)
+                               (#e.Error error)
+                               (text.contains? exception-message error)
+
+                               (#e.Success outputT)
+                               #0)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object class"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object class" (~ (code.text class)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (|> outputT (:coerce Class) (Class::getName []) (text/= class))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm object instance?"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object instance?" (~ (code.text instance-class)) (~ instance))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            ))))
+
+(host.import: java/util/GregorianCalendar
+  (#static AD int))
+
+(context: "Member [Field]"
+  (<| (times +100)
+      (do @
+        [sample-short (|> r.int (:: @ map (|>> int/abs (i/% 100))))
+         sample-string (r.text +5)
+         other-sample-string (r.text +5)
+         #let [shortS (` ["short" ("jvm object cast" "java.lang.Short" "short"
+                                   ("jvm convert long-to-short" (~ (code.int sample-short))))])
+               stringS (` ["java.lang.String" (~ (code.text sample-string))])
+               type-codeS (` ["org.omg.CORBA.TypeCode" ("jvm object null")])
+               idl-typeS (` ["org.omg.CORBA.IDLType" ("jvm object null")])
+               value-memberS (` ("jvm member invoke constructor"
+                                 "org.omg.CORBA.ValueMember"
+                                 (~ stringS) (~ stringS) (~ stringS) (~ stringS)
+                                 (~ type-codeS) (~ idl-typeS) (~ shortS)))]]
+        ($_ seq
+            (test "jvm member static get"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= GregorianCalendar::AD (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member static put"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"
+                                                            ("jvm member static get" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (is? hostL.unit (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member virtual get"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (text/= sample-string (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member virtual put"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
+                                                            ("jvm member virtual put" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
+                                                             (~ (code.text other-sample-string)) (~ value-memberS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (text/= other-sample-string (:coerce Text outputT))
+
+                             (#e.Error error)
+                             #0)))
+            ))))
+
+(host.import: java/lang/Object)
+
+(host.import: (java/util/ArrayList a))
+
+(context: "Member [Method]"
+  (<| (times +100)
+      (do @
+        [sample (|> r.int (:: @ map (|>> int/abs (i/% 100))))
+         #let [object-longS (` ["java.lang.Object" (~ (code.int sample))])
+               intS (` ["int" ("jvm object cast" "java.lang.Integer" "int"
+                               ("jvm convert long-to-int" (~ (code.int sample))))])
+               coded-intS (` ["java.lang.String" (~ (code.text (int/encode sample)))])
+               array-listS (` ("jvm member invoke constructor" "java.util.ArrayList" (~ intS)))]]
+        ($_ seq
+            (test "jvm member invoke static"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long"
+                                                            "decode" "java.lang.Long"
+                                                            (~ coded-intS))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (i/= sample (:coerce Int outputT))
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke virtual"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
+                                                            ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean"
+                                                             (~ (code.int sample)) (~ object-longS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke interface"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
+                                                            ("jvm member invoke interface" "java.util.Collection" "add" "boolean"
+                                                             (~ array-listS) (~ object-longS)))))]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (:coerce Bit outputT)
+
+                             (#e.Error error)
+                             #0)))
+            (test "jvm member invoke constructor"
+                  (|> (do macro.Monad
+                        [sampleI (expressionT.translate array-listS)]
+                        (evalT.eval sampleI))
+                      (lang.with-current-module "")
+                      (macro.run (io.run init-jvm))
+                      (case> (#e.Success outputT)
+                             (host.instance? ArrayList (:coerce Object outputT))
+
+                             (#e.Error error)
+                             #0)))
+            ))))
diff --git a/lux-r/project.clj b/lux-r/project.clj
new file mode 100644
index 000000000..138d826fe
--- /dev/null
+++ b/lux-r/project.clj
@@ -0,0 +1,34 @@
+(def version "0.6.0-SNAPSHOT")
+(def repo "https://github.com/LuxLang/lux")
+(def sonatype "https://oss.sonatype.org")
+(def sonatype-releases (str sonatype "/service/local/staging/deploy/maven2/"))
+(def sonatype-snapshots (str sonatype "/content/repositories/snapshots/"))
+
+(defproject com.github.luxlang/lux-r #=(identity version)
+  :description "An R compiler for Lux."
+  :url ~repo
+  :license {:name "Lux License v0.1"
+            :url ~(str repo "/blob/master/license.txt")}
+  :plugins [[com.github.luxlang/lein-luxc ~version]]
+  :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}]
+                        ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]]
+  :pom-addition [:developers [:developer
+                              [:name "Eduardo Julian"]
+                              [:url "https://github.com/eduardoejp"]]]
+  :repositories [["releases" ~sonatype-releases]
+                 ["snapshots" ~sonatype-snapshots]
+                 ["bedatadriven" "https://nexus.bedatadriven.com/content/groups/public/"]
+                 ["jitpack" "https://jitpack.io"]]
+  :scm {:name "git"
+        :url ~(str repo ".git")}
+
+  :dependencies [[com.github.luxlang/luxc-jvm ~version]
+                 [com.github.luxlang/stdlib ~version]
+                 ;; JVM Bytecode
+                 [org.ow2.asm/asm-all "5.0.3"]]
+  
+  :manifest {"lux" ~version}
+  :source-paths ["source"]
+  :lux {:program "program"
+        :test "test/program"}
+  )
diff --git a/lux-r/source/luxc/lang/host/r.lux b/lux-r/source/luxc/lang/host/r.lux
new file mode 100644
index 000000000..6e4c7fb5b
--- /dev/null
+++ b/lux-r/source/luxc/lang/host/r.lux
@@ -0,0 +1,299 @@
+(.module:
+  [lux #- not or and list if function cond when]
+  (lux (control pipe)
+       (data [maybe "maybe/" Functor]
+             [text]
+             text/format
+             [number]
+             (coll [list "list/" Functor Fold]))
+       (type abstract)))
+
+(abstract: #export Single {} Any)
+(abstract: #export Poly {} Any)
+
+(abstract: #export (Var kind)
+  {}
+
+  Text
+
+  (def: name (All [k] (-> (Var k) Text)) (|>> :representation))
+
+  (def: #export var (-> Text (Var Single)) (|>> :abstraction))
+  (def: #export var-args (Var Poly) (:abstraction "..."))
+  )
+
+(type: #export SVar (Var Single))
+(type: #export PVar (Var Poly))
+
+(abstract: #export Expression
+  {}
+  
+  Text
+
+  (def: #export expression (-> Expression Text) (|>> :representation))
+
+  (def: #export code (-> Text Expression) (|>> :abstraction))
+
+  (def: (self-contained code)
+    (-> Text Expression)
+    (:abstraction
+     (format "(" code ")")))
+
+  (def: nest
+    (-> Text Text)
+    (|>> (format "\n")
+         (text.replace-all "\n" "\n  ")))
+
+  (def: (_block expression)
+    (-> Text Text)
+    (format "{" (nest expression) "\n" "}"))
+
+  (def: #export (block expression)
+    (-> Expression Expression)
+    (:abstraction
+     (format "{" (:representation expression) "}")))
+
+  (def: #export null
+    Expression
+    (|> "NULL" self-contained))
+
+  (def: #export n/a
+    Expression
+    (|> "NA" self-contained))
+
+  (def: #export not-available Expression n/a)
+  (def: #export not-applicable Expression n/a)
+  (def: #export no-answer Expression n/a)
+
+  (def: #export bool
+    (-> Bit Expression)
+    (|>> (case> #0 "FALSE"
+                #1 "TRUE")
+         self-contained))
+
+  (def: #export (int value)
+    (-> Int Expression)
+    (self-contained
+     (format "as.integer(" (%i value) ")")))
+
+  (def: #export float
+    (-> Frac Expression)
+    (|>> (cond> [(f/= number.positive-infinity)]
+                [(new> "1.0/0.0")]
+                
+                [(f/= number.negative-infinity)]
+                [(new> "-1.0/0.0")]
+                
+                [(f/= number.not-a-number)]
+                [(new> "0.0/0.0")]
+                
+                ## else
+                [%f])
+         self-contained))
+
+  (def: #export string
+    (-> Text Expression)
+    (|>> %t self-contained))
+
+  (def: (composite-literal left-delimiter right-delimiter entry-serializer)
+    (All [a] (-> Text Text (-> a Text)
+                 (-> (List a) Expression)))
+    (.function (_ entries)
+      (self-contained
+       (format left-delimiter
+               (|> entries (list/map entry-serializer) (text.join-with ","))
+               right-delimiter))))
+
+  (def: #export named-list
+    (-> (List [Text Expression]) Expression)
+    (composite-literal "list(" ")" (.function (_ [key value])
+                                     (format key "=" (:representation value)))))
+  
+  (template [ ]
+    [(def: #export 
+       (-> (List Expression) Expression)
+       (composite-literal (format  "(") ")" expression))]
+
+    [vector "c"]
+    [list   "list"]
+    )
+  
+  (def: #export (slice from to list)
+    (-> Expression Expression Expression Expression)
+    (self-contained
+     (format (:representation list)
+             "[" (:representation from) ":" (:representation to) "]")))
+
+  (def: #export (slice-from from list)
+    (-> Expression Expression Expression)
+    (self-contained
+     (format (:representation list)
+             "[-1"  ":-" (:representation from) "]")))
+
+  (def: #export (apply args func)
+    (-> (List Expression) Expression Expression)
+    (self-contained
+     (format (:representation func) "(" (text.join-with "," (list/map expression args)) ")")))
+
+  (def: #export (apply-kw args kw-args func)
+    (-> (List Expression) (List [Text Expression]) Expression Expression)
+    (self-contained
+     (format (:representation func)
+             (format "("
+                     (text.join-with "," (list/map expression args)) ","
+                     (text.join-with "," (list/map (.function (_ [key val])
+                                                     (format key "=" (expression val)))
+                                                   kw-args))
+                     ")"))))
+
+  (def: #export (nth idx list)
+    (-> Expression Expression Expression)
+    (self-contained
+     (format (:representation list) "[[" (:representation idx) "]]")))
+
+  (def: #export (if test then else)
+    (-> Expression Expression Expression Expression)
+    (self-contained
+     (format "if(" (:representation test) ")"
+             " " (.._block (:representation then))
+             " else " (.._block (:representation else)))))
+
+  (def: #export (when test then)
+    (-> Expression Expression Expression)
+    (self-contained
+     (format "if(" (:representation test) ") {"
+             (.._block (:representation then))
+             "\n" "}")))
+
+  (def: #export (cond clauses else)
+    (-> (List [Expression Expression]) Expression Expression)
+    (list/fold (.function (_ [test then] next)
+                 (if test then next))
+               else
+               (list.reverse clauses)))
+
+  (template [ ]
+    [(def: #export ( param subject)
+       (-> Expression Expression Expression)
+       (self-contained
+        (format (:representation subject)
+                " "  " "
+                (:representation param))))]
+
+    [=       "=="]
+    [<       "<"]
+    [<=      "<="]
+    [>       ">"]
+    [>=      ">="]
+    [+       "+"]
+    [-       "-"]
+    [*       "*"]
+    [/       "/"]
+    [%%      "%%"]
+    [**      "**"]
+    [or      "||"]
+    [and     "&&"]
+    )
+
+  (def: #export @@
+    (All [k] (-> (Var k) Expression))
+    (|>> ..name self-contained))
+
+  (def: #export global
+    (-> Text Expression)
+    (|>> var @@))
+
+  (template [ ]
+    [(def: #export ( param subject)
+       (-> Expression Expression Expression)
+       (..apply (.list subject param) (..global )))]
+
+    [bit-or   "bitwOr"]
+    [bit-and  "bitwAnd"]
+    [bit-xor  "bitwXor"]
+    [bit-shl  "bitwShiftL"]
+    [bit-ushr "bitwShiftR"]
+    )
+
+  (def: #export (bit-not subject)
+    (-> Expression Expression)
+    (..apply (.list subject) (..global "bitwNot")))
+
+  (template [ ]
+    [(def: #export 
+       (-> Expression Expression)
+       (|>> :representation (format ) self-contained))]
+
+    [not    "!"]
+    [negate "-"]
+    )
+  
+  (def: #export (length list)
+    (-> Expression Expression)
+    (..apply (.list list) (..global "length")))
+
+  (def: #export (range from to)
+    (-> Expression Expression Expression)
+    (self-contained
+     (format (:representation from) ":" (:representation to))))
+
+  (def: #export (function inputs body)
+    (-> (List (Ex [k] (Var k))) Expression Expression)
+    (let [args (|> inputs (list/map ..name) (text.join-with ", "))]
+      (self-contained
+       (format "function(" args ") "
+               (.._block (:representation body))))))
+
+  (def: #export (try body warning error finally)
+    (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression)
+    (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text)
+                      (.function (_ parameter value preparation)
+                        (|> value
+                            (maybe/map (|>> :representation preparation (format ", " parameter " = ")))
+                            (maybe.default ""))))]
+      (self-contained
+       (format "tryCatch("
+               (.._block (:representation body))
+               (optional "warning" warning id)
+               (optional "error" error id)
+               (optional "finally" finally .._block)
+               ")"))))
+
+  (def: #export (while test body)
+    (-> Expression Expression Expression)
+    (self-contained
+     (format "while (" (:representation test) ") "
+             (.._block (:representation body)))))
+
+  (def: #export (for-in var inputs body)
+    (-> SVar Expression Expression Expression)
+    (self-contained
+     (format "for (" (..name var) " in " (..expression inputs) ")"
+             (.._block (:representation body)))))
+
+  (template [ ]
+    [(def: #export ( message)
+       (-> Expression Expression)
+       (..apply (.list message) (..global )))]
+
+    [stop  "stop"]
+    [print "print"]
+    )
+
+  (def: #export (set! var value)
+    (-> (Var Single) Expression Expression)
+    (self-contained
+     (format (..name var) " <- " (:representation value))))
+
+  (def: #export (set-nth! idx value list)
+    (-> Expression Expression SVar Expression)
+    (self-contained
+     (format (..name list) "[[" (:representation idx) "]] <- " (:representation value))))
+
+  (def: #export (then pre post)
+    (-> Expression Expression Expression)
+    (:abstraction
+     (format (:representation pre)
+             "\n"
+             (:representation post))))
+  )
diff --git a/lux-r/source/luxc/lang/synthesis/variable.lux b/lux-r/source/luxc/lang/synthesis/variable.lux
new file mode 100644
index 000000000..f6a45b02e
--- /dev/null
+++ b/lux-r/source/luxc/lang/synthesis/variable.lux
@@ -0,0 +1,98 @@
+(.module:
+  lux
+  (lux (data [number]
+             (coll [list "list/" Fold Monoid]
+                   ["s" set])))
+  (luxc (lang ["la" analysis]
+              ["ls" synthesis]
+              [".L" variable #+ Variable])))
+
+(def: (bound-vars path)
+  (-> ls.Path (List Variable))
+  (case path
+    (#ls.BindP register)
+    (list (.int register))
+
+    (^or (#ls.SeqP pre post) (#ls.AltP pre post))
+    (list/compose (bound-vars pre) (bound-vars post))
+    
+    _
+    (list)))
+
+(def: (path-bodies path)
+  (-> ls.Path (List ls.Synthesis))
+  (case path
+    (#ls.ExecP body)
+    (list body)
+
+    (#ls.SeqP pre post)
+    (path-bodies post)
+
+    (#ls.AltP pre post)
+    (list/compose (path-bodies pre) (path-bodies post))
+    
+    _
+    (list)))
+
+(def: (non-arg? arity var)
+  (-> ls.Arity Variable Bit)
+  (and (variableL.local? var)
+       (n/> arity (.nat var))))
+
+(type: Tracker (s.Set Variable))
+
+(def: init-tracker Tracker (s.new number.Hash))
+
+(def: (unused-vars current-arity bound exprS)
+  (-> ls.Arity (List Variable) ls.Synthesis (List Variable))
+  (let [tracker (loop [exprS exprS
+                       tracker (list/fold s.add init-tracker bound)]
+                  (case exprS
+                    (#ls.Variable var)
+                    (if (non-arg? current-arity var)
+                      (s.remove var tracker)
+                      tracker)
+                    
+                    (#ls.Variant tag last? memberS)
+                    (recur memberS tracker)
+
+                    (#ls.Tuple membersS)
+                    (list/fold recur tracker membersS)
+
+                    (#ls.Call funcS argsS)
+                    (list/fold recur (recur funcS tracker) argsS)
+                    
+                    (^or (#ls.Recur argsS)
+                         (#ls.Procedure name argsS))
+                    (list/fold recur tracker argsS)
+
+                    (#ls.Let offset inputS outputS)
+                    (|> tracker (recur inputS) (recur outputS))
+
+                    (#ls.If testS thenS elseS)
+                    (|> tracker (recur testS) (recur thenS) (recur elseS))
+
+                    (#ls.Loop offset initsS bodyS)
+                    (recur bodyS (list/fold recur tracker initsS))
+
+                    (#ls.Case inputS outputPS)
+                    (let [tracker' (list/fold s.add
+                                              (recur inputS tracker)
+                                              (bound-vars outputPS))]
+                      (list/fold recur tracker' (path-bodies outputPS)))
+
+                    (#ls.Function arity env bodyS)
+                    (list/fold s.remove tracker env)
+
+                    _
+                    tracker
+                    ))]
+    (s.to-list tracker)))
+
+## (def: (optimize-register-use current-arity [pathS bodyS])
+##   (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis])
+##   (let [bound (bound-vars pathS)
+##         unused (unused-vars current-arity bound bodyS)
+##         adjusted (adjust-vars unused bound)]
+##     [(|> pathS (clean-pattern adjusted) simplify-pattern)
+##      (clean-expression adjusted bodyS)]))
diff --git a/lux-r/source/luxc/lang/translation/r.lux b/lux-r/source/luxc/lang/translation/r.lux
new file mode 100644
index 000000000..a4a3db1f5
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r.lux
@@ -0,0 +1,216 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                pipe
+                [monad #+ do])
+       (data [bit]
+             [maybe]
+             ["e" error #+ Error]
+             [text "text/" Eq]
+             text/format
+             (coll [array]))
+       [macro]
+       [io #+ IO Process io]
+       [host #+ class: interface: object]
+       (world [file #+ File]))
+  (luxc [lang]
+        (lang [".L" variable #+ Register]
+              (host [r #+ Expression]))
+        [".C" io]))
+
+(template []
+  [(exception: #export ( {message Text})
+     message)]
+
+  [No-Active-Module-Buffer]
+  [Cannot-Execute]
+
+  [No-Anchor]
+  )
+
+(host.import: java/lang/Object)
+
+(host.import: java/lang/String
+  (getBytes [String] #try [byte]))
+
+(host.import: java/lang/CharSequence)
+
+(host.import: java/lang/Appendable
+  (append [CharSequence] Appendable))
+
+(host.import: java/lang/StringBuilder
+  (new [])
+  (toString [] String))
+
+(host.import: javax/script/ScriptEngine
+  (eval [String] #try #? Object))
+
+(host.import: javax/script/ScriptEngineFactory
+  (getScriptEngine [] ScriptEngine))
+
+(type: #export Anchor [Text Register])
+
+(type: #export Host
+  {#context [Text Nat]
+   #anchor (Maybe Anchor)
+   #loader (-> Expression (Error Any))
+   #interpreter (-> Expression (Error Object))
+   #module-buffer (Maybe StringBuilder)
+   #program-buffer StringBuilder})
+
+(def: #export init
+  (IO Host)
+  (io (let [interpreter (|> (undefined)
+                            (ScriptEngineFactory::getScriptEngine []))]
+        {#context ["" +0]
+         #anchor #.None
+         #loader (function (_ code)
+                   (do e.Monad
+                     [_ (ScriptEngine::eval [(r.expression code)] interpreter)]
+                     (wrap [])))
+         #interpreter (function (_ code)
+                        (do e.Monad
+                          [output (ScriptEngine::eval [(r.expression code)] interpreter)]
+                          (wrap (maybe.default (:coerce Object [])
+                                               output))))
+         #module-buffer #.None
+         #program-buffer (StringBuilder::new [])})))
+
+(def: #export r-module-name Text "module.r")
+
+(def: #export init-module-buffer
+  (Meta Any)
+  (function (_ compiler)
+    (#e.Success [(update@ #.host
+                          (|>> (:coerce Host)
+                               (set@ #module-buffer (#.Some (StringBuilder::new [])))
+                               (:coerce Nothing))
+                          compiler)
+                 []])))
+
+(def: #export (with-sub-context expr)
+  (All [a] (-> (Meta a) (Meta [Text a])))
+  (function (_ compiler)
+    (let [old (:coerce Host (get@ #.host compiler))
+          [old-name old-sub] (get@ #context old)
+          new-name (format old-name "f___" (%i (.int old-sub)))]
+      (case (expr (set@ #.host
+                        (:coerce Nothing (set@ #context [new-name +0] old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:coerce Host)
+                                   (set@ #context [old-name (inc old-sub)])
+                                   (:coerce Nothing))
+                              compiler')
+                     [new-name output]])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export context
+  (Meta Text)
+  (function (_ compiler)
+    (#e.Success [compiler
+                 (|> (get@ #.host compiler)
+                     (:coerce Host)
+                     (get@ #context)
+                     (let> [name sub]
+                           name))])))
+
+(def: #export (with-anchor anchor expr)
+  (All [a] (-> Anchor (Meta a) (Meta a)))
+  (function (_ compiler)
+    (let [old (:coerce Host (get@ #.host compiler))]
+      (case (expr (set@ #.host
+                        (:coerce Nothing (set@ #anchor (#.Some anchor) old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:coerce Host)
+                                   (set@ #anchor (get@ #anchor old))
+                                   (:coerce Nothing))
+                              compiler')
+                     output])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export anchor
+  (Meta Anchor)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor))
+      (#.Some anchor)
+      (#e.Success [compiler anchor])
+
+      #.None
+      ((lang.throw No-Anchor "") compiler))))
+
+(def: #export module-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer))
+      #.None
+      ((lang.throw No-Active-Module-Buffer "") compiler)
+      
+      (#.Some module-buffer)
+      (#e.Success [compiler module-buffer]))))
+
+(def: #export program-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))])))
+
+(template [  ]
+  [(def: ( code)
+     (-> Expression (Meta ))
+     (function (_ compiler)
+       (let [runner (|> compiler (get@ #.host) (:coerce Host) (get@ ))]
+         (case (runner code)
+           (#e.Error error)
+           ((lang.throw Cannot-Execute error) compiler)
+           
+           (#e.Success output)
+           (#e.Success [compiler output])))))]
+
+  [load!     #loader      Any]
+  [interpret #interpreter Object]
+  )
+
+(def: #export variant-tag-field "luxVT")
+(def: #export variant-flag-field "luxVF")
+(def: #export variant-value-field "luxVV")
+
+(def: #export int-high-field "luxIH")
+(def: #export int-low-field "luxIL")
+
+(def: #export unit Text "")
+
+(def: #export (definition-name [module name])
+  (-> Name Text)
+  (lang.normalize-name (format module "$" name)))
+
+(def: #export (save code)
+  (-> Expression (Meta Any))
+  (do macro.Monad
+    [module-buffer module-buffer
+     #let [_ (Appendable::append [(:coerce CharSequence (r.expression code))]
+                                 module-buffer)]]
+    (load! code)))
+
+(def: #export run interpret)
+
+(def: #export (save-module! target)
+  (-> File (Meta (Process Any)))
+  (do macro.Monad
+    [module macro.current-module-name
+     module-buffer module-buffer
+     program-buffer program-buffer
+     #let [module-code (StringBuilder::toString [] module-buffer)
+           _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))]
+                                 program-buffer)]]
+    (wrap (ioC.write target
+                     (format (lang.normalize-name module) "/" r-module-name)
+                     (|> module-code
+                         (String::getBytes ["UTF-8"])
+                         e.assume)))))
diff --git a/lux-r/source/luxc/lang/translation/r/case.jvm.lux b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
new file mode 100644
index 000000000..42460b620
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
@@ -0,0 +1,195 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [number]
+             [text]
+             text/format
+             (coll [list "list/" Functor Fold]
+                   (set ["set" unordered #+ Set])))
+       [macro #+ "meta/" Monad]
+       (macro [code]))
+  (luxc [lang]
+        (lang [".L" variable #+ Register Variable]
+              ["ls" synthesis #+ Synthesis Path]
+              (host [r #+ Expression SVar @@])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" reference]))
+
+(def: #export (translate-let translate register valueS bodyS)
+  (-> (-> Synthesis (Meta Expression)) Register Synthesis Synthesis
+      (Meta Expression))
+  (do macro.Monad
+    [valueO (translate valueS)
+     bodyO (translate bodyS)
+     #let [$register (referenceT.variable register)]]
+    (wrap (r.block
+           ($_ r.then
+               (r.set! $register valueO)
+               bodyO)))))
+
+(def: #export (translate-record-get translate valueS pathP)
+  (-> (-> Synthesis (Meta Expression)) Synthesis (List [Nat Bit])
+      (Meta Expression))
+  (do macro.Monad
+    [valueO (translate valueS)]
+    (wrap (list/fold (function (_ [idx tail?] source)
+                       (let [method (if tail?
+                                      runtimeT.product//right
+                                      runtimeT.product//left)]
+                         (method source (r.int (:coerce Int idx)))))
+                     valueO
+                     pathP))))
+
+(def: #export (translate-if testO thenO elseO)
+  (-> Expression Expression Expression Expression)
+  (r.if testO thenO elseO))
+
+(def: $savepoint (r.var "lux_pm_cursor_savepoint"))
+(def: $cursor (r.var "lux_pm_cursor"))
+
+(def: top r.length)
+(def: next (|>> r.length (r.+ (r.int 1))))
+(def: (push! value var)
+  (-> Expression SVar Expression)
+  (r.set-nth! (next (@@ var)) value var))
+(def: (pop! var)
+  (-> SVar Expression)
+  (r.set-nth! (top (@@ var)) r.null var))
+
+(def: (push-cursor! value)
+  (-> Expression Expression)
+  (push! value $cursor))
+
+(def: save-cursor!
+  Expression
+  (push! (r.slice (r.float 1.0) (r.length (@@ $cursor)) (@@ $cursor))
+         $savepoint))
+
+(def: restore-cursor!
+  Expression
+  (r.set! $cursor (r.nth (top (@@ $savepoint)) (@@ $savepoint))))
+
+(def: cursor-top
+  Expression
+  (|> (@@ $cursor) (r.nth (top (@@ $cursor)))))
+
+(def: pop-cursor!
+  Expression
+  (pop! $cursor))
+
+(def: pm-error (r.string "PM-ERROR"))
+
+(def: fail-pm! (r.stop pm-error))
+
+(def: $temp (r.var "lux_pm_temp"))
+
+(exception: #export (Unrecognized-Path {message Text})
+  message)
+
+(def: $alt_error (r.var "alt_error"))
+
+(def: (pm-catch handler)
+  (-> Expression Expression)
+  (r.function (list $alt_error)
+    (r.if (|> (@@ $alt_error) (r.= pm-error))
+      handler
+      (r.stop (@@ $alt_error)))))
+
+(def: (translate-pattern-matching' translate pathP)
+  (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
+  (case pathP
+    (^code ("lux case exec" (~ bodyS)))
+    (do macro.Monad
+      [bodyO (translate bodyS)]
+      (wrap bodyO))
+
+    (^code ("lux case pop"))
+    (meta/wrap pop-cursor!)
+
+    (^code ("lux case bind" (~ [_ (#.Nat register)])))
+    (meta/wrap (r.set! (referenceT.variable register) cursor-top))
+
+    (^template [ ]
+      [_ ( value)]
+      (meta/wrap (r.when (r.not (r.= (|> value ) cursor-top))
+                         fail-pm!)))
+    ([#.Bit  r.bool]
+     [#.Frac r.float]
+     [#.Text r.string])
+
+    (^template [ ]
+      [_ ( value)]
+      (meta/wrap (r.when (r.not (runtimeT.int//= (|> value ) cursor-top))
+                         fail-pm!)))
+    ([#.Nat  (<| runtimeT.int (:coerce Int))]
+     [#.Int  runtimeT.int]
+     [#.Rev  (<| runtimeT.int (:coerce Int))])
+
+    (^template [ ]
+      (^code ( (~ [_ (#.Nat idx)])))
+      (meta/wrap (push-cursor! ( cursor-top (r.int (:coerce Int idx))))))
+    (["lux case tuple left" runtimeT.product//left]
+     ["lux case tuple right" runtimeT.product//right])
+
+    (^template [ ]
+      (^code ( (~ [_ (#.Nat idx)])))
+      (meta/wrap ($_ r.then
+                     (r.set! $temp (runtimeT.sum//get cursor-top (r.int (:coerce Int idx)) ))
+                     (r.if (r.= r.null (@@ $temp))
+                       fail-pm!
+                       (push-cursor! (@@ $temp))))))
+    (["lux case variant left" r.null]
+     ["lux case variant right" (r.string "")])
+
+    (^code ("lux case seq" (~ leftP) (~ rightP)))
+    (do macro.Monad
+      [leftO (translate-pattern-matching' translate leftP)
+       rightO (translate-pattern-matching' translate rightP)]
+      (wrap ($_ r.then
+                leftO
+                rightO)))
+
+    (^code ("lux case alt" (~ leftP) (~ rightP)))
+    (do macro.Monad
+      [leftO (translate-pattern-matching' translate leftP)
+       rightO (translate-pattern-matching' translate rightP)]
+      (wrap (r.try ($_ r.then
+                       save-cursor!
+                       leftO)
+                   #.None
+                   (#.Some (pm-catch ($_ r.then
+                                         restore-cursor!
+                                         rightO)))
+                   #.None)))
+
+    _
+    (lang.throw Unrecognized-Path (%code pathP))
+    ))
+
+(def: (translate-pattern-matching translate pathP)
+  (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
+  (do macro.Monad
+    [pattern-matching! (translate-pattern-matching' translate pathP)]
+    (wrap (r.try pattern-matching!
+                 #.None
+                 (#.Some (pm-catch (r.stop (r.string "Invalid expression for pattern-matching."))))
+                 #.None))))
+
+(def: (initialize-pattern-matching! stack-init)
+  (-> Expression Expression)
+  ($_ r.then
+      (r.set! $cursor (r.list (list stack-init)))
+      (r.set! $savepoint (r.list (list)))))
+
+(def: #export (translate-case translate valueS pathP)
+  (-> (-> Synthesis (Meta Expression)) Synthesis Path (Meta Expression))
+  (do macro.Monad
+    [valueO (translate valueS)
+     pattern-matching! (translate-pattern-matching translate pathP)]
+    (wrap (r.block
+           ($_ r.then
+               (initialize-pattern-matching! valueO)
+               pattern-matching!)))))
diff --git a/lux-r/source/luxc/lang/translation/r/expression.jvm.lux b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
new file mode 100644
index 000000000..3c41fbe63
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
@@ -0,0 +1,88 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             text/format)
+       [macro]
+       (macro ["s" syntax]))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              [".L" extension]
+              ["ls" synthesis]
+              (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" structure]
+      [".T" reference]
+      [".T" function]
+      [".T" case]
+      [".T" procedure])
+  )
+
+(template []
+  [(exception: #export ( {message Text})
+     message)]
+
+  [Invalid-Function-Syntax]
+  [Unrecognized-Synthesis]
+  )
+
+(def: #export (translate synthesis)
+  (-> ls.Synthesis (Meta Expression))
+  (case synthesis
+    (^code [])
+    (:: macro.Monad wrap runtimeT.unit)
+
+    (^template [ ]
+      [_ ( value)]
+      ( value))
+    ([#.Bit primitiveT.translate-bit]
+     [#.Nat  primitiveT.translate-nat]
+     [#.Int  primitiveT.translate-int]
+     [#.Rev  primitiveT.translate-rev]
+     [#.Frac primitiveT.translate-frac]
+     [#.Text primitiveT.translate-text])
+
+    (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS)))
+    (structureT.translate-variant translate tag last? valueS)
+
+    (^code [(~ singleton)])
+    (translate singleton)
+
+    (^code [(~+ members)])
+    (structureT.translate-tuple translate members)
+
+    (^ [_ (#.Form (list [_ (#.Int var)]))])
+    (referenceT.translate-variable var)
+
+    [_ (#.Identifier definition)]
+    (referenceT.translate-definition definition)
+
+    (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
+    (caseT.translate-let translate register inputS exprS)
+
+    (^code ("lux case" (~ inputS) (~ pathPS)))
+    (caseT.translate-case translate inputS pathPS)
+
+    (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+    (case (s.run environment (p.some s.int))
+      (#e.Success environment)
+      (functionT.translate-function translate environment arity bodyS)
+
+      _
+      (&.throw Invalid-Function-Syntax (%code synthesis)))
+
+    (^code ("lux call" (~ functionS) (~+ argsS)))
+    (functionT.translate-apply translate functionS argsS)
+
+    (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
+    (procedureT.translate-procedure translate procedure argsS)
+    ## (do macro.Monad
+    ##   [translation (extensionL.find-translation procedure)]
+    ##   (translation argsS))
+
+    _
+    (&.throw Unrecognized-Synthesis (%code synthesis))))
diff --git a/lux-r/source/luxc/lang/translation/r/function.jvm.lux b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
new file mode 100644
index 000000000..f39a5e1a2
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
@@ -0,0 +1,94 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                pipe)
+       (data [product]
+             [text]
+             text/format
+             (coll [list "list/" Functor Fold]))
+       [macro])
+  (luxc ["&" lang]
+        (lang ["ls" synthesis]
+              [".L" variable #+ Variable]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-apply translate functionS argsS+)
+  (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression))
+  (do {@ macro.Monad}
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (r.apply argsO+ functionO))))
+
+(def: $curried (r.var "curried"))
+
+(def: (input-declaration register)
+  (r.set! (referenceT.variable (inc register))
+          (|> (@@ $curried) (r.nth (|> register inc .int r.int)))))
+
+(def: (with-closure function-name inits function-definition)
+  (-> Text (List Expression) Expression (Meta Expression))
+  (let [$closure (r.var (format function-name "___CLOSURE"))]
+    (case inits
+      #.Nil
+      (do macro.Monad
+        [_ (//.save function-definition)]
+        (wrap (r.global function-name)))
+
+      _
+      (do macro.Monad
+        [_ (//.save (r.set! $closure
+                            (r.function (|> (list.enumerate inits)
+                                            (list/map (|>> product.left referenceT.closure)))
+                              ($_ r.then
+                                  function-definition
+                                  (r.global function-name)))))]
+        (wrap (r.apply inits (@@ $closure)))))))
+
+(def: #export (translate-function translate env arity bodyS)
+  (-> (-> ls.Synthesis (Meta Expression))
+      (List Variable) ls.Arity ls.Synthesis
+      (Meta Expression))
+  (do {@ macro.Monad}
+    [[function-name bodyO] (//.with-sub-context
+                             (do @
+                               [function-name //.context]
+                               (//.with-anchor [function-name +1]
+                                 (translate bodyS))))
+     closureO+ (monad.map @ referenceT.translate-variable env)
+     #let [arityO (|> arity .int r.int)
+           $num_args (r.var "num_args")
+           $function (r.var function-name)
+           var-args (r.code (format "list" (r.expression (@@ r.var-args))))
+           apply-poly (function (_ args func)
+                        (r.apply (list func args) (r.global "do.call")))]]
+    (with-closure function-name closureO+
+      (r.set! $function
+              (r.function (list r.var-args)
+                ($_ r.then
+                    (r.set! $curried var-args)
+                    (r.set! $num_args (r.length (@@ $curried)))
+                    (r.cond (list [(|> (@@ $num_args) (r.= arityO))
+                                   ($_ r.then
+                                       (r.set! (referenceT.variable +0) (@@ $function))
+                                       (|> (list.n/range +0 (dec arity))
+                                           (list/map input-declaration)
+                                           (list/fold r.then bodyO)))]
+                                  [(|> (@@ $num_args) (r.> arityO))
+                                   (let [arity-args (r.slice (r.int 1) arityO (@@ $curried))
+                                         output-func-args (r.slice (|> arityO (r.+ (r.int 1)))
+                                                                   (@@ $num_args)
+                                                                   (@@ $curried))]
+                                     (|> (@@ $function)
+                                         (apply-poly arity-args)
+                                         (apply-poly output-func-args)))])
+                            ## (|> (@@ $num_args) (r.< arityO))
+                            (let [$missing (r.var "missing")]
+                              (r.function (list r.var-args)
+                                ($_ r.then
+                                    (r.set! $missing var-args)
+                                    (|> (@@ $function)
+                                        (apply-poly (r.apply (list (@@ $curried) (@@ $missing))
+                                                             (r.global "append"))))))))))))
+    ))
diff --git a/lux-r/source/luxc/lang/translation/r/loop.jvm.lux b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
new file mode 100644
index 000000000..f1197e5ce
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
@@ -0,0 +1,37 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor]))
+       [macro])
+  (luxc [lang]
+        (lang ["ls" synthesis]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-loop translate offset initsS+ bodyS)
+  (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis
+      (Meta Expression))
+  (do {@ macro.Monad}
+    [loop-name (|> (macro.gensym "loop")
+                   (:: @ map (|>> %code lang.normalize-name)))
+     initsO+ (monad.map @ translate initsS+)
+     bodyO (//.with-anchor [loop-name offset]
+             (translate bodyS))
+     #let [$loop-name (r.var loop-name)
+           @loop-name (@@ $loop-name)]
+     _ (//.save (r.set! $loop-name
+                        (r.function (|> (list.n/range +0 (dec (list.size initsS+)))
+                                        (list/map (|>> (n/+ offset) referenceT.variable)))
+                          bodyO)))]
+    (wrap (r.apply initsO+ @loop-name))))
+
+(def: #export (translate-recur translate argsS+)
+  (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis)
+      (Meta Expression))
+  (do {@ macro.Monad}
+    [[loop-name offset] //.anchor
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (r.apply argsO+ (r.global loop-name)))))
diff --git a/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
new file mode 100644
index 000000000..8bc7da848
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
@@ -0,0 +1,22 @@
+(.module:
+  lux
+  (lux [macro "meta/" Monad])
+  (luxc (lang (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]))
+
+(def: #export translate-bit
+  (-> Bit (Meta Expression))
+  (|>> r.bool meta/wrap))
+
+(def: #export translate-int
+  (-> Int (Meta Expression))
+  (|>> runtimeT.int meta/wrap))
+
+(def: #export translate-frac
+  (-> Frac (Meta Expression))
+  (|>> r.float meta/wrap))
+
+(def: #export translate-text
+  (-> Text (Meta Expression))
+  (|>> r.string meta/wrap))
diff --git a/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux
new file mode 100644
index 000000000..85ccd90dc
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -0,0 +1,339 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             [text]
+             text/format
+             [number]
+             (coll [list "list/" Functor]
+                   (dictionary ["dict" unordered #+ Dict])))
+       [macro #+ with-gensyms]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" lang]
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (host [r #+ Expression])))
+  [///]
+  (/// [".T" runtime]
+       [".T" case]
+       [".T" function]
+       [".T" loop]))
+
+## [Types]
+(type: #export Translator
+  (-> ls.Synthesis (Meta Expression)))
+
+(type: #export Proc
+  (-> Translator (List ls.Synthesis) (Meta Expression)))
+
+(type: #export Bundle
+  (Dict Text Proc))
+
+(syntax: (Vector {size s.nat} elemT)
+  (wrap (list (` [(~+ (list.repeat size elemT))]))))
+
+(type: #export Nullary (-> (Vector +0 Expression) Expression))
+(type: #export Unary   (-> (Vector +1 Expression) Expression))
+(type: #export Binary  (-> (Vector +2 Expression) Expression))
+(type: #export Trinary (-> (Vector +3 Expression) Expression))
+(type: #export Variadic (-> (List Expression) Expression))
+
+## [Utils]
+(def: #export (install name unnamed)
+  (-> Text (-> Text Proc)
+      (-> Bundle Bundle))
+  (dict.put name (unnamed name)))
+
+(def: #export (prefix prefix bundle)
+  (-> Text Bundle Bundle)
+  (|> bundle
+      dict.entries
+      (list/map (function (_ [key val]) [(format prefix " " key) val]))
+      (dict.from-list text.Hash)))
+
+(def: (wrong-arity proc expected actual)
+  (-> Text Nat Nat Text)
+  (format "Wrong number of arguments for " (%t proc) "\n"
+          "Expected: " (|> expected .int %i) "\n"
+          "  Actual: " (|> actual .int %i)))
+
+(syntax: (arity: {name s.local-identifier} {arity s.nat})
+  (with-gensyms [g!_ g!proc g!name g!translate g!inputs]
+    (do {@ macro.monad}
+      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+      (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc))
+                       (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression)
+                           (-> Text ..Proc))
+                       (function ((~ g!_) (~ g!name))
+                         (function ((~ g!_) (~ g!translate) (~ g!inputs))
+                           (case (~ g!inputs)
+                             (^ (list (~+ g!input+)))
+                             (do macro.Monad
+                               [(~+ (|> g!input+
+                                        (list/map (function (_ g!input)
+                                                    (list g!input (` ((~ g!translate) (~ g!input))))))
+                                        list.concat))]
+                               ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
+
+                             (~' _)
+                             (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
+
+(arity: nullary +0)
+(arity: unary +1)
+(arity: binary +2)
+(arity: trinary +3)
+
+(def: #export (variadic proc)
+  (-> Variadic (-> Text Proc))
+  (function (_ proc-name)
+    (function (_ translate inputsS)
+      (do {@ macro.Monad}
+        [inputsI (monad.map @ translate inputsS)]
+        (wrap (proc inputsI))))))
+
+## [Procedures]
+## [[Lux]]
+(def: (lux//is [leftO rightO])
+  Binary
+  (r.apply (list leftO rightO)
+           (r.global "identical")))
+
+(def: (lux//if [testO thenO elseO])
+  Trinary
+  (caseT.translate-if testO thenO elseO))
+
+(def: (lux//try riskyO)
+  Unary
+  (runtimeT.lux//try riskyO))
+
+(exception: #export (Wrong-Syntax {message Text})
+  message)
+
+(def: #export (wrong-syntax procedure args)
+  (-> Text (List ls.Synthesis) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code.tuple args))))
+
+(def: lux//loop
+  (-> Text Proc)
+  (function (_ proc-name)
+    (function (_ translate inputsS)
+      (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any))
+        (#e.Success [offset initsS+ bodyS])
+        (loopT.translate-loop translate offset initsS+ bodyS)
+
+        (#e.Error error)
+        (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
+      )))
+
+(def: lux//recur
+  (-> Text Proc)
+  (function (_ proc-name)
+    (function (_ translate inputsS)
+      (loopT.translate-recur translate inputsS))))
+
+(def: lux-procs
+  Bundle
+  (|> (dict.new text.Hash)
+      (install "is" (binary lux//is))
+      (install "try" (unary lux//try))
+      (install "if" (trinary lux//if))
+      (install "loop" lux//loop)
+      (install "recur" lux//recur)
+      ))
+
+## [[Bits]]
+(template [ ]
+  [(def: ( [subjectO paramO])
+     Binary
+     ( paramO subjectO))]
+  
+  [bit//and runtimeT.bit//and]
+  [bit//or  runtimeT.bit//or]
+  [bit//xor runtimeT.bit//xor]
+  )
+
+(template [ ]
+  [(def: ( [subjectO paramO])
+     Binary
+     ( (runtimeT.int64-low paramO) subjectO))]
+
+  [bit//left-shift          runtimeT.bit//left-shift]
+  [bit//arithmetic-right-shift  runtimeT.bit//arithmetic-right-shift]
+  [bit//logical-right-shift runtimeT.bit//logical-right-shift]
+  )
+
+(def: bit-procs
+  Bundle
+  (<| (prefix "bit")
+      (|> (dict.new text.Hash)
+          (install "and" (binary bit//and))
+          (install "or" (binary bit//or))
+          (install "xor" (binary bit//xor))
+          (install "left-shift" (binary bit//left-shift))
+          (install "logical-right-shift" (binary bit//logical-right-shift))
+          (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
+          )))
+
+## [[Numbers]]
+(host.import: java/lang/Double
+  (#static MIN_VALUE Double)
+  (#static MAX_VALUE Double))
+
+(template [  ]
+  [(def: ( _)
+     Nullary
+     ( ))]
+
+  [frac//smallest Double::MIN_VALUE            r.float]
+  [frac//min      (f/* -1.0 Double::MAX_VALUE) r.float]
+  [frac//max      Double::MAX_VALUE            r.float]
+  )
+
+(template [ ]
+  [(def: ( [subjectO paramO])
+     Binary
+     (|> subjectO ( paramO)))]
+
+  [int//add        runtimeT.int//+]
+  [int//sub        runtimeT.int//-]
+  [int//mul        runtimeT.int//*]
+  [int//div        runtimeT.int///]
+  [int//rem        runtimeT.int//%]
+  )
+
+(template [ ]
+  [(def: ( [subjectO paramO])
+     Binary
+     ( paramO subjectO))]
+
+  [frac//add r.+]
+  [frac//sub r.-]
+  [frac//mul r.*]
+  [frac//div r./]
+  [frac//rem r.%%]
+  [frac//=   r.=]
+  [frac//<   r.<]
+
+  [text//=   r.=]
+  [text//<   r.<]
+  )
+
+(template [ ]
+  [(def: ( [subjectO paramO])
+     Binary
+     ( paramO subjectO))]
+
+  [int//= runtimeT.int//=]
+  [int//< runtimeT.int//<]
+  )
+
+(def: (apply1 func)
+  (-> Expression (-> Expression Expression))
+  (function (_ value)
+    (r.apply (list value) func)))
+
+(def: int//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8"))))
+
+(def: int-procs
+  Bundle
+  (<| (prefix "int")
+      (|> (dict.new text.Hash)
+          (install "+" (binary int//add))
+          (install "-" (binary int//sub))
+          (install "*" (binary int//mul))
+          (install "/" (binary int//div))
+          (install "%" (binary int//rem))
+          (install "=" (binary int//=))
+          (install "<" (binary int//<))
+          (install "to-frac" (unary runtimeT.int//to-float))
+          (install "char" (unary int//char)))))
+
+(def: (frac//encode value)
+  (-> Expression Expression)
+  (r.apply (list (r.string "%f") value) (r.global "sprintf")))
+
+(def: frac-procs
+  Bundle
+  (<| (prefix "frac")
+      (|> (dict.new text.Hash)
+          (install "+" (binary frac//add))
+          (install "-" (binary frac//sub))
+          (install "*" (binary frac//mul))
+          (install "/" (binary frac//div))
+          (install "%" (binary frac//rem))
+          (install "=" (binary frac//=))
+          (install "<" (binary frac//<))
+          (install "smallest" (nullary frac//smallest))
+          (install "min" (nullary frac//min))
+          (install "max" (nullary frac//max))
+          (install "to-int" (unary (apply1 (r.global "as.integer"))))
+          (install "encode" (unary frac//encode))
+          (install "decode" (unary runtimeT.frac//decode)))))
+
+## [[Text]]
+(def: (text//concat [subjectO paramO])
+  Binary
+  (r.apply (list subjectO paramO) (r.global "paste0")))
+
+(def: (text//char [subjectO paramO])
+  Binary
+  (runtimeT.text//char subjectO paramO))
+
+(def: (text//clip [subjectO paramO extraO])
+  Trinary
+  (runtimeT.text//clip subjectO paramO extraO))
+
+(def: (text//index [textO partO startO])
+  Trinary
+  (runtimeT.text//index textO partO startO))
+
+(def: text-procs
+  Bundle
+  (<| (prefix "text")
+      (|> (dict.new text.Hash)
+          (install "=" (binary text//=))
+          (install "<" (binary text//<))
+          (install "concat" (binary text//concat))
+          (install "index" (trinary text//index))
+          (install "size" (unary (|>> (apply1 (r.global "nchar")) runtimeT.int//from-float)))
+          (install "char" (binary text//char))
+          (install "clip" (trinary text//clip))
+          )))
+
+## [[IO]]
+(def: (io//exit input)
+  Unary
+  (r.apply-kw (list)
+              (list ["status" (runtimeT.int//to-float input)])
+              (r.global "quit")))
+
+(def: (void code)
+  (-> Expression Expression)
+  (r.block (r.then code runtimeT.unit)))
+
+(def: io-procs
+  Bundle
+  (<| (prefix "io")
+      (|> (dict.new text.Hash)
+          (install "log" (unary (|>> r.print ..void)))
+          (install "error" (unary r.stop))
+          (install "exit" (unary io//exit))
+          (install "current-time" (nullary (function (_ _)
+                                             (runtimeT.io//current-time! runtimeT.unit)))))))
+
+## [Bundles]
+(def: #export procedures
+  Bundle
+  (<| (prefix "lux")
+      (|> lux-procs
+          (dict.merge bit-procs)
+          (dict.merge int-procs)
+          (dict.merge frac-procs)
+          (dict.merge text-procs)
+          (dict.merge io-procs)
+          )))
diff --git a/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux
new file mode 100644
index 000000000..3bd33955f
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux
@@ -0,0 +1,89 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor]
+                   (dictionary ["dict" unordered #+ Dict])))
+       [macro "macro/" Monad])
+  (luxc ["&" lang]
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (host [ruby #+ Ruby Expression Statement])))
+  [///]
+  (/// [".T" runtime])
+  (// ["@" common]))
+
+## (template [ ]
+##   [(def: ( _) @.Nullary )]
+
+##   [lua//nil      "nil"]
+##   [lua//table    "{}"]
+##   )
+
+## (def: (lua//global proc translate inputs)
+##   (-> Text @.Proc)
+##   (case inputs
+##     (^ (list [_ (#.Text name)]))
+##     (do macro.Monad
+##       []
+##       (wrap name))
+
+##     _
+##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: (lua//call proc translate inputs)
+##   (-> Text @.Proc)
+##   (case inputs
+##     (^ (list& functionS argsS+))
+##     (do {@ macro.Monad}
+##       [functionO (translate functionS)
+##        argsO+ (monad.map @ translate argsS+)]
+##       (wrap (lua.apply functionO argsO+)))
+
+##     _
+##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: lua-procs
+##   @.Bundle
+##   (|> (dict.new text.Hash)
+##       (@.install "nil" (@.nullary lua//nil))
+##       (@.install "table" (@.nullary lua//table))
+##       (@.install "global" lua//global)
+##       (@.install "call" lua//call)))
+
+## (def: (table//call proc translate inputs)
+##   (-> Text @.Proc)
+##   (case inputs
+##     (^ (list& tableS [_ (#.Text field)] argsS+))
+##     (do {@ macro.Monad}
+##       [tableO (translate tableS)
+##        argsO+ (monad.map @ translate argsS+)]
+##       (wrap (lua.method field tableO argsO+)))
+
+##     _
+##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: (table//get [fieldO tableO])
+##   @.Binary
+##   (runtimeT.lua//get tableO fieldO))
+
+## (def: (table//set [fieldO valueO tableO])
+##   @.Trinary
+##   (runtimeT.lua//set tableO fieldO valueO))
+
+## (def: table-procs
+##   @.Bundle
+##   (<| (@.prefix "table")
+##       (|> (dict.new text.Hash)
+##           (@.install "call" table//call)
+##           (@.install "get" (@.binary table//get))
+##           (@.install "set" (@.trinary table//set)))))
+
+(def: #export procedures
+  @.Bundle
+  (<| (@.prefix "lua")
+      (dict.new text.Hash)
+      ## (|> lua-procs
+      ##     (dict.merge table-procs))
+      ))
diff --git a/lux-r/source/luxc/lang/translation/r/reference.jvm.lux b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
new file mode 100644
index 000000000..7de1c74ee
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
@@ -0,0 +1,42 @@
+(.module:
+  lux
+  (lux [macro]
+       (data [text]
+             text/format))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              (host [r #+ Expression SVar @@])))
+  [//]
+  (// [".T" runtime]))
+
+(template [  ]
+  [(def: #export ( register)
+     (-> Register SVar)
+     (r.var (format  (%i (.int register)))))
+   
+   (def: #export ( register)
+     (-> Register (Meta Expression))
+     (:: macro.Monad wrap (@@ ( register))))]
+
+  [closure  translate-captured "c"]
+  [variable translate-local    "v"])
+
+(def: #export (local var)
+  (-> Variable SVar)
+  (if (variableL.captured? var)
+    (closure (variableL.captured-register var))
+    (variable (.nat var))))
+
+(def: #export (translate-variable var)
+  (-> Variable (Meta Expression))
+  (if (variableL.captured? var)
+    (translate-captured (variableL.captured-register var))
+    (translate-local (.nat var))))
+
+(def: #export global
+  (-> Name SVar)
+  (|>> //.definition-name r.var))
+
+(def: #export (translate-definition name)
+  (-> Name (Meta Expression))
+  (:: macro.Monad wrap (@@ (global name))))
diff --git a/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
new file mode 100644
index 000000000..d641041d2
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -0,0 +1,802 @@
+(.module:
+  lux
+  (lux (control ["p" parser "p/" Monad]
+                [monad #+ do])
+       (data [bit]
+             [number (#+ hex) ("int/" Interval)]
+             text/format
+             (coll [list "list/" Monad]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [io #+ Process])
+  [//]
+  (luxc [lang]
+        (lang (host [r #+ SVar Expression @@]))))
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export unit Expression (r.string //.unit))
+
+(def: full-32 (hex "+FFFFFFFF"))
+(def: half-32 (hex "+7FFFFFFF"))
+(def: post-32 (hex "+100000000"))
+
+(def: (cap-32 input)
+  (-> Nat Int)
+  (cond (n/> full-32 input)
+        (|> input (bit.and full-32) cap-32)
+        
+        (n/> half-32 input)
+        (|> post-32 (n/- input) .int (i/* -1))
+        
+        ## else
+        (.int input)))
+
+(def: high-32 (bit.logical-right-shift +32))
+(def: low-32 (|>> (bit.and (hex "+FFFFFFFF"))))
+
+(def: #export (int value)
+  (-> Int Expression)
+  (let [value (.nat value)
+        high (|> value ..high-32 cap-32)
+        low (|> value ..low-32 cap-32)]
+    (r.named-list (list [//.int-high-field (r.int high)]
+                        [//.int-low-field (r.int low)]))))
+
+(def: (flag value)
+  (-> Bit Expression)
+  (if value
+    (r.string "")
+    r.null))
+
+(def: (variant' tag last? value)
+  (-> Expression Expression Expression Expression)
+  (r.named-list (list [//.variant-tag-field tag]
+                      [//.variant-flag-field last?]
+                      [//.variant-value-field value])))
+
+(def: #export (variant tag last? value)
+  (-> Nat Bit Expression Expression)
+  (variant' (r.int (.int tag))
+            (flag last?)
+            value))
+
+(def: #export none
+  Expression
+  (variant +0 #0 unit))
+
+(def: #export some
+  (-> Expression Expression)
+  (variant +1 #1))
+
+(def: #export left
+  (-> Expression Expression)
+  (variant +0 #0))
+
+(def: #export right
+  (-> Expression Expression)
+  (variant +1 #1))
+
+(type: Runtime Expression)
+
+(def: declaration
+  (s.Syntax [Text (List Text)])
+  (p.either (p.seq s.local-identifier (p/wrap (list)))
+            (s.form (p.seq s.local-identifier (p.some s.local-identifier)))))
+
+(syntax: (runtime: {[name args] declaration}
+           definition)
+  (let [implementation (code.local-identifier (format "@@" name))
+        runtime (format prefix "__" (lang.normalize-name name))
+        $runtime (` (r.var (~ (code.text runtime))))
+        @runtime (` (@@ (~ $runtime)))
+        argsC+ (list/map code.local-identifier args)
+        argsLC+ (list/map (|>> lang.normalize-name (format "LRV__") code.text (~) (r.var) (`))
+                          args)
+        declaration (` ((~ (code.local-identifier name))
+                        (~+ argsC+)))
+        type (` (-> (~+ (list.repeat (list.size argsC+) (` r.Expression)))
+                    r.Expression))]
+    (wrap (list (` (def: (~' #export) (~ declaration)
+                     (~ type)
+                     (~ (case argsC+
+                          #.Nil
+                          @runtime
+
+                          _
+                          (` (r.apply (list (~+ argsC+)) (~ @runtime)))))))
+                (` (def: (~ implementation)
+                     r.Expression
+                     (~ (case argsC+
+                          #.Nil
+                          (` (r.set! (~ $runtime) (~ definition)))
+
+                          _
+                          (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
+                                           (list/map (function (_ [left right])
+                                                       (list left right)))
+                                           list/join))]
+                               (r.set! (~ $runtime)
+                                       (r.function (list (~+ argsLC+))
+                                         (~ definition)))))))))))))
+
+(syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))}
+                   body)
+  (wrap (list (` (let [(~+ (|> vars
+                               (list/map (function (_ var)
+                                           (list (code.local-identifier var)
+                                                 (` (r.var (~ (code.text (format "LRV__" (lang.normalize-name var)))))))))
+                               list/join))]
+                   (~ body))))))
+
+(def: high-shift (r.bit-shl (r.int 32)))
+
+(runtime: f2^32 (|> (r.int 2) (r.** (r.int 32))))
+(runtime: f2^63 (|> (r.int 2) (r.** (r.int 63))))
+
+(def: (as-double value)
+  (-> Expression Expression)
+  (r.apply (list value) (r.global "as.double")))
+
+(def: (as-integer value)
+  (-> Expression Expression)
+  (r.apply (list value) (r.global "as.integer")))
+
+(runtime: (int//unsigned-low input)
+  (with-vars [low]
+    ($_ r.then
+        (r.set! low (|> (@@ input) (r.nth (r.string //.int-low-field))))
+        (r.if (|> (@@ low) (r.>= (r.int 0)))
+          (@@ low)
+          (|> (@@ low) (r.+ f2^32))))))
+
+(runtime: (int//to-float input)
+  (let [high (|> (@@ input)
+                 (r.nth (r.string //.int-high-field))
+                 high-shift)
+        low (|> (@@ input)
+                int//unsigned-low)]
+    (|> high (r.+ low) as-double)))
+
+(runtime: (int//new high low)
+  (r.named-list (list [//.int-high-field (as-integer (@@ high))]
+                      [//.int-low-field (as-integer (@@ low))])))
+
+(template [ ]
+  [(runtime: 
+     (..int ))]
+
+  [int//zero 0]
+  [int//one 1]
+  [int//min int/bottom]
+  [int//max int/top]
+  )
+
+(def: #export int64-high (r.nth (r.string //.int-high-field)))
+(def: #export int64-low (r.nth (r.string //.int-low-field)))
+
+(runtime: (bit//not input)
+  (int//new (|> (@@ input) int64-high r.bit-not)
+            (|> (@@ input) int64-low r.bit-not)))
+
+(runtime: (int//+ param subject)
+  (with-vars [sH sL pH pL
+              x00 x16 x32 x48]
+    ($_ r.then
+        (r.set! sH (|> (@@ subject) int64-high))
+        (r.set! sL (|> (@@ subject) int64-low))
+        (r.set! pH (|> (@@ param) int64-high))
+        (r.set! pL (|> (@@ param) int64-low))
+        (let [bits16 (r.code "0xFFFF")
+              move-top-16 (r.bit-shl (r.int 16))
+              top-16 (r.bit-ushr (r.int 16))
+              bottom-16 (r.bit-and bits16)
+              split-16 (function (_ source)
+                         [(|> source top-16)
+                          (|> source bottom-16)])
+              split-int (function (_ high low)
+                          [(split-16 high)
+                           (split-16 low)])
+              
+              [[s48 s32] [s16 s00]] (split-int (@@ sH) (@@ sL))
+              [[p48 p32] [p16 p00]] (split-int (@@ pH) (@@ pL))
+              new-half (function (_ top bottom)
+                         (|> top bottom-16 move-top-16
+                             (r.bit-or (bottom-16 bottom))))]
+          ($_ r.then
+              (r.set! x00 (|> s00 (r.+ p00)))
+              (r.set! x16 (|> (@@ x00) top-16 (r.+ s16) (r.+ p16)))
+              (r.set! x32 (|> (@@ x16) top-16 (r.+ s32) (r.+ p32)))
+              (r.set! x48 (|> (@@ x32) top-16 (r.+ s48) (r.+ p48)))
+              (int//new (new-half (@@ x48) (@@ x32))
+                        (new-half (@@ x16) (@@ x00))))))))
+
+(runtime: (int//= reference sample)
+  (let [n/a? (function (_ value)
+               (r.apply (list value) (r.global "is.na")))
+        isTRUE? (function (_ value)
+                  (r.apply (list value) (r.global "isTRUE")))
+        comparison (: (-> (-> Expression Expression) Expression)
+                      (function (_ field)
+                        (|> (|> (field (@@ sample)) (r.= (field (@@ reference))))
+                            (r.or (|> (n/a? (field (@@ sample)))
+                                      (r.and (n/a? (field (@@ reference)))))))))]
+    (|> (comparison int64-high)
+        (r.and (comparison int64-low))
+        isTRUE?)))
+
+(runtime: (int//negate input)
+  (r.if (|> (@@ input) (int//= int//min))
+    int//min
+    (|> (@@ input) bit//not (int//+ int//one))))
+
+(runtime: int//-one
+  (int//negate int//one))
+
+(runtime: (int//- param subject)
+  (int//+ (int//negate (@@ param)) (@@ subject)))
+
+(runtime: (int//< reference sample)
+  (with-vars [r-? s-?]
+    ($_ r.then
+        (r.set! s-? (|> (@@ sample) int64-high (r.< (r.int 0))))
+        (r.set! r-? (|> (@@ reference) int64-high (r.< (r.int 0))))
+        (|> (|> (@@ s-?) (r.and (r.not (@@ r-?))))
+            (r.or (|> (r.not (@@ s-?)) (r.and (@@ r-?)) r.not))
+            (r.or (|> (@@ sample)
+                      (int//- (@@ reference))
+                      int64-high
+                      (r.< (r.int 0))))))))
+
+(runtime: (int//from-float input)
+  (r.cond (list [(r.apply (list (@@ input)) (r.global "is.nan"))
+                 int//zero]
+                [(|> (@@ input) (r.<= (r.negate f2^63)))
+                 int//min]
+                [(|> (@@ input) (r.+ (r.float 1.0)) (r.>= f2^63))
+                 int//max]
+                [(|> (@@ input) (r.< (r.float 0.0)))
+                 (|> (@@ input) r.negate int//from-float int//negate)])
+          (int//new (|> (@@ input) (r./ f2^32))
+                    (|> (@@ input) (r.%% f2^32)))))
+
+(runtime: (int//* param subject)
+  (with-vars [sH sL pH pL
+              x00 x16 x32 x48]
+    ($_ r.then
+        (r.set! sH (|> (@@ subject) int64-high))
+        (r.set! pH (|> (@@ param) int64-high))
+        (let [negative-subject? (|> (@@ sH) (r.< (r.int 0)))
+              negative-param? (|> (@@ pH) (r.< (r.int 0)))]
+          (r.cond (list [negative-subject?
+                         (r.if negative-param?
+                           (int//* (int//negate (@@ param))
+                                   (int//negate (@@ subject)))
+                           (int//negate (int//* (@@ param)
+                                                (int//negate (@@ subject)))))]
+
+                        [negative-param?
+                         (int//negate (int//* (int//negate (@@ param))
+                                              (@@ subject)))])
+                  ($_ r.then
+                      (r.set! sL (|> (@@ subject) int64-low))
+                      (r.set! pL (|> (@@ param) int64-low))
+                      (let [bits16 (r.code "0xFFFF")
+                            move-top-16 (r.bit-shl (r.int 16))
+                            top-16 (r.bit-ushr (r.int 16))
+                            bottom-16 (r.bit-and bits16)
+                            split-16 (function (_ source)
+                                       [(|> source top-16)
+                                        (|> source bottom-16)])
+                            split-int (function (_ high low)
+                                        [(split-16 high)
+                                         (split-16 low)])
+                            new-half (function (_ top bottom)
+                                       (|> top bottom-16 move-top-16
+                                           (r.bit-or (bottom-16 bottom))))
+                            x16-top (|> (@@ x16) top-16)
+                            x32-top (|> (@@ x32) top-16)]
+                        (with-vars [s48 s32 s16 s00
+                                    p48 p32 p16 p00]
+                          (let [[[_s48 _s32] [_s16 _s00]] (split-int (@@ sH) (@@ sL))
+                                [[_p48 _p32] [_p16 _p00]] (split-int (@@ pH) (@@ pL))
+                                set-subject-chunks! ($_ r.then (r.set! s48 _s48) (r.set! s32 _s32) (r.set! s16 _s16) (r.set! s00 _s00))
+                                set-param-chunks! ($_ r.then (r.set! p48 _p48) (r.set! p32 _p32) (r.set! p16 _p16) (r.set! p00 _p00))]
+                            ($_ r.then
+                                set-subject-chunks!
+                                set-param-chunks!
+                                (r.set! x00 (|> (@@ s00) (r.* (@@ p00))))
+                                (r.set! x16 (|> (@@ x00) top-16 (r.+ (|> (@@ s16) (r.* (@@ p00))))))
+                                (r.set! x32 x16-top)
+                                (r.set! x16 (|> (@@ x16) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p16))))))
+                                (r.set! x32 (|> (@@ x32) (r.+ x16-top) (r.+ (|> (@@ s32) (r.* (@@ p00))))))
+                                (r.set! x48 x32-top)
+                                (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s16) (r.* (@@ p16))))))
+                                (r.set! x48 (|> (@@ x48) (r.+ x32-top)))
+                                (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p32))))))
+                                (r.set! x48 (|> (@@ x48) (r.+ x32-top)
+                                                (r.+ (|> (@@ s48) (r.* (@@ p00))))
+                                                (r.+ (|> (@@ s32) (r.* (@@ p16))))
+                                                (r.+ (|> (@@ s16) (r.* (@@ p32))))
+                                                (r.+ (|> (@@ s00) (r.* (@@ p48))))))
+                                (int//new (new-half (@@ x48) (@@ x32))
+                                          (new-half (@@ x16) (@@ x00))))))
+                        )))))))
+
+(def: (limit-shift! shift)
+  (-> SVar Expression)
+  (r.set! shift (|> (@@ shift) (r.bit-and (r.int 63)))))
+
+(def: (no-shift-clause shift input)
+  (-> SVar SVar [Expression Expression])
+  [(|> (@@ shift) (r.= (r.int 0)))
+   (@@ input)])
+
+(runtime: (bit//left-shift shift input)
+  ($_ r.then
+      (limit-shift! shift)
+      (r.cond (list (no-shift-clause shift input)
+                    [(|> (@@ shift) (r.< (r.int 32)))
+                     (let [mid (|> (int64-low (@@ input)) (r.bit-ushr (|> (r.int 32) (r.- (@@ shift)))))
+                           high (|> (int64-high (@@ input))
+                                    (r.bit-shl (@@ shift))
+                                    (r.bit-or mid))
+                           low (|> (int64-low (@@ input))
+                                   (r.bit-shl (@@ shift)))]
+                       (int//new high low))])
+              (let [high (|> (int64-high (@@ input))
+                             (r.bit-shl (|> (@@ shift) (r.- (r.int 32)))))]
+                (int//new high (r.int 0))))))
+
+(runtime: (bit//arithmetic-right-shift-32 shift input)
+  (let [top-bit (|> (@@ input) (r.bit-and (r.int (hex "80000000"))))]
+    (|> (@@ input)
+        (r.bit-ushr (@@ shift))
+        (r.bit-or top-bit))))
+
+(runtime: (bit//arithmetic-right-shift shift input)
+  ($_ r.then
+      (limit-shift! shift)
+      (r.cond (list (no-shift-clause shift input)
+                    [(|> (@@ shift) (r.< (r.int 32)))
+                     (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
+                           high (|> (int64-high (@@ input))
+                                    (bit//arithmetic-right-shift-32 (@@ shift)))
+                           low (|> (int64-low (@@ input))
+                                   (r.bit-ushr (@@ shift))
+                                   (r.bit-or mid))]
+                       (int//new high low))])
+              (let [low (|> (int64-high (@@ input))
+                            (bit//arithmetic-right-shift-32 (|> (@@ shift) (r.- (r.int 32)))))
+                    high (r.if (|> (int64-high (@@ input)) (r.>= (r.int 0)))
+                           (r.int 0)
+                           (r.int -1))]
+                (int//new high low)))))
+
+(runtime: (int/// param subject)
+  (let [negative? (|>> (int//< int//zero))
+        valid-division-check [(|> (@@ param) (int//= int//zero))
+                              (r.stop (r.string "Cannot divide by zero!"))]
+        short-circuit-check [(|> (@@ subject) (int//= int//zero))
+                             int//zero]]
+    (r.cond (list valid-division-check
+                  short-circuit-check
+
+                  [(|> (@@ subject) (int//= int//min))
+                   (r.cond (list [(|> (|> (@@ param) (int//= int//one))
+                                      (r.or (|> (@@ param) (int//= int//-one))))
+                                  int//min]
+                                 [(|> (@@ param) (int//= int//min))
+                                  int//one])
+                           (with-vars [approximation]
+                             ($_ r.then
+                                 (r.set! approximation
+                                         (|> (@@ subject)
+                                             (bit//arithmetic-right-shift (r.int 1))
+                                             (int/// (@@ param))
+                                             (bit//left-shift (r.int 1))))
+                                 (r.if (|> (@@ approximation) (int//= int//zero))
+                                   (r.if (negative? (@@ param))
+                                     int//one
+                                     int//-one)
+                                   (let [remainder (int//- (int//* (@@ param) (@@ approximation))
+                                                           (@@ subject))]
+                                     (|> remainder
+                                         (int/// (@@ param))
+                                         (int//+ (@@ approximation))))))))]
+                  [(|> (@@ param) (int//= int//min))
+                   int//zero]
+
+                  [(negative? (@@ subject))
+                   (r.if (negative? (@@ param))
+                     (|> (int//negate (@@ subject))
+                         (int/// (int//negate (@@ param))))
+                     (|> (int//negate (@@ subject))
+                         (int/// (@@ param))
+                         int//negate))]
+
+                  [(negative? (@@ param))
+                   (|> (@@ param)
+                       int//negate
+                       (int/// (@@ subject))
+                       int//negate)])
+            (with-vars [result remainder approximate approximate-result log2 approximate-remainder]
+              ($_ r.then
+                  (r.set! result int//zero)
+                  (r.set! remainder (@@ subject))
+                  (r.while (|> (|> (@@ remainder) (int//< (@@ param)))
+                               (r.or (|> (@@ remainder) (int//= (@@ param)))))
+                           (let [calc-rough-estimate (r.apply (list (|> (int//to-float (@@ remainder)) (r./ (int//to-float (@@ param)))))
+                                                              (r.global "floor"))
+                                 calc-approximate-result (int//from-float (@@ approximate))
+                                 calc-approximate-remainder (|> (@@ approximate-result) (int//* (@@ param)))
+                                 delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
+                                         (r.float 1.0)
+                                         (r.** (|> (@@ log2) (r.- (r.float 48.0)))
+                                               (r.float 2.0)))]
+                             ($_ r.then
+                                 (r.set! approximate (r.apply (list (r.float 1.0) calc-rough-estimate)
+                                                              (r.global "max")))
+                                 (r.set! log2 (let [log (function (_ input)
+                                                          (r.apply (list input) (r.global "log")))]
+                                                (r.apply (list (|> (log (r.int 2))
+                                                                   (r./ (log (@@ approximate)))))
+                                                         (r.global "ceil"))))
+                                 (r.set! approximate-result calc-approximate-result)
+                                 (r.set! approximate-remainder calc-approximate-remainder)
+                                 (r.while (|> (negative? (@@ approximate-remainder))
+                                              (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
+                                          ($_ r.then
+                                              (r.set! approximate (|> delta (r.- (@@ approximate))))
+                                              (r.set! approximate-result calc-approximate-result)
+                                              (r.set! approximate-remainder calc-approximate-remainder)))
+                                 (r.set! result (|> (r.if (|> (@@ approximate-result) (int//= int//zero))
+                                                      int//one
+                                                      (@@ approximate-result))
+                                                    (int//+ (@@ result))))
+                                 (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder)))))))
+                  (@@ result)))
+            )))
+
+(runtime: (int//% param subject)
+  (let [flat (|> (@@ subject) (int/// (@@ param)) (int//* (@@ param)))]
+    (|> (@@ subject) (int//- flat))))
+
+(def: runtime//int
+  Runtime
+  ($_ r.then
+      @@int//zero
+      @@int//one
+      @@int//min
+      @@int//max
+      @@int//=
+      @@int//<
+      @@int//+
+      @@int//-
+      @@int//negate
+      @@int//-one
+      @@int//unsigned-low
+      @@int//to-float
+      @@int//*
+      @@int///
+      @@int//%))
+
+(runtime: (lux//try op)
+  (with-vars [error value]
+    (r.try ($_ r.then
+               (r.set! value (r.apply (list ..unit) (@@ op)))
+               (..right (@@ value)))
+           #.None
+           (#.Some (r.function (list error)
+                     (..left (r.nth (r.string "message")
+                                    (@@ error)))))
+           #.None)))
+
+(runtime: (lux//program-args program-args)
+  (with-vars [inputs value]
+    ($_ r.then
+        (r.set! inputs ..none)
+        (<| (r.for-in value (@@ program-args))
+            (r.set! inputs (..some (r.list (list (@@ value) (@@ inputs))))))
+        (@@ inputs))))
+
+(def: runtime//lux
+  Runtime
+  ($_ r.then
+      @@lux//try
+      @@lux//program-args))
+
+(def: current-time-float
+  Expression
+  (let [raw-time (r.apply (list) (r.global "Sys.time"))]
+    (r.apply (list raw-time) (r.global "as.numeric"))))
+
+(runtime: (io//current-time! _)
+  (|> current-time-float
+      (r.* (r.float 1,000.0))
+      int//from-float))
+
+(def: runtime//io
+  Runtime
+  ($_ r.then
+      @@io//current-time!))
+
+(def: minimum-index-length
+  (-> SVar Expression)
+  (|>> @@ (r.+ (r.int 1))))
+
+(def: (product-element product index)
+  (-> Expression Expression Expression)
+  (|> product (r.nth (|> index (r.+ (r.int 1))))))
+
+(def: (product-tail product)
+  (-> SVar Expression)
+  (|> (@@ product) (r.nth (r.length (@@ product)))))
+
+(def: (updated-index min-length product)
+  (-> Expression Expression Expression)
+  (|> min-length (r.- (r.length product))))
+
+(runtime: (product//left product index)
+  (let [$index_min_length (r.var "index_min_length")]
+    ($_ r.then
+        (r.set! $index_min_length (minimum-index-length index))
+        (r.if (|> (r.length (@@ product)) (r.> (@@ $index_min_length)))
+          ## No need for recursion
+          (product-element (@@ product) (@@ index))
+          ## Needs recursion
+          (product//left (product-tail product)
+                         (updated-index (@@ $index_min_length) (@@ product)))))))
+
+(runtime: (product//right product index)
+  (let [$index_min_length (r.var "index_min_length")]
+    ($_ r.then
+        (r.set! $index_min_length (minimum-index-length index))
+        (r.cond (list [## Last element.
+                       (|> (r.length (@@ product)) (r.= (@@ $index_min_length)))
+                       (product-element (@@ product) (@@ index))]
+                      [## Needs recursion
+                       (|> (r.length (@@ product)) (r.< (@@ $index_min_length)))
+                       (product//right (product-tail product)
+                                       (updated-index (@@ $index_min_length) (@@ product)))])
+                ## Must slice
+                (|> (@@ product) (r.slice-from (@@ index)))))))
+
+(runtime: (sum//get sum wanted_tag wants_last)
+  (let [no-match r.null
+        sum-tag (|> (@@ sum) (r.nth (r.string //.variant-tag-field)))
+        sum-flag (|> (@@ sum) (r.nth (r.string //.variant-flag-field)))
+        sum-value (|> (@@ sum) (r.nth (r.string //.variant-value-field)))
+        is-last? (|> sum-flag (r.= (r.string "")))
+        test-recursion (r.if is-last?
+                         ## Must recurse.
+                         (sum//get sum-value
+                                   (|> (@@ wanted_tag) (r.- sum-tag))
+                                   (@@ wants_last))
+                         no-match)]
+    (r.cond (list [(r.= sum-tag (@@ wanted_tag))
+                   (r.if (r.= (@@ wants_last) sum-flag)
+                     sum-value
+                     test-recursion)]
+
+                  [(|> (@@ wanted_tag) (r.> sum-tag))
+                   test-recursion]
+
+                  [(|> (|> (@@ wants_last) (r.= (r.string "")))
+                       (r.and (|> (@@ wanted_tag) (r.< sum-tag))))
+                   (variant' (|> sum-tag (r.- (@@ wanted_tag))) sum-flag sum-value)])
+
+            no-match)))
+
+(def: runtime//adt
+  Runtime
+  ($_ r.then
+      @@product//left
+      @@product//right
+      @@sum//get
+      ))
+
+(template [ ]
+  [(runtime: ( mask input)
+     (int//new ( (int64-high (@@ mask))
+                     (int64-high (@@ input)))
+               ( (int64-low (@@ mask))
+                     (int64-low (@@ input)))))]
+
+  [bit//and r.bit-and]
+  [bit//or  r.bit-or]
+  [bit//xor r.bit-xor]
+  )
+
+(runtime: (bit//logical-right-shift shift input)
+  ($_ r.then
+      (limit-shift! shift)
+      (r.cond (list (no-shift-clause shift input)
+                    [(|> (@@ shift) (r.< (r.int 32)))
+                     (with-vars [$mid]
+                       (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
+                             high (|> (int64-high (@@ input)) (r.bit-ushr (@@ shift)))
+                             low (|> (int64-low (@@ input))
+                                     (r.bit-ushr (@@ shift))
+                                     (r.bit-or (r.if (r.apply (list (@@ $mid)) (r.global "is.na"))
+                                                 (r.int 0)
+                                                 (@@ $mid))))]
+                         ($_ r.then
+                             (r.set! $mid mid)
+                             (int//new high low))))]
+                    [(|> (@@ shift) (r.= (r.int 32)))
+                     (let [high (int64-high (@@ input))]
+                       (int//new (r.int 0) high))])
+              (let [low (|> (int64-high (@@ input)) (r.bit-ushr (|> (@@ shift) (r.- (r.int 32)))))]
+                (int//new (r.int 0) low)))))
+
+(def: runtime//bit
+  Runtime
+  ($_ r.then
+      @@bit//and
+      @@bit//or
+      @@bit//xor
+      @@bit//not
+      @@bit//left-shift
+      @@bit//arithmetic-right-shift-32
+      @@bit//arithmetic-right-shift
+      @@bit//logical-right-shift
+      ))
+
+(runtime: (frac//decode input)
+  (with-vars [output]
+    ($_ r.then
+        (r.set! output (r.apply (list (@@ input)) (r.global "as.numeric")))
+        (r.if (|> (@@ output) (r.= r.n/a))
+          ..none
+          (..some (@@ output))))))
+
+(def: runtime//frac
+  Runtime
+  ($_ r.then
+      @@frac//decode))
+
+(def: inc (-> Expression Expression) (|>> (r.+ (r.int 1))))
+
+(template [ ]
+  [(def: ( top value)
+     (-> Expression Expression Expression)
+     (|> (|> value (r.>= (r.int 0)))
+         (r.and (|> value ( top)))))]
+
+  [within? r.<]
+  [up-to?  r.<=]
+  )
+
+(def: (text-clip start end text)
+  (-> Expression Expression Expression Expression)
+  (r.apply (list text start end)
+           (r.global "substr")))
+
+(def: (text-length text)
+  (-> Expression Expression)
+  (r.apply (list text) (r.global "nchar")))
+
+(runtime: (text//index subject param start)
+  (with-vars [idx startF subjectL]
+    ($_ r.then
+        (r.set! startF (int//to-float (@@ start)))
+        (r.set! subjectL (text-length (@@ subject)))
+        (r.if (|> (@@ startF) (within? (@@ subjectL)))
+          ($_ r.then
+              (r.set! idx (|> (r.apply-kw (list (@@ param) (r.if (|> (@@ startF) (r.= (r.int 0)))
+                                                             (@@ subject)
+                                                             (text-clip (inc (@@ startF))
+                                                                        (inc (@@ subjectL))
+                                                                        (@@ subject))))
+                                          (list ["fixed" (r.bool #1)])
+                                          (r.global "regexpr"))
+                              (r.nth (r.int 1))))
+              (r.if (|> (@@ idx) (r.= (r.int -1)))
+                ..none
+                (..some (int//from-float (|> (@@ idx) (r.+ (@@ startF)))))))
+          ..none))))
+
+(runtime: (text//clip text from to)
+  (with-vars [length]
+    ($_ r.then
+        (r.set! length (r.length (@@ text)))
+        (r.if ($_ r.and
+                  (|> (@@ to) (within? (@@ length)))
+                  (|> (@@ from) (up-to? (@@ to))))
+          (..some (text-clip (inc (@@ from)) (inc (@@ to)) (@@ text)))
+          ..none))))
+
+(def: (char-at idx text)
+  (-> Expression Expression Expression)
+  (r.apply (list (text-clip idx idx text))
+           (r.global "utf8ToInt")))
+
+(runtime: (text//char text idx)
+  (r.if (|> (@@ idx) (within? (r.length (@@ text))))
+    ($_ r.then
+        (r.set! idx (inc (@@ idx)))
+        (..some (int//from-float (char-at (@@ idx) (@@ text)))))
+    ..none))
+
+(def: runtime//text
+  Runtime
+  ($_ r.then
+      @@text//index
+      @@text//clip
+      @@text//char))
+
+(def: (check-index-out-of-bounds array idx body)
+  (-> Expression Expression Expression Expression)
+  (r.if (|> idx (r.<= (r.length array)))
+    body
+    (r.stop (r.string "Array index out of bounds!"))))
+
+(runtime: (array//new size)
+  (with-vars [output]
+    ($_ r.then
+        (r.set! output (r.list (list)))
+        (r.set-nth! (|> (@@ size) (r.+ (r.int 1)))
+                    r.null
+                    output)
+        (@@ output))))
+
+(runtime: (array//get array idx)
+  (with-vars [temp]
+    (<| (check-index-out-of-bounds (@@ array) (@@ idx))
+        ($_ r.then
+            (r.set! temp (|> (@@ array) (r.nth (@@ idx))))
+            (r.if (|> (@@ temp) (r.= r.null))
+              ..none
+              (..some (@@ temp)))))))
+
+(runtime: (array//put array idx value)
+  (<| (check-index-out-of-bounds (@@ array) (@@ idx))
+      ($_ r.then
+          (r.set-nth! (@@ idx) (@@ value) array)
+          (@@ array))))
+
+(def: runtime//array
+  Runtime
+  ($_ r.then
+      @@array//new
+      @@array//get
+      @@array//put))
+
+(runtime: (box//write value box)
+  ($_ r.then
+      (r.set-nth! (r.int 1) (@@ value) box)
+      ..unit))
+
+(def: runtime//box
+  Runtime
+  ($_ r.then
+      @@box//write))
+
+(def: runtime
+  Runtime
+  ($_ r.then
+      runtime//lux
+      @@f2^32
+      @@f2^63
+      @@int//new
+      @@int//from-float
+      runtime//bit
+      runtime//int
+      runtime//adt
+      runtime//frac
+      runtime//text
+      runtime//array
+      runtime//box
+      runtime//io
+      ))
+
+(def: #export artifact Text (format prefix ".r"))
+
+(def: #export translate
+  (Meta (Process Any))
+  (do macro.Monad
+    [_ //.init-module-buffer
+     _ (//.save runtime)]
+    (//.save-module! artifact)))
diff --git a/lux-r/source/luxc/lang/translation/r/statement.jvm.lux b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
new file mode 100644
index 000000000..1798cb56d
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
@@ -0,0 +1,45 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       [macro]
+       (data text/format))
+  (luxc (lang [".L" module]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" runtime]
+      [".T" reference]
+      [".T" eval]))
+
+(def: #export (translate-def name expressionT expressionO metaV)
+  (-> Text Type Expression Code (Meta Any))
+  (do {@ macro.Monad}
+    [current-module macro.current-module-name
+     #let [def-name [current-module name]]]
+    (case (macro.get-identifier-ann (name-of #.alias) metaV)
+      (#.Some real-def)
+      (do @
+        [[realT realA realV] (macro.find-def real-def)
+         _ (moduleL.define def-name [realT metaV realV])]
+        (wrap []))
+
+      _
+      (do @
+        [#let [def-name (referenceT.global def-name)]
+         _ (//.save (r.set! def-name expressionO))
+         expressionV (evalT.eval (@@ def-name))
+         _ (moduleL.define def-name [expressionT metaV expressionV])
+         _ (if (macro.type? metaV)
+             (case (macro.declared-tags metaV)
+               #.Nil
+               (wrap [])
+
+               tags
+               (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV)))
+             (wrap []))
+         #let [_ (log! (format "DEF " (%name def-name)))]]
+        (wrap []))
+      )))
+
+(def: #export (translate-program programO)
+  (-> Expression (Meta Expression))
+  (macro.fail "translate-program NOT IMPLEMENTED YET"))
diff --git a/lux-r/source/luxc/lang/translation/r/structure.jvm.lux b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
new file mode 100644
index 000000000..cea8fcd59
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
@@ -0,0 +1,31 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format)
+       [macro])
+  (luxc ["&" lang]
+        (lang [synthesis #+ Synthesis]
+              (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]))
+
+(def: #export (translate-tuple translate elemsS+)
+  (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression))
+  (case elemsS+
+    #.Nil
+    (:: macro.Monad wrap runtimeT.unit)
+
+    (#.Cons singletonS #.Nil)
+    (translate singletonS)
+
+    _
+    (do {@ macro.Monad}
+      [elemsT+ (monad.map @ translate elemsS+)]
+      (wrap (r.list elemsT+)))))
+
+(def: #export (translate-variant translate tag tail? valueS)
+  (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression))
+  (do macro.Monad
+    [valueT (translate valueS)]
+    (wrap (runtimeT.variant tag tail? valueT))))
diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux
new file mode 100644
index 000000000..e2cf047e9
--- /dev/null
+++ b/lux-r/source/program.lux
@@ -0,0 +1,180 @@
+(.module:
+  [lux (#- Definition)
+   ["@" target]
+   ["." host (#+ import:)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    [parser
+     [cli (#+ program:)]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
+   [data
+    ["." product]
+    [text
+     ["%" format (#+ format)]]
+    [collection
+     [array (#+ Array)]
+     ["." dictionary]]]
+   [world
+    ["." file]]
+   [target
+    [jvm
+     [bytecode (#+ Bytecode)]]]
+   [tool
+    [compiler
+     [default
+      ["." platform (#+ Platform)]]
+     [language
+      [lux
+       [analysis
+        ["." macro (#+ Expander)]]
+       [phase
+        [extension (#+ Phase Bundle Operation Handler Extender)
+         ["." analysis #_
+          ["#" jvm]]
+         ["." generation #_
+          ["#" jvm]]
+         ## ["." directive #_
+         ##  ["#" jvm]]
+         ]
+        [generation
+         ["." jvm #_
+          ## ["." runtime (#+ Anchor Definition)]
+          ["." packager]
+          ## ["#/." host]
+          ]]]]]]]]
+  [program
+   ["/" compositor
+    ["/." cli]
+    ["/." static]]]
+  [luxc
+   [lang
+    [host
+     ["_" jvm]]
+    ["." directive #_
+     ["#" jvm]]
+    [translation
+     ["." jvm
+      ["." runtime]
+      ["." expression]
+      ["#/." program]
+      ["translation" extension]]]]])
+
+(import: #long java/lang/reflect/Method
+  (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
+
+(import: #long (java/lang/Class c)
+  (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method))
+
+(import: #long java/lang/Object
+  (getClass [] (java/lang/Class java/lang/Object)))
+
+(def: _object-class
+  (java/lang/Class java/lang/Object)
+  (host.class-for java/lang/Object))
+
+(def: _apply2-args
+  (Array (java/lang/Class java/lang/Object))
+  (|> (host.array (java/lang/Class java/lang/Object) 2)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)))
+
+(def: _apply4-args
+  (Array (java/lang/Class java/lang/Object))
+  (|> (host.array (java/lang/Class java/lang/Object) 4)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)
+      (host.array-write 2 _object-class)
+      (host.array-write 3 _object-class)))
+
+(def: #export (expander macro inputs lux)
+  Expander
+  (do try.monad
+    [apply-method (|> macro
+                      (:coerce java/lang/Object)
+                      (java/lang/Object::getClass)
+                      (java/lang/Class::getMethod "apply" _apply2-args))]
+    (:coerce (Try (Try [Lux (List Code)]))
+             (java/lang/reflect/Method::invoke
+              (:coerce java/lang/Object macro)
+              (|> (host.array java/lang/Object 2)
+                  (host.array-write 0 (:coerce java/lang/Object inputs))
+                  (host.array-write 1 (:coerce java/lang/Object lux)))
+              apply-method))))
+
+(def: #export platform
+  ## (IO (Platform Anchor (Bytecode Any) Definition))
+  (IO (Platform _.Anchor _.Inst _.Definition))
+  (do io.monad
+    [## host jvm/host.host
+     host jvm.host]
+    (wrap {#platform.&file-system (file.async file.system)
+           #platform.host host
+           ## #platform.phase jvm.generate
+           #platform.phase expression.translate
+           ## #platform.runtime runtime.generate
+           #platform.runtime runtime.translate
+           #platform.write product.right})))
+
+(def: extender
+  Extender
+  ## TODO: Stop relying on coercions ASAP.
+  (<| (:coerce Extender)
+      (function (@self handler))
+      (:coerce Handler)
+      (function (@self name phase))
+      (:coerce Phase)
+      (function (@self parameters))
+      (:coerce Operation)
+      (function (@self state))
+      (:coerce Try)
+      try.assume
+      (:coerce Try)
+      (do try.monad
+        [method (|> handler
+                    (:coerce java/lang/Object)
+                    (java/lang/Object::getClass)
+                    (java/lang/Class::getMethod "apply" _apply4-args))]
+        (java/lang/reflect/Method::invoke
+         (:coerce java/lang/Object handler)
+         (|> (host.array java/lang/Object 4)
+             (host.array-write 0 (:coerce java/lang/Object name))
+             (host.array-write 1 (:coerce java/lang/Object phase))
+             (host.array-write 2 (:coerce java/lang/Object parameters))
+             (host.array-write 3 (:coerce java/lang/Object state)))
+         method))))
+
+(def: (target service)
+  (-> /cli.Service /cli.Target)
+  (case service
+    (^or (#/cli.Compilation [sources libraries target module])
+         (#/cli.Interpretation [sources libraries target module])
+         (#/cli.Export [sources target]))
+    target))
+
+(def: (declare-success! _)
+  (-> Any (Promise Any))
+  (promise.future (io.exit +0)))
+
+(program: [{service /cli.service}]
+  (let [jar-path (format (..target service) (:: file.system separator) "program.jar")]
+    (exec (do promise.monad
+            [_ (/.compiler {#/static.host @.jvm
+                            #/static.host-module-extension ".jvm"
+                            #/static.target (..target service)
+                            #/static.artifact-extension ".class"}
+                           ..expander
+                           analysis.bundle
+                           ..platform
+                           ## generation.bundle
+                           translation.bundle
+                           (directive.bundle ..extender)
+                           jvm/program.program
+                           ..extender
+                           service
+                           [(packager.package jvm/program.class) jar-path])]
+            (..declare-success! []))
+      (io.io []))))
diff --git a/lux-r/source/test/program.lux b/lux-r/source/test/program.lux
new file mode 100644
index 000000000..270f9005d
--- /dev/null
+++ b/lux-r/source/test/program.lux
@@ -0,0 +1,18 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [control
+    ["." io]
+    [parser
+     [cli (#+ program:)]]]]
+  [spec
+   ["." compositor]]
+  {1
+   ["." /]})
+
+(program: args
+  (<| io.io
+      _.run!
+      ## (_.times 100)
+      (_.seed 1985013625126912890)
+      (compositor.spec /.jvm /.bundle /.expander /.program)))
diff --git a/new-luxc/project.clj b/new-luxc/project.clj
deleted file mode 100644
index 90ddecf12..000000000
--- a/new-luxc/project.clj
+++ /dev/null
@@ -1,34 +0,0 @@
-(def version "0.6.0-SNAPSHOT")
-(def repo "https://github.com/LuxLang/lux")
-(def sonatype "https://oss.sonatype.org")
-(def sonatype-releases (str sonatype "/service/local/staging/deploy/maven2/"))
-(def sonatype-snapshots (str sonatype "/content/repositories/snapshots/"))
-
-(defproject com.github.luxlang/new-luxc #=(identity version)
-  :description "A re-written compiler for Lux."
-  :url ~repo
-  :license {:name "Lux License v0.1"
-            :url ~(str repo "/blob/master/license.txt")}
-  :plugins [[com.github.luxlang/lein-luxc ~version]]
-  :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}]
-                        ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]]
-  :pom-addition [:developers [:developer
-                              [:name "Eduardo Julian"]
-                              [:url "https://github.com/eduardoejp"]]]
-  :repositories [["releases" ~sonatype-releases]
-                 ["snapshots" ~sonatype-snapshots]
-                 ["bedatadriven" "https://nexus.bedatadriven.com/content/groups/public/"]
-                 ["jitpack" "https://jitpack.io"]]
-  :scm {:name "git"
-        :url ~(str repo ".git")}
-
-  :dependencies [[com.github.luxlang/luxc-jvm ~version]
-                 [com.github.luxlang/stdlib ~version]
-                 ;; JVM Bytecode
-                 [org.ow2.asm/asm-all "5.0.3"]]
-  
-  :manifest {"lux" ~version}
-  :source-paths ["source"]
-  :lux {:program "program"
-        :test "test/program"}
-  )
diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux
deleted file mode 100644
index 27b1c8688..000000000
--- a/new-luxc/source/luxc/lang/directive/jvm.lux
+++ /dev/null
@@ -1,538 +0,0 @@
-(.module:
-  [lux #*
-   [host (#+ import:)]
-   [type (#+ :share)]
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try (#+ Try)]]
-   [target
-    ["/" jvm]]
-   [data
-    [identity (#+ Identity)]
-    ["." product]
-    [number
-     ["." nat]]
-    [text
-     ["%" format (#+ format)]]
-    [collection
-     ["." list ("#@." fold)]
-     ["." dictionary (#+ Dictionary)]
-     ["." row (#+ Row) ("#@." functor fold)]]]
-   [tool
-    [compiler
-     ["." phase]
-     [language
-      [lux
-       [synthesis (#+ Synthesis)]
-       ["." generation]
-       ["." directive]
-       [phase
-        ["." extension
-         ["." bundle]
-         [directive
-          ["./" lux]]]]]]]]]
-  [///
-   [host
-    ["." jvm (#+ Inst)
-     ["_" inst]]]])
-
-(import: #long org/objectweb/asm/Label
-  (new []))
-
-(def: (literal literal)
-  (-> /.Literal Inst)
-  (case literal
-    (#/.Boolean value) (_.boolean value)
-    (#/.Int value) (_.int value)
-    (#/.Long value) (_.long value)
-    (#/.Double value) (_.double value)
-    (#/.Char value) (_.char value)
-    (#/.String value) (_.string value)))
-
-(def: (constant instruction)
-  (-> /.Constant Inst)
-  (case instruction
-    (#/.BIPUSH constant) (_.BIPUSH constant)
-    
-    (#/.SIPUSH constant) (_.SIPUSH constant)
-
-    #/.ICONST_M1 _.ICONST_M1
-    #/.ICONST_0 _.ICONST_0
-    #/.ICONST_1 _.ICONST_1
-    #/.ICONST_2 _.ICONST_2
-    #/.ICONST_3 _.ICONST_3
-    #/.ICONST_4 _.ICONST_4
-    #/.ICONST_5 _.ICONST_5
-
-    #/.LCONST_0 _.LCONST_0
-    #/.LCONST_1 _.LCONST_1
-    
-    #/.FCONST_0 _.FCONST_0
-    #/.FCONST_1 _.FCONST_1
-    #/.FCONST_2 _.FCONST_2
-    
-    #/.DCONST_0 _.DCONST_0
-    #/.DCONST_1 _.DCONST_1
-    
-    #/.ACONST_NULL _.NULL
-
-    (#/.LDC literal)
-    (..literal literal)
-    ))
-
-(def: (int-arithmetic instruction)
-  (-> /.Int-Arithmetic Inst)
-  (case instruction
-    #/.IADD _.IADD
-    #/.ISUB _.ISUB
-    #/.IMUL _.IMUL
-    #/.IDIV _.IDIV
-    #/.IREM _.IREM
-    #/.INEG _.INEG))
-
-(def: (long-arithmetic instruction)
-  (-> /.Long-Arithmetic Inst)
-  (case instruction
-    #/.LADD _.LADD
-    #/.LSUB _.LSUB
-    #/.LMUL _.LMUL
-    #/.LDIV _.LDIV
-    #/.LREM _.LREM
-    #/.LNEG _.LNEG))
-
-(def: (float-arithmetic instruction)
-  (-> /.Float-Arithmetic Inst)
-  (case instruction
-    #/.FADD _.FADD
-    #/.FSUB _.FSUB
-    #/.FMUL _.FMUL
-    #/.FDIV _.FDIV
-    #/.FREM _.FREM
-    #/.FNEG _.FNEG))
-
-(def: (double-arithmetic instruction)
-  (-> /.Double-Arithmetic Inst)
-  (case instruction
-    #/.DADD _.DADD
-    #/.DSUB _.DSUB
-    #/.DMUL _.DMUL
-    #/.DDIV _.DDIV
-    #/.DREM _.DREM
-    #/.DNEG _.DNEG))
-
-(def: (arithmetic instruction)
-  (-> /.Arithmetic Inst)
-  (case instruction
-    (#/.Int-Arithmetic int-arithmetic)
-    (..int-arithmetic int-arithmetic)
-    
-    (#/.Long-Arithmetic long-arithmetic)
-    (..long-arithmetic long-arithmetic)
-    
-    (#/.Float-Arithmetic float-arithmetic)
-    (..float-arithmetic float-arithmetic)
-    
-    (#/.Double-Arithmetic double-arithmetic)
-    (..double-arithmetic double-arithmetic)))
-
-(def: (int-bitwise instruction)
-  (-> /.Int-Bitwise Inst)
-  (case instruction
-    #/.IOR _.IOR
-    #/.IXOR _.IXOR
-    #/.IAND _.IAND
-    #/.ISHL _.ISHL
-    #/.ISHR _.ISHR
-    #/.IUSHR _.IUSHR))
-
-(def: (long-bitwise instruction)
-  (-> /.Long-Bitwise Inst)
-  (case instruction
-    #/.LOR _.LOR
-    #/.LXOR _.LXOR
-    #/.LAND _.LAND
-    #/.LSHL _.LSHL
-    #/.LSHR _.LSHR
-    #/.LUSHR _.LUSHR))
-
-(def: (bitwise instruction)
-  (-> /.Bitwise Inst)
-  (case instruction
-    (#/.Int-Bitwise int-bitwise)
-    (..int-bitwise int-bitwise)
-    
-    (#/.Long-Bitwise long-bitwise)
-    (..long-bitwise long-bitwise)))
-
-(def: (conversion instruction)
-  (-> /.Conversion Inst)
-  (case instruction
-    #/.I2B _.I2B
-    #/.I2S _.I2S
-    #/.I2L _.I2L
-    #/.I2F _.I2F
-    #/.I2D _.I2D
-    #/.I2C _.I2C
-
-    #/.L2I _.L2I
-    #/.L2F _.L2F
-    #/.L2D _.L2D
-
-    #/.F2I _.F2I
-    #/.F2L _.F2L
-    #/.F2D _.F2D
-    
-    #/.D2I _.D2I
-    #/.D2L _.D2L
-    #/.D2F _.D2F))
-
-(def: (array instruction)
-  (-> /.Array Inst)
-  (case instruction
-    #/.ARRAYLENGTH _.ARRAYLENGTH
-
-    (#/.NEWARRAY type) (_.NEWARRAY type)
-    (#/.ANEWARRAY type) (_.ANEWARRAY type)
-
-    #/.BALOAD _.BALOAD
-    #/.BASTORE _.BASTORE
-
-    #/.SALOAD _.SALOAD
-    #/.SASTORE _.SASTORE
-
-    #/.IALOAD _.IALOAD
-    #/.IASTORE _.IASTORE
-
-    #/.LALOAD _.LALOAD
-    #/.LASTORE _.LASTORE
-
-    #/.FALOAD _.FALOAD
-    #/.FASTORE _.FASTORE
-
-    #/.DALOAD _.DALOAD
-    #/.DASTORE _.DASTORE
-    
-    #/.CALOAD _.CALOAD
-    #/.CASTORE _.CASTORE
-
-    #/.AALOAD _.AALOAD
-    #/.AASTORE _.AASTORE))
-
-(def: (object instruction)
-  (-> /.Object Inst)
-  (case instruction
-    (^template [ ]
-      ( class field-name field-type)
-      ( class field-name field-type))
-    ([#/.GETSTATIC _.GETSTATIC]
-     [#/.PUTSTATIC _.PUTSTATIC]
-     [#/.GETFIELD _.GETFIELD]
-     [#/.PUTFIELD _.PUTFIELD])
-    
-    (#/.NEW type) (_.NEW type)
-    
-    (#/.INSTANCEOF type) (_.INSTANCEOF type)
-    (#/.CHECKCAST type) (_.CHECKCAST type)
-
-    (^template [ ]
-      ( class method-name method-type)
-      ( class method-name method-type))
-    ([#/.INVOKEINTERFACE _.INVOKEINTERFACE]
-     [#/.INVOKESPECIAL _.INVOKESPECIAL]
-     [#/.INVOKESTATIC _.INVOKESTATIC]
-     [#/.INVOKEVIRTUAL _.INVOKEVIRTUAL])
-    ))
-
-(def: (local-int instruction)
-  (-> /.Local-Int Inst)
-  (case instruction
-    (#/.ILOAD register) (_.ILOAD register)
-    (#/.ISTORE register) (_.ISTORE register)))
-
-(def: (local-long instruction)
-  (-> /.Local-Long Inst)
-  (case instruction
-    (#/.LLOAD register) (_.LLOAD register)
-    (#/.LSTORE register) (_.LSTORE register)))
-
-(def: (local-float instruction)
-  (-> /.Local-Float Inst)
-  (case instruction
-    (#/.FLOAD register) (_.FLOAD register)
-    (#/.FSTORE register) (_.FSTORE register)))
-
-(def: (local-double instruction)
-  (-> /.Local-Double Inst)
-  (case instruction
-    (#/.DLOAD register) (_.DLOAD register)
-    (#/.DSTORE register) (_.DSTORE register)))
-
-(def: (local-object instruction)
-  (-> /.Local-Object Inst)
-  (case instruction
-    (#/.ALOAD register) (_.ALOAD register)
-    (#/.ASTORE register) (_.ASTORE register)))
-
-(def: (local instruction)
-  (-> /.Local Inst)
-  (case instruction
-    (#/.Local-Int instruction) (..local-int instruction)
-    (#/.IINC register) (_.IINC register)
-    (#/.Local-Long instruction) (..local-long instruction)
-    (#/.Local-Float instruction) (..local-float instruction)
-    (#/.Local-Double instruction) (..local-double instruction)
-    (#/.Local-Object instruction) (..local-object instruction)))
-
-(def: (stack instruction)
-  (-> /.Stack Inst)
-  (case instruction
-    #/.DUP _.DUP
-    #/.DUP_X1 _.DUP_X1
-    #/.DUP_X2 _.DUP_X2
-    #/.DUP2 _.DUP2
-    #/.DUP2_X1 _.DUP2_X1
-    #/.DUP2_X2 _.DUP2_X2
-    #/.SWAP _.SWAP
-    #/.POP _.POP
-    #/.POP2 _.POP2))
-
-(def: (comparison instruction)
-  (-> /.Comparison Inst)
-  (case instruction
-    #/.LCMP _.LCMP
-    
-    #/.FCMPG _.FCMPG
-    #/.FCMPL _.FCMPL
-
-    #/.DCMPG _.DCMPG
-    #/.DCMPL _.DCMPL))
-
-(def: (branching instruction)
-  (-> (/.Branching org/objectweb/asm/Label) Inst)
-  (case instruction
-    (#/.IF_ICMPEQ label) (_.IF_ICMPEQ label)
-    (#/.IF_ICMPGE label) (_.IF_ICMPGE label)
-    (#/.IF_ICMPGT label) (_.IF_ICMPGT label)
-    (#/.IF_ICMPLE label) (_.IF_ICMPLE label)
-    (#/.IF_ICMPLT label) (_.IF_ICMPLT label)
-    (#/.IF_ICMPNE label) (_.IF_ICMPNE label)
-    (#/.IFEQ label) (_.IFEQ label)
-    (#/.IFGE label) (_.IFGE label)
-    (#/.IFGT label) (_.IFGT label)
-    (#/.IFLE label) (_.IFLE label)
-    (#/.IFLT label) (_.IFLT label)
-    (#/.IFNE label) (_.IFNE label)
-
-    (#/.TABLESWITCH min max default labels)
-    (_.TABLESWITCH min max default labels)
-    
-    (#/.LOOKUPSWITCH default keys+labels)
-    (_.LOOKUPSWITCH default keys+labels)
-
-    (#/.IF_ACMPEQ label) (_.IF_ACMPEQ label)
-    (#/.IF_ACMPNE label) (_.IF_ACMPNE label)
-    (#/.IFNONNULL label) (_.IFNONNULL label)
-    (#/.IFNULL label) (_.IFNULL label)))
-
-(def: (exception instruction)
-  (-> (/.Exception org/objectweb/asm/Label) Inst)
-  (case instruction
-    (#/.Try start end handler exception) (_.try start end handler exception)
-    #/.ATHROW _.ATHROW))
-
-(def: (concurrency instruction)
-  (-> /.Concurrency Inst)
-  (case instruction
-    #/.MONITORENTER _.MONITORENTER
-    #/.MONITOREXIT _.MONITOREXIT))
-
-(def: (return instruction)
-  (-> /.Return Inst)
-  (case instruction
-    #/.RETURN _.RETURN
-    #/.IRETURN _.IRETURN
-    #/.LRETURN _.LRETURN
-    #/.FRETURN _.FRETURN
-    #/.DRETURN _.DRETURN
-    #/.ARETURN _.ARETURN))
-
-(def: (control instruction)
-  (-> (/.Control org/objectweb/asm/Label) Inst)
-  (case instruction
-    (#/.GOTO label) (_.GOTO label)
-    (#/.Branching instruction) (..branching instruction)
-    (#/.Exception instruction) (..exception instruction)
-    (#/.Concurrency instruction) (..concurrency instruction)
-    (#/.Return instruction) (..return instruction)))
-
-(def: (instruction instruction)
-  (-> (/.Instruction org/objectweb/asm/Label) Inst)
-  (case instruction
-    #/.NOP _.NOP
-    (#/.Constant instruction) (..constant instruction)
-    (#/.Arithmetic instruction) (..arithmetic instruction)
-    (#/.Bitwise instruction) (..bitwise instruction)
-    (#/.Conversion instruction) (..conversion instruction)
-    (#/.Array instruction) (..array instruction)
-    (#/.Object instruction) (..object instruction)
-    (#/.Local instruction) (..local instruction)
-    (#/.Stack instruction) (..stack instruction)
-    (#/.Comparison instruction) (..comparison instruction)
-    (#/.Control instruction) (..control instruction)))
-
-(type: Mapping
-  (Dictionary /.Label org/objectweb/asm/Label))
-
-(type: (Re-labeler context)
-  (-> [Mapping (context /.Label)]
-      [Mapping (context org/objectweb/asm/Label)]))
-
-(def: (relabel [mapping label])
-  (Re-labeler Identity)
-  (case (dictionary.get label mapping)
-    (#.Some label)
-    [mapping label]
-
-    #.None
-    (let [label' (org/objectweb/asm/Label::new)]
-      [(dictionary.put label label' mapping) label'])))
-
-(def: (relabel-branching [mapping instruction])
-  (Re-labeler /.Branching)
-  (case instruction
-    (^template []
-      ( label)
-      (let [[mapping label] (..relabel [mapping label])]
-        [mapping ( label)]))
-    ([#/.IF_ICMPEQ] [#/.IF_ICMPGE] [#/.IF_ICMPGT] [#/.IF_ICMPLE] [#/.IF_ICMPLT] [#/.IF_ICMPNE]
-     [#/.IFEQ] [#/.IFNE] [#/.IFGE] [#/.IFGT] [#/.IFLE] [#/.IFLT]
-
-     [#/.IF_ACMPEQ] [#/.IF_ACMPNE] [#/.IFNONNULL] [#/.IFNULL])
-
-    (#/.TABLESWITCH min max default labels)
-    (let [[mapping default] (..relabel [mapping default])
-          [mapping labels] (list@fold (function (_ input [mapping output])
-                                        (let [[mapping input] (..relabel [mapping input])]
-                                          [mapping (list& input output)]))
-                                      [mapping (list)] labels)]
-      [mapping (#/.TABLESWITCH min max default (list.reverse labels))])
-    
-    (#/.LOOKUPSWITCH default keys+labels)
-    (let [[mapping default] (..relabel [mapping default])
-          [mapping keys+labels] (list@fold (function (_ [expected input] [mapping output])
-                                             (let [[mapping input] (..relabel [mapping input])]
-                                               [mapping (list& [expected input] output)]))
-                                           [mapping (list)] keys+labels)]
-      [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))])
-    ))
-
-(def: (relabel-exception [mapping instruction])
-  (Re-labeler /.Exception)
-  (case instruction
-    (#/.Try start end handler exception)
-    (let [[mapping start] (..relabel [mapping start])
-          [mapping end] (..relabel [mapping end])
-          [mapping handler] (..relabel [mapping handler])]
-      [mapping (#/.Try start end handler exception)])
-    
-    #/.ATHROW
-    [mapping #/.ATHROW]
-    ))
-
-(def: (relabel-control [mapping instruction])
-  (Re-labeler /.Control)
-  (case instruction
-    (^template [ ]
-      ( instruction)
-      (let [[mapping instruction] ( [mapping instruction])]
-        [mapping ( instruction)]))
-    ([#/.GOTO ..relabel]
-     [#/.Branching ..relabel-branching]
-     [#/.Exception ..relabel-exception])
-
-    (^template []
-      ( instruction)
-      [mapping ( instruction)])
-    ([#/.Concurrency] [#/.Return])
-    ))
-
-(def: (relabel-instruction [mapping instruction])
-  (Re-labeler /.Instruction)
-  (case instruction
-    #/.NOP [mapping #/.NOP]
-
-    (^template []
-      ( instruction)
-      [mapping ( instruction)])
-    ([#/.Constant]
-     [#/.Arithmetic]
-     [#/.Bitwise]
-     [#/.Conversion]
-     [#/.Array]
-     [#/.Object]
-     [#/.Local]
-     [#/.Stack]
-     [#/.Comparison])
-    
-    (#/.Control instruction)
-    (let [[mapping instruction] (..relabel-control [mapping instruction])]
-      [mapping (#/.Control instruction)])))
-
-(def: (relabel-bytecode [mapping bytecode])
-  (Re-labeler /.Bytecode)
-  (row@fold (function (_ input [mapping output])
-              (let [[mapping input] (..relabel-instruction [mapping input])]
-                [mapping (row.add input output)]))
-            [mapping (row.row)]
-            bytecode))
-
-(def: fresh
-  Mapping
-  (dictionary.new nat.hash))
-
-(def: bytecode
-  (-> (/.Bytecode /.Label) Inst)
-  (|>> [..fresh]
-       ..relabel-bytecode
-       product.right
-       (row@map ..instruction)
-       row.to-list
-       _.fuse))
-
-(type: Pseudo-Handler
-  (-> Text (List Synthesis) (Try (/.Bytecode /.Label))))
-
-(def: (true-handler pseudo)
-  (-> Pseudo-Handler jvm.Handler)
-  (function (_ extension-name phase archive inputs)
-    (|> (pseudo extension-name inputs)
-        (:: try.monad map ..bytecode)
-        phase.lift)))
-
-(def: (def::generation extender)
-  (-> jvm.Extender
-      (directive.Handler jvm.Anchor jvm.Inst jvm.Definition))
-  (function (handler extension-name phase archive inputsC+)
-    (case inputsC+
-      (^ (list nameC valueC))
-      (do phase.monad
-        [[_ _ name] (lux/.evaluate! archive Text nameC)
-         [_ _ pseudo-handlerV] (lux/.evaluate! archive ..Pseudo-Handler valueC)
-         _ (|> pseudo-handlerV
-               (:coerce ..Pseudo-Handler)
-               ..true-handler
-               (extension.install extender (:coerce Text name))
-               directive.lift-generation)
-         _ (directive.lift-generation
-            (generation.log! (format "Generation " (%.text (:coerce Text name)))))]
-        (wrap directive.no-requirements))
-
-      _
-      (phase.throw extension.invalid-syntax [extension-name %.code inputsC+]))))
-
-(def: #export (bundle extender)
-  (-> jvm.Extender
-      (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition))
-  (|> bundle.empty
-      (dictionary.put "lux def generation" (..def::generation extender))))
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
deleted file mode 100644
index d957bdb1d..000000000
--- a/new-luxc/source/luxc/lang/host/jvm.lux
+++ /dev/null
@@ -1,131 +0,0 @@
-(.module:
-  [lux (#- Definition Type)
-   [host (#+ import:)]
-   [abstract
-    monad]
-   [control
-    ["p" parser
-     ["s" code]]]
-   [data
-    [binary (#+ Binary)]
-    [collection
-     ["." list ("#/." functor)]]]
-   [macro
-    ["." code]
-    [syntax (#+ syntax:)]]
-   [target
-    [jvm
-     ["." type (#+ Type)
-      [category (#+ Class)]]]]
-   [tool
-    [compiler
-     [reference (#+ Register)]
-     [language
-      [lux
-       ["." generation]]]
-     [meta
-      [archive (#+ Archive)]]]]])
-
-(import: org/objectweb/asm/MethodVisitor)
-
-(import: org/objectweb/asm/ClassWriter)
-
-(import: #long org/objectweb/asm/Label
-  (new []))
-
-(type: #export Def
-  (-> ClassWriter ClassWriter))
-
-(type: #export Inst
-  (-> MethodVisitor MethodVisitor))
-
-(type: #export Label
-  org/objectweb/asm/Label)
-
-(type: #export Visibility
-  #Public
-  #Protected
-  #Private
-  #Default)
-
-(type: #export Version
-  #V1_1
-  #V1_2
-  #V1_3
-  #V1_4
-  #V1_5
-  #V1_6
-  #V1_7
-  #V1_8)
-
-(type: #export ByteCode Binary)
-
-(type: #export Definition [Text ByteCode])
-
-(type: #export Anchor [Label Register])
-
-(type: #export Host
-  (generation.Host Inst Definition))
-
-(template [ ]
-  [(type: #export 
-     ( ..Anchor Inst Definition))]
-
-  [State     generation.State]
-  [Operation generation.Operation]
-  [Phase     generation.Phase]
-  [Handler   generation.Handler]
-  [Bundle    generation.Bundle]
-  [Extender  generation.Extender]
-  )
-
-(type: #export (Generator i)
-  (-> Phase Archive i (Operation Inst)))
-
-(syntax: (config: {type s.local-identifier}
-           {none s.local-identifier}
-           {++ s.local-identifier}
-           {options (s.tuple (p.many s.local-identifier))})
-  (let [g!type (code.local-identifier type)
-        g!none (code.local-identifier none)
-        g!tags+ (list/map code.local-tag options)
-        g!_left (code.local-identifier "_left")
-        g!_right (code.local-identifier "_right")
-        g!options+ (list/map (function (_ option)
-                               (` (def: (~' #export) (~ (code.local-identifier option))
-                                    (~ g!type)
-                                    (|> (~ g!none)
-                                        (set@ (~ (code.local-tag option)) #1)))))
-                             options)]
-    (wrap (list& (` (type: (~' #export) (~ g!type)
-                      (~ (code.record (list/map (function (_ tag)
-                                                  [tag (` .Bit)])
-                                                g!tags+)))))
-
-                 (` (def: (~' #export) (~ g!none)
-                      (~ g!type)
-                      (~ (code.record (list/map (function (_ tag)
-                                                  [tag (` #0)])
-                                                g!tags+)))))
-
-                 (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right))
-                      (-> (~ g!type) (~ g!type) (~ g!type))
-                      (~ (code.record (list/map (function (_ tag)
-                                                  [tag (` (or (get@ (~ tag) (~ g!_left))
-                                                              (get@ (~ tag) (~ g!_right))))])
-                                                g!tags+)))))
-
-                 g!options+))))
-
-(config: Class-Config  noneC ++C [finalC])
-(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
-(config: Field-Config  noneF ++F [finalF staticF transientF volatileF])
-
-(def: #export new-label
-  (-> Any Label)
-  (function (_ _)
-    (org/objectweb/asm/Label::new)))
-
-(def: #export (simple-class name)
-  (-> Text (Type Class))
-  (type.class name (list)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
deleted file mode 100644
index f274da61f..000000000
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ /dev/null
@@ -1,298 +0,0 @@
-(.module:
-  [lux (#- Type)
-   ["." host (#+ import: do-to)]
-   [control
-    ["." function]]
-   [data
-    ["." product]
-    [number
-     ["i" int]]
-    ["." text
-     ["%" format (#+ format)]]
-    [collection
-     ["." array (#+ Array)]
-     ["." list ("#@." functor)]]]
-   [target
-    [jvm
-     [encoding
-      ["." name]]
-     ["." type (#+ Type Constraint)
-      [category (#+ Class Value Method)]
-      ["." signature]
-      ["." descriptor]]]]]
-  ["." //])
-
-(def: signature (|>> type.signature signature.signature))
-(def: descriptor (|>> type.descriptor descriptor.descriptor))
-(def: class-name (|>> type.descriptor descriptor.class-name name.read))
-
-(import: #long java/lang/Object)
-(import: #long java/lang/String)
-
-(import: org/objectweb/asm/Opcodes
-  (#static ACC_PUBLIC int)
-  (#static ACC_PROTECTED int)
-  (#static ACC_PRIVATE int)
-
-  (#static ACC_TRANSIENT int)
-  (#static ACC_VOLATILE int)
-
-  (#static ACC_ABSTRACT int)
-  (#static ACC_FINAL int)
-  (#static ACC_STATIC int)
-  (#static ACC_SYNCHRONIZED int)
-  (#static ACC_STRICT int)
-
-  (#static ACC_SUPER int)
-  (#static ACC_INTERFACE int)
-
-  (#static V1_1 int)
-  (#static V1_2 int)
-  (#static V1_3 int)
-  (#static V1_4 int)
-  (#static V1_5 int)
-  (#static V1_6 int)
-  (#static V1_7 int)
-  (#static V1_8 int)
-  )
-
-(import: org/objectweb/asm/FieldVisitor
-  (visitEnd [] void))
-
-(import: org/objectweb/asm/MethodVisitor
-  (visitCode [] void)
-  (visitMaxs [int int] void)
-  (visitEnd [] void))
-
-(import: org/objectweb/asm/ClassWriter
-  (#static COMPUTE_MAXS int)
-  (#static COMPUTE_FRAMES int)
-  (new [int])
-  (visit [int int String String String [String]] void)
-  (visitEnd [] void)
-  (visitField [int String String String Object] FieldVisitor)
-  (visitMethod [int String String String [String]] MethodVisitor)
-  (toByteArray [] [byte]))
-
-(def: (string-array values)
-  (-> (List Text) (Array Text))
-  (let [output (host.array String (list.size values))]
-    (exec (list@map (function (_ [idx value])
-                      (host.array-write idx value output))
-                    (list.enumerate values))
-      output)))
-
-(def: (version-flag version)
-  (-> //.Version Int)
-  (case version
-    #//.V1_1 (Opcodes::V1_1)
-    #//.V1_2 (Opcodes::V1_2)
-    #//.V1_3 (Opcodes::V1_3)
-    #//.V1_4 (Opcodes::V1_4)
-    #//.V1_5 (Opcodes::V1_5)
-    #//.V1_6 (Opcodes::V1_6)
-    #//.V1_7 (Opcodes::V1_7)
-    #//.V1_8 (Opcodes::V1_8)))
-
-(def: (visibility-flag visibility)
-  (-> //.Visibility Int)
-  (case visibility
-    #//.Public    (Opcodes::ACC_PUBLIC)
-    #//.Protected (Opcodes::ACC_PROTECTED)
-    #//.Private   (Opcodes::ACC_PRIVATE)
-    #//.Default   +0))
-
-(def: (class-flags config)
-  (-> //.Class-Config Int)
-  ($_ i.+
-      (if (get@ #//.finalC config) (Opcodes::ACC_FINAL) +0)))
-
-(def: (method-flags config)
-  (-> //.Method-Config Int)
-  ($_ i.+
-      (if (get@ #//.staticM config) (Opcodes::ACC_STATIC) +0)
-      (if (get@ #//.finalM config) (Opcodes::ACC_FINAL) +0)
-      (if (get@ #//.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0)
-      (if (get@ #//.strictM config) (Opcodes::ACC_STRICT) +0)))
-
-(def: (field-flags config)
-  (-> //.Field-Config Int)
-  ($_ i.+
-      (if (get@ #//.staticF config) (Opcodes::ACC_STATIC) +0)
-      (if (get@ #//.finalF config) (Opcodes::ACC_FINAL) +0)
-      (if (get@ #//.transientF config) (Opcodes::ACC_TRANSIENT) +0)
-      (if (get@ #//.volatileF config) (Opcodes::ACC_VOLATILE) +0)))
-
-(def: param-signature
-  (-> (Type Class) Text)
-  (|>> ..signature (format ":")))
-
-(def: (formal-param [name super interfaces])
-  (-> Constraint Text)
-  (format name
-          (param-signature super)
-          (|> interfaces
-              (list@map param-signature)
-              (text.join-with ""))))
-
-(def: (constraints-signature constraints super interfaces)
-  (-> (List Constraint) (Type Class) (List (Type Class))
-      Text)
-  (let [formal-params (if (list.empty? constraints)
-                        ""
-                        (format "<"
-                                (|> constraints
-                                    (list@map formal-param)
-                                    (text.join-with ""))
-                                ">"))]
-    (format formal-params
-            (..signature super)
-            (|> interfaces
-                (list@map ..signature)
-                (text.join-with "")))))
-
-(def: class-computes
-  Int
-  ($_ i.+
-      (ClassWriter::COMPUTE_MAXS)
-      ## (ClassWriter::COMPUTE_FRAMES)
-      ))
-
-(def: binary-name (|>> name.internal name.read))
-
-(template [ ]
-  [(def: #export ( version visibility config name constraints super interfaces
-                         definitions)
-     (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (Type Class) (List (Type Class)) //.Def
-         (host.type [byte]))
-     (let [writer (|> (do-to (ClassWriter::new class-computes)
-                        (ClassWriter::visit (version-flag version)
-                                            ($_ i.+
-                                                (Opcodes::ACC_SUPER)
-                                                
-                                                (visibility-flag visibility)
-                                                (class-flags config))
-                                            (..binary-name name)
-                                            (constraints-signature constraints super interfaces)
-                                            (..class-name super)
-                                            (|> interfaces
-                                                (list@map ..class-name)
-                                                string-array)))
-                      definitions)
-           _ (ClassWriter::visitEnd writer)]
-       (ClassWriter::toByteArray writer)))]
-
-  [class    +0]
-  [abstract (Opcodes::ACC_ABSTRACT)]
-  )
-
-(def: $Object
-  (Type Class)
-  (type.class "java.lang.Object" (list)))
-
-(def: #export (interface version visibility config name constraints interfaces
-                         definitions)
-  (-> //.Version //.Visibility //.Class-Config Text (List Constraint) (List (Type Class)) //.Def
-      (host.type [byte]))
-  (let [writer (|> (do-to (ClassWriter::new class-computes)
-                     (ClassWriter::visit (version-flag version)
-                                         ($_ i.+
-                                             (Opcodes::ACC_SUPER)
-                                             (Opcodes::ACC_INTERFACE)
-                                             (visibility-flag visibility)
-                                             (class-flags config))
-                                         (..binary-name name)
-                                         (constraints-signature constraints $Object interfaces)
-                                         (..class-name $Object)
-                                         (|> interfaces
-                                             (list@map ..class-name)
-                                             string-array)))
-                   definitions)
-        _ (ClassWriter::visitEnd writer)]
-    (ClassWriter::toByteArray writer)))
-
-(def: #export (method visibility config name type then)
-  (-> //.Visibility //.Method-Config Text (Type Method) //.Inst
-      //.Def)
-  (function (_ writer)
-    (let [=method (ClassWriter::visitMethod ($_ i.+
-                                                (visibility-flag visibility)
-                                                (method-flags config))
-                                            (..binary-name name)
-                                            (..descriptor type)
-                                            (..signature type)
-                                            (string-array (list))
-                                            writer)
-          _ (MethodVisitor::visitCode =method)
-          _ (then =method)
-          _ (MethodVisitor::visitMaxs +0 +0 =method)
-          _ (MethodVisitor::visitEnd =method)]
-      writer)))
-
-(def: #export (abstract-method visibility config name type)
-  (-> //.Visibility //.Method-Config Text (Type Method)
-      //.Def)
-  (function (_ writer)
-    (let [=method (ClassWriter::visitMethod ($_ i.+
-                                                (visibility-flag visibility)
-                                                (method-flags config)
-                                                (Opcodes::ACC_ABSTRACT))
-                                            (..binary-name name)
-                                            (..descriptor type)
-                                            (..signature type)
-                                            (string-array (list))
-                                            writer)
-          _ (MethodVisitor::visitEnd =method)]
-      writer)))
-
-(def: #export (field visibility config name type)
-  (-> //.Visibility //.Field-Config Text (Type Value) //.Def)
-  (function (_ writer)
-    (let [=field (do-to (ClassWriter::visitField ($_ i.+
-                                                     (visibility-flag visibility)
-                                                     (field-flags config))
-                                                 (..binary-name name)
-                                                 (..descriptor type)
-                                                 (..signature type)
-                                                 (host.null)
-                                                 writer)
-                   (FieldVisitor::visitEnd))]
-      writer)))
-
-(template [   ]
-  [(def: #export ( visibility config name value)
-     (-> //.Visibility //.Field-Config Text  //.Def)
-     (function (_ writer)
-       (let [=field (do-to (ClassWriter::visitField ($_ i.+
-                                                        (visibility-flag visibility)
-                                                        (field-flags config))
-                                                    (..binary-name name)
-                                                    (..descriptor )
-                                                    (..signature )
-                                                    ( value)
-                                                    writer)
-                      (FieldVisitor::visitEnd))]
-         writer)))]
-
-  [boolean-field Bit  type.boolean                           function.identity]
-  [byte-field    Int  type.byte                              host.long-to-byte]
-  [short-field   Int  type.short                             host.long-to-short]
-  [int-field     Int  type.int                               host.long-to-int]
-  [long-field    Int  type.long                              function.identity]
-  [float-field   Frac type.float                             host.double-to-float]
-  [double-field  Frac type.double                            function.identity]
-  [char-field    Nat  type.char                              (|>> .int host.long-to-int host.int-to-char)]
-  [string-field  Text (type.class "java.lang.String" (list)) function.identity]
-  )
-
-(def: #export (fuse defs)
-  (-> (List //.Def) //.Def)
-  (case defs
-    #.Nil
-    function.identity
-
-    (#.Cons singleton #.Nil)
-    singleton
-
-    (#.Cons head tail)
-    (function.compose (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
deleted file mode 100644
index b673c7d7e..000000000
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ /dev/null
@@ -1,464 +0,0 @@
-(.module:
-  [lux (#- Type int char)
-   ["." host (#+ import: do-to)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    ["." function]
-    ["." try]
-    ["p" parser
-     ["s" code]]]
-   [data
-    ["." product]
-    ["." maybe]
-    [number
-     ["n" nat]
-     ["i" int]]
-    [collection
-     ["." list ("#@." functor)]]]
-   [macro
-    ["." code]
-    ["." template]
-    [syntax (#+ syntax:)]]
-   [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))
-(def: descriptor (|>> type.descriptor descriptor.descriptor))
-(def: reflection (|>> type.reflection reflection.reflection))
-
-## [Host]
-(import: #long java/lang/Object)
-(import: #long java/lang/String)
-
-(syntax: (declare {codes (p.many s.local-identifier)})
-  (|> codes
-      (list@map (function (_ code) (` ((~' #static) (~ (code.local-identifier code)) (~' int)))))
-      wrap))
-
-(`` (import: #long org/objectweb/asm/Opcodes
-      (#static NOP int)
-
-      ## Conversion
-      (~~ (declare D2F D2I D2L
-                   F2D F2I F2L
-                   I2B I2C I2D I2F I2L I2S
-                   L2D L2F L2I))
-
-      ## Primitive
-      (~~ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
-                   T_BYTE T_SHORT T_INT T_LONG))
-
-      ## Class
-      (~~ (declare CHECKCAST NEW INSTANCEOF))
-      
-      ## Stack
-      (~~ (declare DUP DUP_X1 DUP_X2
-                   DUP2 DUP2_X1 DUP2_X2
-                   POP POP2
-                   SWAP))
-      
-      ## Jump
-      (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT
-                   IF_ICMPNE IF_ICMPGE IF_ICMPLE
-                   IF_ACMPEQ IF_ACMPNE IFNULL IFNONNULL
-                   IFEQ IFNE IFLT IFLE IFGT IFGE
-                   GOTO))
-
-      (~~ (declare BIPUSH SIPUSH))
-      (~~ (declare 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))
-      (#static ACONST_NULL int)
-      
-      ## Var
-      (~~ (declare IINC
-                   ILOAD LLOAD FLOAD DLOAD ALOAD
-                   ISTORE LSTORE FSTORE DSTORE ASTORE))
-      
-      ## Arithmetic
-      (~~ (declare IADD ISUB IMUL IDIV IREM INEG
-                   LADD LSUB LMUL LDIV LREM LNEG LCMP
-                   FADD FSUB FMUL FDIV FREM FNEG FCMPG FCMPL
-                   DADD DSUB DMUL DDIV DREM DNEG DCMPG DCMPL))
-      
-      ## Bit-wise
-      (~~ (declare IAND IOR IXOR ISHL ISHR IUSHR
-                   LAND LOR LXOR LSHL LSHR LUSHR))
-
-      ## Array
-      (~~ (declare ARRAYLENGTH NEWARRAY ANEWARRAY
-                   AALOAD AASTORE
-                   BALOAD BASTORE
-                   SALOAD SASTORE
-                   IALOAD IASTORE
-                   LALOAD LASTORE
-                   FALOAD FASTORE
-                   DALOAD DASTORE
-                   CALOAD CASTORE))
-      
-      ## Member
-      (~~ (declare GETSTATIC PUTSTATIC GETFIELD PUTFIELD
-                   INVOKESTATIC INVOKESPECIAL INVOKEVIRTUAL INVOKEINTERFACE))
-
-      (#static ATHROW int)
-
-      ## Concurrency
-      (~~ (declare MONITORENTER MONITOREXIT))
-      
-      ## Return
-      (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN))
-      ))
-
-(import: #long org/objectweb/asm/Label
-  (new []))
-
-(import: #long org/objectweb/asm/MethodVisitor
-  (visitCode [] void)
-  (visitMaxs [int int] void)
-  (visitEnd [] void)
-  (visitInsn [int] void)
-  (visitLdcInsn [java/lang/Object] void)
-  (visitFieldInsn [int java/lang/String java/lang/String java/lang/String] void)
-  (visitTypeInsn [int java/lang/String] void)
-  (visitVarInsn [int int] void)
-  (visitIntInsn [int int] void)
-  (visitMethodInsn [int java/lang/String java/lang/String java/lang/String boolean] void)
-  (visitLabel [org/objectweb/asm/Label] void)
-  (visitJumpInsn [int org/objectweb/asm/Label] void)
-  (visitTryCatchBlock [org/objectweb/asm/Label org/objectweb/asm/Label org/objectweb/asm/Label java/lang/String] void)
-  (visitLookupSwitchInsn [org/objectweb/asm/Label [int] [org/objectweb/asm/Label]] void)
-  (visitTableSwitchInsn [int int org/objectweb/asm/Label [org/objectweb/asm/Label]] void)
-  )
-
-## [Insts]
-(def: #export make-label
-  (All [s] (Operation s org/objectweb/asm/Label))
-  (function (_ state)
-    (#try.Success [state (org/objectweb/asm/Label::new)])))
-
-(def: #export (with-label action)
-  (All [a] (-> (-> org/objectweb/asm/Label a) a))
-  (action (org/objectweb/asm/Label::new)))
-
-(template [  ]
-  [(def: #export ( value)
-     (->  Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitLdcInsn ( value)))))]
-
-  [boolean Bit  function.identity]
-  [int     Int  host.long-to-int]
-  [long    Int  function.identity]
-  [double  Frac function.identity]
-  [char    Nat  (|>> .int host.long-to-int host.int-to-char)]
-  [string  Text function.identity]
-  )
-
-(template: (!prefix short)
-  (`` ((~~ (template.identifier ["org/objectweb/asm/Opcodes::" short])))))
-
-(template []
-  [(def: #export 
-     Inst
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))]
-
-  [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]
-  )
-
-(def: #export NULL
-  Inst
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitInsn (!prefix ACONST_NULL)))))
-
-(template []
-  [(def: #export ( constant)
-     (-> Int Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitIntInsn (!prefix ) constant))))]
-
-  [BIPUSH]
-  [SIPUSH]
-  )
-
-(template []
-  [(def: #export 
-     Inst
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitInsn (!prefix )))))]
-
-  [NOP]
-  
-  ## Stack
-  [DUP] [DUP_X1] [DUP_X2] [DUP2] [DUP2_X1] [DUP2_X2]
-  [POP] [POP2]
-  [SWAP]
-
-  ## Conversions
-  [D2F] [D2I] [D2L]
-  [F2D] [F2I] [F2L]
-  [I2B] [I2C] [I2D] [I2F] [I2L] [I2S]
-  [L2D] [L2F] [L2I]
-
-  ## Integer arithmetic
-  [IADD] [ISUB] [IMUL] [IDIV] [IREM] [INEG]
-
-  ## Integer bitwise
-  [IAND] [IOR] [IXOR] [ISHL] [ISHR] [IUSHR]
-  
-  ## Long arithmetic
-  [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LNEG]
-  [LCMP]
-
-  ## Long bitwise
-  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
-
-  ## Float arithmetic
-  [FADD] [FSUB] [FMUL] [FDIV] [FREM] [FNEG] [FCMPG] [FCMPL]
-
-  ## Double arithmetic
-  [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DNEG]
-  [DCMPG] [DCMPL]
-
-  ## Array
-  [ARRAYLENGTH]
-  [AALOAD] [AASTORE]
-  [BALOAD] [BASTORE]
-  [SALOAD] [SASTORE]
-  [IALOAD] [IASTORE]
-  [LALOAD] [LASTORE]
-  [FALOAD] [FASTORE]
-  [DALOAD] [DASTORE]
-  [CALOAD] [CASTORE]
-
-  ## Exceptions
-  [ATHROW]
-
-  ## Concurrency
-  [MONITORENTER] [MONITOREXIT]
-
-  ## Return
-  [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN]
-  )
-
-(type: #export Register Nat)
-
-(template []
-  [(def: #export ( register)
-     (-> Register Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitVarInsn (!prefix ) (.int register)))))]
-
-  [IINC]
-  [ILOAD] [LLOAD] [FLOAD] [DLOAD] [ALOAD]
-  [ISTORE] [LSTORE] [FSTORE] [DSTORE] [ASTORE]
-  )
-
-(template [ ]
-  [(def: #export ( class field type)
-     (-> (Type Class) Text (Type Value) Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitFieldInsn () (..class-name class) field (..descriptor type)))))]
-
-  [GETSTATIC org/objectweb/asm/Opcodes::GETSTATIC]
-  [PUTSTATIC org/objectweb/asm/Opcodes::PUTSTATIC]
-  
-  [PUTFIELD  org/objectweb/asm/Opcodes::PUTFIELD]
-  [GETFIELD  org/objectweb/asm/Opcodes::GETFIELD]
-  )
-
-(template [ +]
-  [(`` (template [ ]
-         [(def: #export ( class)
-            (-> (Type ) Inst)
-            (function (_ visitor)
-              (do-to visitor
-                (org/objectweb/asm/MethodVisitor::visitTypeInsn () (..class-name class)))))]
-
-         (~~ (template.splice +))))]
-
-  [Object
-   [[CHECKCAST  org/objectweb/asm/Opcodes::CHECKCAST]
-    [ANEWARRAY  org/objectweb/asm/Opcodes::ANEWARRAY]]]
-
-  [Class
-   [[NEW        org/objectweb/asm/Opcodes::NEW]
-    [INSTANCEOF org/objectweb/asm/Opcodes::INSTANCEOF]]]
-  )
-
-(def: #export (NEWARRAY type)
-  (-> (Type Primitive) Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitIntInsn (org/objectweb/asm/Opcodes::NEWARRAY)
-                                                     (`` (cond (~~ (template [ ]
-                                                                     [(type@=  type) ()]
-                                                                     
-                                                                     [type.boolean org/objectweb/asm/Opcodes::T_BOOLEAN]
-                                                                     [type.byte    org/objectweb/asm/Opcodes::T_BYTE]
-                                                                     [type.short   org/objectweb/asm/Opcodes::T_SHORT]
-                                                                     [type.int     org/objectweb/asm/Opcodes::T_INT]
-                                                                     [type.long    org/objectweb/asm/Opcodes::T_LONG]
-                                                                     [type.float   org/objectweb/asm/Opcodes::T_FLOAT]
-                                                                     [type.double  org/objectweb/asm/Opcodes::T_DOUBLE]
-                                                                     [type.char    org/objectweb/asm/Opcodes::T_CHAR]))
-                                                               ## else
-                                                               (undefined)))))))
-
-(template [  ]
-  [(def: #export ( class method-name method)
-     (-> (Type Class) Text (Type Method) Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitMethodInsn ()
-                                                           (..class-name class)
-                                                           method-name
-                                                           (|> method type.descriptor descriptor.descriptor)
-                                                           ))))]
-
-  [INVOKESTATIC    org/objectweb/asm/Opcodes::INVOKESTATIC false]
-  [INVOKEVIRTUAL   org/objectweb/asm/Opcodes::INVOKEVIRTUAL false]
-  [INVOKESPECIAL   org/objectweb/asm/Opcodes::INVOKESPECIAL false]
-  [INVOKEINTERFACE org/objectweb/asm/Opcodes::INVOKEINTERFACE true]
-  )
-
-(template []
-  [(def: #export ( @where)
-     (-> //.Label Inst)
-     (function (_ visitor)
-       (do-to visitor
-         (org/objectweb/asm/MethodVisitor::visitJumpInsn (!prefix ) @where))))]
-
-  [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
-  [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
-  [IF_ACMPEQ] [IF_ACMPNE] [IFNULL] [IFNONNULL]
-  [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
-  [GOTO]
-  )
-
-(def: #export (LOOKUPSWITCH default keys+labels)
-  (-> //.Label (List [Int //.Label]) Inst)
-  (function (_ visitor)
-    (let [keys+labels (list.sort (function (_ left right)
-                                   (i.< (product.left left) (product.left right)))
-                                 keys+labels)
-          array-size (list.size keys+labels)
-          keys-array (host.array int array-size)
-          labels-array (host.array org/objectweb/asm/Label array-size)
-          _ (loop [idx 0]
-              (if (n.< array-size idx)
-                (let [[key label] (maybe.assume (list.nth idx keys+labels))]
-                  (exec
-                    (host.array-write idx (host.long-to-int key) keys-array)
-                    (host.array-write idx label labels-array)
-                    (recur (inc idx))))
-                []))]
-      (do-to visitor
-        (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys-array labels-array)))))
-
-(def: #export (TABLESWITCH min max default labels)
-  (-> Int Int //.Label (List //.Label) Inst)
-  (function (_ visitor)
-    (let [num-labels (list.size labels)
-          labels-array (host.array org/objectweb/asm/Label num-labels)
-          _ (loop [idx 0]
-              (if (n.< num-labels idx)
-                (exec (host.array-write idx
-                                        (maybe.assume (list.nth idx labels))
-                                        labels-array)
-                  (recur (inc idx)))
-                []))]
-      (do-to visitor
-        (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels-array)))))
-
-(def: #export (try @from @to @handler exception)
-  (-> //.Label //.Label //.Label (Type Class) Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitTryCatchBlock @from @to @handler (..class-name exception)))))
-
-(def: #export (label @label)
-  (-> //.Label Inst)
-  (function (_ visitor)
-    (do-to visitor
-      (org/objectweb/asm/MethodVisitor::visitLabel @label))))
-
-(def: #export (array elementT)
-  (-> (Type Value) Inst)
-  (case (type.primitive? elementT)
-    (#.Left elementT)
-    (ANEWARRAY elementT)
-
-    (#.Right elementT)
-    (NEWARRAY elementT)))
-
-(template [        ]
-  [(def: ( type)
-     (-> (Type Primitive) Text)
-     (`` (cond (~~ (template [ ]
-                     [(type@=  type) ]
-                     
-                     [type.boolean ]
-                     [type.byte    ]
-                     [type.short   ]
-                     [type.int     ]
-                     [type.long    ]
-                     [type.float   ]
-                     [type.double  ]
-                     [type.char    ]))
-               ## else
-               (undefined))))]
-
-  [primitive-wrapper
-   box.boolean box.byte box.short box.int
-   box.long box.float box.double box.char]
-  [primitive-unwrap
-   "booleanValue" "byteValue" "shortValue" "intValue"
-   "longValue" "floatValue" "doubleValue" "charValue"]
-  )
-
-(def: #export (wrap type)
-  (-> (Type Primitive) Inst)
-  (let [wrapper (type.class (primitive-wrapper type) (list))]
-    (INVOKESTATIC wrapper "valueOf" (type.method [(list type) wrapper (list)]))))
-
-(def: #export (unwrap type)
-  (-> (Type Primitive) Inst)
-  (let [wrapper (type.class (primitive-wrapper type) (list))]
-    (|>> (CHECKCAST wrapper)
-         (INVOKEVIRTUAL wrapper (primitive-unwrap type) (type.method [(list) type (list)])))))
-
-(def: #export (fuse insts)
-  (-> (List Inst) Inst)
-  (case insts
-    #.Nil
-    function.identity
-
-    (#.Cons singleton #.Nil)
-    singleton
-
-    (#.Cons head tail)
-    (function.compose (fuse tail) head)))
diff --git a/new-luxc/source/luxc/lang/host/r.lux b/new-luxc/source/luxc/lang/host/r.lux
deleted file mode 100644
index 6e4c7fb5b..000000000
--- a/new-luxc/source/luxc/lang/host/r.lux
+++ /dev/null
@@ -1,299 +0,0 @@
-(.module:
-  [lux #- not or and list if function cond when]
-  (lux (control pipe)
-       (data [maybe "maybe/" Functor]
-             [text]
-             text/format
-             [number]
-             (coll [list "list/" Functor Fold]))
-       (type abstract)))
-
-(abstract: #export Single {} Any)
-(abstract: #export Poly {} Any)
-
-(abstract: #export (Var kind)
-  {}
-
-  Text
-
-  (def: name (All [k] (-> (Var k) Text)) (|>> :representation))
-
-  (def: #export var (-> Text (Var Single)) (|>> :abstraction))
-  (def: #export var-args (Var Poly) (:abstraction "..."))
-  )
-
-(type: #export SVar (Var Single))
-(type: #export PVar (Var Poly))
-
-(abstract: #export Expression
-  {}
-  
-  Text
-
-  (def: #export expression (-> Expression Text) (|>> :representation))
-
-  (def: #export code (-> Text Expression) (|>> :abstraction))
-
-  (def: (self-contained code)
-    (-> Text Expression)
-    (:abstraction
-     (format "(" code ")")))
-
-  (def: nest
-    (-> Text Text)
-    (|>> (format "\n")
-         (text.replace-all "\n" "\n  ")))
-
-  (def: (_block expression)
-    (-> Text Text)
-    (format "{" (nest expression) "\n" "}"))
-
-  (def: #export (block expression)
-    (-> Expression Expression)
-    (:abstraction
-     (format "{" (:representation expression) "}")))
-
-  (def: #export null
-    Expression
-    (|> "NULL" self-contained))
-
-  (def: #export n/a
-    Expression
-    (|> "NA" self-contained))
-
-  (def: #export not-available Expression n/a)
-  (def: #export not-applicable Expression n/a)
-  (def: #export no-answer Expression n/a)
-
-  (def: #export bool
-    (-> Bit Expression)
-    (|>> (case> #0 "FALSE"
-                #1 "TRUE")
-         self-contained))
-
-  (def: #export (int value)
-    (-> Int Expression)
-    (self-contained
-     (format "as.integer(" (%i value) ")")))
-
-  (def: #export float
-    (-> Frac Expression)
-    (|>> (cond> [(f/= number.positive-infinity)]
-                [(new> "1.0/0.0")]
-                
-                [(f/= number.negative-infinity)]
-                [(new> "-1.0/0.0")]
-                
-                [(f/= number.not-a-number)]
-                [(new> "0.0/0.0")]
-                
-                ## else
-                [%f])
-         self-contained))
-
-  (def: #export string
-    (-> Text Expression)
-    (|>> %t self-contained))
-
-  (def: (composite-literal left-delimiter right-delimiter entry-serializer)
-    (All [a] (-> Text Text (-> a Text)
-                 (-> (List a) Expression)))
-    (.function (_ entries)
-      (self-contained
-       (format left-delimiter
-               (|> entries (list/map entry-serializer) (text.join-with ","))
-               right-delimiter))))
-
-  (def: #export named-list
-    (-> (List [Text Expression]) Expression)
-    (composite-literal "list(" ")" (.function (_ [key value])
-                                     (format key "=" (:representation value)))))
-  
-  (template [ ]
-    [(def: #export 
-       (-> (List Expression) Expression)
-       (composite-literal (format  "(") ")" expression))]
-
-    [vector "c"]
-    [list   "list"]
-    )
-  
-  (def: #export (slice from to list)
-    (-> Expression Expression Expression Expression)
-    (self-contained
-     (format (:representation list)
-             "[" (:representation from) ":" (:representation to) "]")))
-
-  (def: #export (slice-from from list)
-    (-> Expression Expression Expression)
-    (self-contained
-     (format (:representation list)
-             "[-1"  ":-" (:representation from) "]")))
-
-  (def: #export (apply args func)
-    (-> (List Expression) Expression Expression)
-    (self-contained
-     (format (:representation func) "(" (text.join-with "," (list/map expression args)) ")")))
-
-  (def: #export (apply-kw args kw-args func)
-    (-> (List Expression) (List [Text Expression]) Expression Expression)
-    (self-contained
-     (format (:representation func)
-             (format "("
-                     (text.join-with "," (list/map expression args)) ","
-                     (text.join-with "," (list/map (.function (_ [key val])
-                                                     (format key "=" (expression val)))
-                                                   kw-args))
-                     ")"))))
-
-  (def: #export (nth idx list)
-    (-> Expression Expression Expression)
-    (self-contained
-     (format (:representation list) "[[" (:representation idx) "]]")))
-
-  (def: #export (if test then else)
-    (-> Expression Expression Expression Expression)
-    (self-contained
-     (format "if(" (:representation test) ")"
-             " " (.._block (:representation then))
-             " else " (.._block (:representation else)))))
-
-  (def: #export (when test then)
-    (-> Expression Expression Expression)
-    (self-contained
-     (format "if(" (:representation test) ") {"
-             (.._block (:representation then))
-             "\n" "}")))
-
-  (def: #export (cond clauses else)
-    (-> (List [Expression Expression]) Expression Expression)
-    (list/fold (.function (_ [test then] next)
-                 (if test then next))
-               else
-               (list.reverse clauses)))
-
-  (template [ ]
-    [(def: #export ( param subject)
-       (-> Expression Expression Expression)
-       (self-contained
-        (format (:representation subject)
-                " "  " "
-                (:representation param))))]
-
-    [=       "=="]
-    [<       "<"]
-    [<=      "<="]
-    [>       ">"]
-    [>=      ">="]
-    [+       "+"]
-    [-       "-"]
-    [*       "*"]
-    [/       "/"]
-    [%%      "%%"]
-    [**      "**"]
-    [or      "||"]
-    [and     "&&"]
-    )
-
-  (def: #export @@
-    (All [k] (-> (Var k) Expression))
-    (|>> ..name self-contained))
-
-  (def: #export global
-    (-> Text Expression)
-    (|>> var @@))
-
-  (template [ ]
-    [(def: #export ( param subject)
-       (-> Expression Expression Expression)
-       (..apply (.list subject param) (..global )))]
-
-    [bit-or   "bitwOr"]
-    [bit-and  "bitwAnd"]
-    [bit-xor  "bitwXor"]
-    [bit-shl  "bitwShiftL"]
-    [bit-ushr "bitwShiftR"]
-    )
-
-  (def: #export (bit-not subject)
-    (-> Expression Expression)
-    (..apply (.list subject) (..global "bitwNot")))
-
-  (template [ ]
-    [(def: #export 
-       (-> Expression Expression)
-       (|>> :representation (format ) self-contained))]
-
-    [not    "!"]
-    [negate "-"]
-    )
-  
-  (def: #export (length list)
-    (-> Expression Expression)
-    (..apply (.list list) (..global "length")))
-
-  (def: #export (range from to)
-    (-> Expression Expression Expression)
-    (self-contained
-     (format (:representation from) ":" (:representation to))))
-
-  (def: #export (function inputs body)
-    (-> (List (Ex [k] (Var k))) Expression Expression)
-    (let [args (|> inputs (list/map ..name) (text.join-with ", "))]
-      (self-contained
-       (format "function(" args ") "
-               (.._block (:representation body))))))
-
-  (def: #export (try body warning error finally)
-    (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression)
-    (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text)
-                      (.function (_ parameter value preparation)
-                        (|> value
-                            (maybe/map (|>> :representation preparation (format ", " parameter " = ")))
-                            (maybe.default ""))))]
-      (self-contained
-       (format "tryCatch("
-               (.._block (:representation body))
-               (optional "warning" warning id)
-               (optional "error" error id)
-               (optional "finally" finally .._block)
-               ")"))))
-
-  (def: #export (while test body)
-    (-> Expression Expression Expression)
-    (self-contained
-     (format "while (" (:representation test) ") "
-             (.._block (:representation body)))))
-
-  (def: #export (for-in var inputs body)
-    (-> SVar Expression Expression Expression)
-    (self-contained
-     (format "for (" (..name var) " in " (..expression inputs) ")"
-             (.._block (:representation body)))))
-
-  (template [ ]
-    [(def: #export ( message)
-       (-> Expression Expression)
-       (..apply (.list message) (..global )))]
-
-    [stop  "stop"]
-    [print "print"]
-    )
-
-  (def: #export (set! var value)
-    (-> (Var Single) Expression Expression)
-    (self-contained
-     (format (..name var) " <- " (:representation value))))
-
-  (def: #export (set-nth! idx value list)
-    (-> Expression Expression SVar Expression)
-    (self-contained
-     (format (..name list) "[[" (:representation idx) "]] <- " (:representation value))))
-
-  (def: #export (then pre post)
-    (-> Expression Expression Expression)
-    (:abstraction
-     (format (:representation pre)
-             "\n"
-             (:representation post))))
-  )
diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux
deleted file mode 100644
index f6a45b02e..000000000
--- a/new-luxc/source/luxc/lang/synthesis/variable.lux
+++ /dev/null
@@ -1,98 +0,0 @@
-(.module:
-  lux
-  (lux (data [number]
-             (coll [list "list/" Fold Monoid]
-                   ["s" set])))
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              [".L" variable #+ Variable])))
-
-(def: (bound-vars path)
-  (-> ls.Path (List Variable))
-  (case path
-    (#ls.BindP register)
-    (list (.int register))
-
-    (^or (#ls.SeqP pre post) (#ls.AltP pre post))
-    (list/compose (bound-vars pre) (bound-vars post))
-    
-    _
-    (list)))
-
-(def: (path-bodies path)
-  (-> ls.Path (List ls.Synthesis))
-  (case path
-    (#ls.ExecP body)
-    (list body)
-
-    (#ls.SeqP pre post)
-    (path-bodies post)
-
-    (#ls.AltP pre post)
-    (list/compose (path-bodies pre) (path-bodies post))
-    
-    _
-    (list)))
-
-(def: (non-arg? arity var)
-  (-> ls.Arity Variable Bit)
-  (and (variableL.local? var)
-       (n/> arity (.nat var))))
-
-(type: Tracker (s.Set Variable))
-
-(def: init-tracker Tracker (s.new number.Hash))
-
-(def: (unused-vars current-arity bound exprS)
-  (-> ls.Arity (List Variable) ls.Synthesis (List Variable))
-  (let [tracker (loop [exprS exprS
-                       tracker (list/fold s.add init-tracker bound)]
-                  (case exprS
-                    (#ls.Variable var)
-                    (if (non-arg? current-arity var)
-                      (s.remove var tracker)
-                      tracker)
-                    
-                    (#ls.Variant tag last? memberS)
-                    (recur memberS tracker)
-
-                    (#ls.Tuple membersS)
-                    (list/fold recur tracker membersS)
-
-                    (#ls.Call funcS argsS)
-                    (list/fold recur (recur funcS tracker) argsS)
-                    
-                    (^or (#ls.Recur argsS)
-                         (#ls.Procedure name argsS))
-                    (list/fold recur tracker argsS)
-
-                    (#ls.Let offset inputS outputS)
-                    (|> tracker (recur inputS) (recur outputS))
-
-                    (#ls.If testS thenS elseS)
-                    (|> tracker (recur testS) (recur thenS) (recur elseS))
-
-                    (#ls.Loop offset initsS bodyS)
-                    (recur bodyS (list/fold recur tracker initsS))
-
-                    (#ls.Case inputS outputPS)
-                    (let [tracker' (list/fold s.add
-                                              (recur inputS tracker)
-                                              (bound-vars outputPS))]
-                      (list/fold recur tracker' (path-bodies outputPS)))
-
-                    (#ls.Function arity env bodyS)
-                    (list/fold s.remove tracker env)
-
-                    _
-                    tracker
-                    ))]
-    (s.to-list tracker)))
-
-## (def: (optimize-register-use current-arity [pathS bodyS])
-##   (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis])
-##   (let [bound (bound-vars pathS)
-##         unused (unused-vars current-arity bound bodyS)
-##         adjusted (adjust-vars unused bound)]
-##     [(|> pathS (clean-pattern adjusted) simplify-pattern)
-##      (clean-expression adjusted bodyS)]))
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
deleted file mode 100644
index 141e70184..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ /dev/null
@@ -1,182 +0,0 @@
-(.module:
-  [lux (#- Module Definition)
-   ["." host (#+ 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
-       ["." generation]]]
-     ["." meta
-      [io (#+ lux-context)]
-      [archive
-       [descriptor (#+ Module)]
-       ["." artifact]]]]]]
-  [///
-   [host
-    ["." jvm (#+ Inst Definition Host State)
-     ["." def]
-     ["." inst]]]]
-  )
-
-(import: #long java/lang/reflect/Field
-  (get [#? java/lang/Object] #try #? java/lang/Object))
-
-(import: #long (java/lang/Class a)
-  (getField [java/lang/String] #try java/lang/reflect/Field))
-
-(import: #long java/lang/Object
-  (getClass [] (java/lang/Class java/lang/Object)))
-
-(import: #long java/lang/ClassLoader)
-
-(type: #export ByteCode Binary)
-
-(def: #export value-field Text "_value")
-(def: #export $Value (type.class "java.lang.Object" (list)))
-
-(exception: #export (cannot-load {class Text} {error Text})
-  (exception.report
-   ["Class" class]
-   ["Error" error]))
-
-(exception: #export (invalid-field {class Text} {field Text} {error Text})
-  (exception.report
-   ["Class" class]
-   ["Field" field]
-   ["Error" error]))
-
-(exception: #export (invalid-value {class Text})
-  (exception.report
-   ["Class" class]))
-
-(def: (class-value class-name class)
-  (-> Text (java/lang/Class java/lang/Object) (Try Any))
-  (case (java/lang/Class::getField ..value-field class)
-    (#try.Success field)
-    (case (java/lang/reflect/Field::get #.None field)
-      (#try.Success ?value)
-      (case ?value
-        (#.Some value)
-        (#try.Success value)
-        
-        #.None
-        (exception.throw ..invalid-value class-name))
-      
-      (#try.Failure error)
-      (exception.throw ..cannot-load [class-name error]))
-    
-    (#try.Failure error)
-    (exception.throw ..invalid-field [class-name ..value-field error])))
-
-(def: class-path-separator ".")
-
-(def: #export bytecode-name
-  (-> Text Text)
-  (text.replace-all ..class-path-separator .module-separator))
-
-(def: #export (class-name [module-id artifact-id])
-  (-> generation.Context Text)
-  (format lux-context
-          ..class-path-separator (%.nat meta.version)
-          ..class-path-separator (%.nat module-id)
-          ..class-path-separator (%.nat artifact-id)))
-
-(def: (evaluate! library loader eval-class valueI)
-  (-> Library java/lang/ClassLoader Text Inst (Try [Any Definition]))
-  (let [bytecode-name (..bytecode-name eval-class)
-        bytecode (def.class #jvm.V1_6
-                            #jvm.Public jvm.noneC
-                            bytecode-name
-                            (list) $Value
-                            (list)
-                            (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
-                                            ..value-field ..$Value)
-                                 (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
-                                             ""
-                                             (type.method [(list) type.void (list)])
-                                             (|>> valueI
-                                                  (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value)
-                                                  inst.RETURN))))]
-    (io.run (do (try.with io.monad)
-              [_ (loader.store eval-class bytecode library)
-               class (loader.load eval-class loader)
-               value (:: io.monad wrap (..class-value eval-class class))]
-              (wrap [value
-                     [eval-class bytecode]])))))
-
-(def: (execute! library loader temp-label [class-name class-bytecode])
-  (-> Library java/lang/ClassLoader Text Definition (Try Any))
-  (io.run (do (try.with io.monad)
-            [existing-class? (|> (atom.read library)
-                                 (:: io.monad map (dictionary.contains? class-name))
-                                 (try.lift io.monad)
-                                 (: (IO (Try Bit))))
-             _ (if existing-class?
-                 (wrap [])
-                 (loader.store class-name class-bytecode library))]
-            (loader.load class-name loader))))
-
-(def: (define! library loader context valueI)
-  (-> Library java/lang/ClassLoader generation.Context Inst (Try [Text Any Definition]))
-  (let [class-name (..class-name context)]
-    (do try.monad
-      [[value definition] (evaluate! library loader class-name valueI)]
-      (wrap [class-name value definition]))))
-
-(def: #export host
-  (IO Host)
-  (io (let [library (loader.new-library [])
-            loader (loader.memory library)]
-        (: Host
-           (structure
-            (def: (evaluate! temp-label valueI)
-              (:: try.monad map product.left
-                  (..evaluate! library loader (text.replace-all " " "$" temp-label) valueI)))
-            
-            (def: execute!
-              (..execute! library loader))
-            
-            (def: define!
-              (..define! library loader))
-
-            (def: (ingest context bytecode)
-              [(..class-name context) bytecode])
-
-            (def: (re-learn context [_ bytecode])
-              (io.run
-               (loader.store (..class-name context) bytecode library)))
-            
-            (def: (re-load context [_ bytecode])
-              (io.run
-               (do (try.with io.monad)
-                 [#let [class-name (..class-name context)]
-                  _ (loader.store class-name bytecode library)
-                  class (loader.load class-name loader)]
-                 (:: io.monad wrap (..class-value class-name class))))))))))
-
-(def: #export $Variant (type.array ..$Value))
-(def: #export $Tuple (type.array ..$Value))
-(def: #export $Runtime (type.class (..class-name [0 0]) (list)))
-(def: #export $Function (type.class (..class-name [0 1]) (list)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.lux b/new-luxc/source/luxc/lang/translation/jvm/case.lux
deleted file mode 100644
index 0d8aaa91e..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/case.lux
+++ /dev/null
@@ -1,239 +0,0 @@
-(.module:
-  [lux (#- Type if let case)
-   [abstract
-    [monad (#+ do)]]
-   [control
-    ["." function]
-    ["ex" exception (#+ exception:)]]
-   [data
-    [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
-     ["$" jvm (#+ Label Inst Operation Phase Generator)
-      ["_" inst]]]]]
-  ["." //
-   ["." runtime]])
-
-(def: (pop-altI stack-depth)
-  (-> Nat Inst)
-  (.case stack-depth
-    0 function.identity
-    1 _.POP
-    2 _.POP2
-    _ ## (n.> 2)
-    (|>> _.POP2
-         (pop-altI (n.- 2 stack-depth)))))
-
-(def: peekI
-  Inst
-  (|>> _.DUP
-       (_.int +0)
-       _.AALOAD))
-
-(def: pushI
-  Inst
-  (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list runtime.$Stack //.$Value) runtime.$Stack (list)])))
-
-(def: popI
-  (|>> (_.int +1)
-       _.AALOAD
-       (_.CHECKCAST runtime.$Stack)))
-
-(def: (path' stack-depth @else @end phase archive path)
-  (-> Nat Label Label Phase Archive Path (Operation Inst))
-  (.case path
-    #synthesis.Pop
-    (operation@wrap ..popI)
-    
-    (#synthesis.Bind register)
-    (operation@wrap (|>> peekI
-                         (_.ASTORE register)))
-
-    (^ (synthesis.path/bit value))
-    (operation@wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
-                      (|>> peekI
-                           (_.unwrap type.boolean)
-                           (jumpI @else))))
-    
-    (^ (synthesis.path/i64 value))
-    (operation@wrap (|>> peekI
-                         (_.unwrap type.long)
-                         (_.long (.int value))
-                         _.LCMP
-                         (_.IFNE @else)))
-    
-    (^ (synthesis.path/f64 value))
-    (operation@wrap (|>> peekI
-                         (_.unwrap type.double)
-                         (_.double value)
-                         _.DCMPL
-                         (_.IFNE @else)))
-    
-    (^ (synthesis.path/text value))
-    (operation@wrap (|>> peekI
-                         (_.string value)
-                         (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list))
-                                          "equals"
-                                          (type.method [(list //.$Value) type.boolean (list)]))
-                         (_.IFEQ @else)))
-    
-    (#synthesis.Then bodyS)
-    (do phase.monad
-      [bodyI (phase archive bodyS)]
-      (wrap (|>> (pop-altI stack-depth)
-                 bodyI
-                 (_.GOTO @end))))
-    
-    (^template [  ]
-      (^ ( idx))
-      (operation@wrap (<| _.with-label (function (_ @success))
-                          _.with-label (function (_ @fail))
-                          (|>> peekI
-                               (_.CHECKCAST //.$Variant)
-                               (_.int (.int ( idx)))
-                               
-                               (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)]))
-                               _.DUP
-                               (_.IFNULL @fail)
-                               (_.GOTO @success)
-                               (_.label @fail)
-                               _.POP
-                               (_.GOTO @else)
-                               (_.label @success)
-                               pushI))))
-    ([synthesis.side/left  _.NULL        function.identity]
-     [synthesis.side/right (_.string "") .inc])
-
-    (^ (synthesis.member/left lefts))
-    (operation@wrap (.let [accessI (.case lefts
-                                     0
-                                     _.AALOAD
-                                     
-                                     lefts
-                                     (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
-                      (|>> peekI
-                           (_.CHECKCAST //.$Tuple)
-                           (_.int (.int lefts))
-                           accessI
-                           pushI)))
-
-    (^ (synthesis.member/right lefts))
-    (operation@wrap (|>> peekI
-                         (_.CHECKCAST //.$Tuple)
-                         (_.int (.int lefts))
-                         (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
-                         pushI))
-
-    ## Extra optimization
-    (^ (synthesis.path/seq
-        (synthesis.member/left 0)
-        (synthesis.!bind-top register thenP)))
-    (do phase.monad
-      [then! (path' stack-depth @else @end phase archive thenP)]
-      (wrap (|>> peekI
-                 (_.CHECKCAST //.$Tuple)
-                 (_.int +0)
-                 _.AALOAD
-                 (_.ASTORE register)
-                 then!)))
-
-    ## Extra optimization
-    (^template [ ]
-      (^ (synthesis.path/seq
-          ( lefts)
-          (synthesis.!bind-top register thenP)))
-      (do phase.monad
-        [then! (path' stack-depth @else @end phase archive thenP)]
-        (wrap (|>> peekI
-                   (_.CHECKCAST //.$Tuple)
-                   (_.int (.int lefts))
-                   (_.INVOKESTATIC //.$Runtime  (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
-                   (_.ASTORE register)
-                   then!))))
-    ([synthesis.member/left  "tuple_left"]
-     [synthesis.member/right "tuple_right"])
-
-    (#synthesis.Alt leftP rightP)
-    (do phase.monad
-      [@alt-else _.make-label
-       leftI (path' (inc stack-depth) @alt-else @end phase archive leftP)
-       rightI (path' stack-depth @else @end phase archive rightP)]
-      (wrap (|>> _.DUP
-                 leftI
-                 (_.label @alt-else)
-                 _.POP
-                 rightI)))
-    
-    (#synthesis.Seq leftP rightP)
-    (do phase.monad
-      [leftI (path' stack-depth @else @end phase archive leftP)
-       rightI (path' stack-depth @else @end phase archive rightP)]
-      (wrap (|>> leftI
-                 rightI)))
-    ))
-
-(def: (path @end phase archive path)
-  (-> Label Phase Archive Path (Operation Inst))
-  (do phase.monad
-    [@else _.make-label
-     pathI (..path' 1 @else @end phase archive path)]
-    (wrap (|>> pathI
-               (_.label @else)
-               _.POP
-               (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) type.void (list)]))
-               _.NULL
-               (_.GOTO @end)))))
-
-(def: #export (if phase archive [testS thenS elseS])
-  (Generator [Synthesis Synthesis Synthesis])
-  (do phase.monad
-    [testI (phase archive testS)
-     thenI (phase archive thenS)
-     elseI (phase archive elseS)]
-    (wrap (<| _.with-label (function (_ @else))
-              _.with-label (function (_ @end))
-              (|>> testI
-                   (_.unwrap type.boolean)
-                   (_.IFEQ @else)
-                   thenI
-                   (_.GOTO @end)
-                   (_.label @else)
-                   elseI
-                   (_.label @end))))))
-
-(def: #export (let phase archive [inputS register exprS])
-  (Generator [Synthesis Nat Synthesis])
-  (do phase.monad
-    [inputI (phase archive inputS)
-     exprI (phase archive exprS)]
-    (wrap (|>> inputI
-               (_.ASTORE register)
-               exprI))))
-
-(def: #export (case phase archive [valueS path])
-  (Generator [Synthesis Path])
-  (do phase.monad
-    [@end _.make-label
-     valueI (phase archive valueS)
-     pathI (..path @end phase archive path)]
-    (wrap (|>> _.NULL
-               valueI
-               pushI
-               pathI
-               (_.label @end)))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.lux b/new-luxc/source/luxc/lang/translation/jvm/common.lux
deleted file mode 100644
index 6cd7f4f2f..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/common.lux
+++ /dev/null
@@ -1,72 +0,0 @@
-(.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]]]
-   ]
-  ## [luxc
-  ##  [lang
-  ##   [host
-  ##    ["." jvm
-  ##     [type]]]]]
-  )
-
-## (def: #export (with-artifacts action)
-##   (All [a] (-> (Meta a) (Meta [Artifacts a])))
-##   (function (_ state)
-##     (case (action (update@ #.host
-##                            (|>> (:coerce Host)
-##                                 (set@ #artifacts (dictionary.new text.hash))
-##                                 (:coerce Nothing))
-##                            state))
-##       (#try.Success [state' output])
-##       (#try.Success [(update@ #.host
-##                                 (|>> (:coerce Host)
-##                                      (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts)))
-##                                      (:coerce Nothing))
-##                                 state')
-##                        [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts))
-##                         output]])
-
-##       (#try.Failure error)
-##       (#try.Failure error))))
-
-## (def: #export (load-definition state)
-##   (-> Lux (-> Name Binary (Try Any)))
-##   (function (_ (^@ def-name [def-module def-name]) def-bytecode)
-##     (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name)))
-##           class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
-##       (<| (macro.run state)
-##           (do macro.monad
-##             [_ (..store-class class-name def-bytecode)
-##              class (..load-class class-name)]
-##             (case (do try.monad
-##                     [field (Class::getField [..value-field] class)]
-##                     (Field::get [#.None] field))
-##               (#try.Success (#.Some def-value))
-##               (wrap def-value)
-
-##               (#try.Success #.None)
-##               (phase.throw invalid-definition-value (%name def-name))
-
-##               (#try.Failure error)
-##               (phase.throw cannot-load-definition
-##                               (format "Definition: " (%name def-name) "\n"
-##                                       "Error:\n"
-##                                       error))))))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.lux
deleted file mode 100644
index 144e35f9b..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/expression.lux
+++ /dev/null
@@ -1,72 +0,0 @@
-(.module:
-  [lux #*
-   [tool
-    [compiler
-     [language
-      [lux
-       ["." synthesis]
-       [phase
-        ["." extension]]]]]]]
-  [luxc
-   [lang
-    [host
-     [jvm (#+ Phase)]]]]
-  [//
-   ["." common]
-   ["." primitive]
-   ["." structure]
-   ["." reference]
-   ["." case]
-   ["." loop]
-   ["." function]])
-
-(def: #export (translate archive synthesis)
-  Phase
-  (case synthesis
-    (^ (synthesis.bit value))
-    (primitive.bit value)
-    
-    (^ (synthesis.i64 value))
-    (primitive.i64 value)
-    
-    (^ (synthesis.f64 value))
-    (primitive.f64 value)
-    
-    (^ (synthesis.text value))
-    (primitive.text value)
-
-    (^ (synthesis.variant data))
-    (structure.variant translate archive data)
-
-    (^ (synthesis.tuple members))
-    (structure.tuple translate archive members)
-
-    (^ (synthesis.variable variable))
-    (reference.variable archive variable)
-
-    (^ (synthesis.constant constant))
-    (reference.constant archive constant)
-
-    (^ (synthesis.branch/let data))
-    (case.let translate archive data)
-
-    (^ (synthesis.branch/if data))
-    (case.if translate archive data)
-
-    (^ (synthesis.branch/case data))
-    (case.case translate archive data)
-
-    (^ (synthesis.loop/recur data))
-    (loop.recur translate archive data)
-
-    (^ (synthesis.loop/scope data))
-    (loop.scope translate archive data)
-
-    (^ (synthesis.function/apply data))
-    (function.call translate archive data)
-
-    (^ (synthesis.function/abstraction data))
-    (function.function translate archive data)
-
-    (#synthesis.Extension extension)
-    (extension.apply archive translate extension)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension.lux b/new-luxc/source/luxc/lang/translation/jvm/extension.lux
deleted file mode 100644
index 9066dd156..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension.lux
+++ /dev/null
@@ -1,16 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [collection
-     ["." dictionary]]]]
-  [////
-   [host
-    [jvm (#+ Bundle)]]]
-  ["." / #_
-   ["#." common]
-   ["#." host]])
-
-(def: #export bundle
-  Bundle
-  (dictionary.merge /common.bundle
-                    /host.bundle))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
deleted file mode 100644
index 383415c0a..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
+++ /dev/null
@@ -1,388 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try]
-    ["<>" parser
-     ["" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    [number
-     ["f" frac]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary]]]
-   [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]]]]]]]
-   [host (#+ import:)]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
-      ["_" inst]]]]]
-  ["." ///
-   ["." runtime]])
-
-(def: #export (custom [parser handler])
-  (All [s]
-    (-> [(Parser s)
-         (-> Text Phase Archive s (Operation Inst))]
-        Handler))
-  (function (_ extension-name phase archive input)
-    (case (.run parser input)
-      (#try.Success input')
-      (handler extension-name phase archive input')
-
-      (#try.Failure error)
-      (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
-
-(import: java/lang/Double
-  (#static MIN_VALUE Double)
-  (#static MAX_VALUE Double))
-
-(def: $String (type.class "java.lang.String" (list)))
-(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
-(def: $System (type.class "java.lang.System" (list)))
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: lux-intI Inst (|>> _.I2L (_.wrap type.long)))
-(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I))
-(def: check-stringI Inst (_.CHECKCAST $String))
-
-(def: (predicateI tester)
-  (-> (-> Label Inst)
-      Inst)
-  (let [$Boolean (type.class "java.lang.Boolean" (list))]
-    (<| _.with-label (function (_ @then))
-        _.with-label (function (_ @end))
-        (|>> (tester @then)
-             (_.GETSTATIC $Boolean "FALSE" $Boolean)
-             (_.GOTO @end)
-             (_.label @then)
-             (_.GETSTATIC $Boolean "TRUE" $Boolean)
-             (_.label @end)
-             ))))
-
-(def: unitI Inst (_.string synthesis.unit))
-
-## TODO: Get rid of this ASAP
-(def: lux::syntax-char-case!
-  (..custom [($_ <>.and
-                 .any
-                 .any
-                 (<>.some (.tuple ($_ <>.and
-                                         (.tuple (<>.many .i64))
-                                         .any))))
-             (function (_ extension-name phase archive [input else conditionals])
-               (<| _.with-label (function (_ @end))
-                   _.with-label (function (_ @else))
-                   (do {@ phase.monad}
-                     [inputG (phase archive input)
-                      elseG (phase archive else)
-                      conditionalsG+ (: (Operation (List [(List [Int Label])
-                                                          Inst]))
-                                        (monad.map @ (function (_ [chars branch])
-                                                       (do @
-                                                         [branchG (phase archive branch)]
-                                                         (wrap (<| _.with-label (function (_ @branch))
-                                                                   [(list@map (function (_ char)
-                                                                                [(.int char) @branch])
-                                                                              chars)
-                                                                    (|>> (_.label @branch)
-                                                                         branchG
-                                                                         (_.GOTO @end))]))))
-                                                   conditionals))
-                      #let [table (|> conditionalsG+
-                                      (list@map product.left)
-                                      list@join)
-                            conditionalsG (|> conditionalsG+
-                                              (list@map product.right)
-                                              _.fuse)]]
-                     (wrap (|>> inputG (_.unwrap type.long) _.L2I
-                                (_.LOOKUPSWITCH @else table)
-                                conditionalsG
-                                (_.label @else)
-                                elseG
-                                (_.label @end)
-                                )))))]))
-
-(def: (lux::is [referenceI sampleI])
-  (Binary Inst)
-  (|>> referenceI
-       sampleI
-       (predicateI _.IF_ACMPEQ)))
-
-(def: (lux::try riskyI)
-  (Unary Inst)
-  (|>> riskyI
-       (_.CHECKCAST ///.$Function)
-       (_.INVOKESTATIC ///.$Runtime "try" runtime.try)))
-
-(template [ ]
-  [(def: ( [maskI inputI])
-     (Binary Inst)
-     (|>> inputI (_.unwrap type.long)
-          maskI (_.unwrap type.long)
-           (_.wrap type.long)))]
-
-  [i64::and _.LAND]
-  [i64::or  _.LOR]
-  [i64::xor _.LXOR]
-  )
-
-(template [ ]
-  [(def: ( [shiftI inputI])
-     (Binary Inst)
-     (|>> inputI (_.unwrap type.long)
-          shiftI jvm-intI
-          
-          (_.wrap type.long)))]
-
-  [i64::left-shift             _.LSHL]
-  [i64::arithmetic-right-shift _.LSHR]
-  [i64::logical-right-shift    _.LUSHR]
-  )
-
-(template [  ]
-  [(def: ( _)
-     (Nullary Inst)
-     (|>>  (_.wrap )))]
-
-  [f64::smallest (_.double (Double::MIN_VALUE))            type.double]
-  [f64::min      (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double]
-  [f64::max      (_.double (Double::MAX_VALUE))            type.double]
-  )
-
-(template [  ]
-  [(def: ( [paramI subjectI])
-     (Binary Inst)
-     (|>> subjectI (_.unwrap )
-          paramI (_.unwrap )
-          
-          (_.wrap )))]
-
-  [i64::+ type.long   _.LADD]
-  [i64::- type.long   _.LSUB]
-  [i64::* type.long   _.LMUL]
-  [i64::/ type.long   _.LDIV]
-  [i64::% type.long   _.LREM]
-  
-  [f64::+ type.double _.DADD]
-  [f64::- type.double _.DSUB]
-  [f64::* type.double _.DMUL]
-  [f64::/ type.double _.DDIV]
-  [f64::% type.double _.DREM]
-  )
-
-(template [   ]
-  [(template [ ]
-     [(def: ( [paramI subjectI])
-        (Binary Inst)
-        (|>> subjectI (_.unwrap )
-             paramI (_.unwrap )
-             
-             (_.int )
-             (predicateI _.IF_ICMPEQ)))]
-     
-     [ +0]
-     [ -1])]
-
-  [i64::= i64::< type.long   _.LCMP]
-  [f64::= f64::< type.double _.DCMPG]
-  )
-
-(template [  ]
-  [(def: ( inputI)
-     (Unary Inst)
-     (|>> inputI  ))]
-
-  [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)]
-  [i64::char (_.unwrap type.long)
-   ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))]
-
-  [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)]
-  [f64::encode (_.unwrap type.double)
-   (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))]
-  [f64::decode ..check-stringI
-   (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))]
-  )
-
-(def: (text::size inputI)
-  (Unary Inst)
-  (|>> inputI
-       ..check-stringI
-       (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)]))
-       lux-intI))
-
-(template [    ]
-  [(def: ( [paramI subjectI])
-     (Binary Inst)
-     (|>> subjectI 
-          paramI 
-           ))]
-
-  [text::= (<|) (<|)
-   (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)]))
-   (_.wrap type.boolean)]
-  [text::< ..check-stringI ..check-stringI
-   (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)]))
-   (predicateI _.IFLT)]
-  [text::char ..check-stringI jvm-intI
-   (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)]))
-   lux-intI]
-  )
-
-(def: (text::concat [leftI rightI])
-  (Binary Inst)
-  (|>> leftI ..check-stringI
-       rightI ..check-stringI
-       (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)]))))
-
-(def: (text::clip [startI endI subjectI])
-  (Trinary Inst)
-  (|>> subjectI ..check-stringI
-       startI jvm-intI
-       endI jvm-intI
-       (_.INVOKEVIRTUAL $String "substring" (type.method [(list type.int type.int) $String (list)]))))
-
-(def: index-method (type.method [(list $String type.int) type.int (list)]))
-(def: (text::index [startI partI textI])
-  (Trinary Inst)
-  (<| _.with-label (function (_ @not-found))
-      _.with-label (function (_ @end))
-      (|>> textI ..check-stringI
-           partI ..check-stringI
-           startI jvm-intI
-           (_.INVOKEVIRTUAL $String "indexOf" index-method)
-           _.DUP
-           (_.int -1)
-           (_.IF_ICMPEQ @not-found)
-           lux-intI
-           runtime.someI
-           (_.GOTO @end)
-           (_.label @not-found)
-           _.POP
-           runtime.noneI
-           (_.label @end))))
-
-(def: string-method (type.method [(list $String) type.void (list)]))
-(def: (io::log messageI)
-  (Unary Inst)
-  (let [$PrintStream (type.class "java.io.PrintStream" (list))]
-    (|>> (_.GETSTATIC $System "out" $PrintStream)
-         messageI
-         ..check-stringI
-         (_.INVOKEVIRTUAL $PrintStream "println" string-method)
-         unitI)))
-
-(def: (io::error messageI)
-  (Unary Inst)
-  (let [$Error (type.class "java.lang.Error" (list))]
-    (|>> (_.NEW $Error)
-         _.DUP
-         messageI
-         ..check-stringI
-         (_.INVOKESPECIAL $Error "" string-method)
-         _.ATHROW)))
-
-(def: (io::exit codeI)
-  (Unary Inst)
-  (|>> codeI jvm-intI
-       (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)]))
-       _.NULL))
-
-(def: (io::current-time _)
-  (Nullary Inst)
-  (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)]))
-       (_.wrap type.long)))
-
-(def: bundle::lux
-  Bundle
-  (|> (: Bundle bundle.empty)
-      (bundle.install "syntax char case!" lux::syntax-char-case!)
-      (bundle.install "is" (binary lux::is))
-      (bundle.install "try" (unary lux::try))))
-
-(def: bundle::i64
-  Bundle
-  (<| (bundle.prefix "i64")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "and" (binary i64::and))
-          (bundle.install "or" (binary i64::or))
-          (bundle.install "xor" (binary i64::xor))
-          (bundle.install "left-shift" (binary i64::left-shift))
-          (bundle.install "logical-right-shift" (binary i64::logical-right-shift))
-          (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift))
-          (bundle.install "=" (binary i64::=))
-          (bundle.install "<" (binary i64::<))
-          (bundle.install "+" (binary i64::+))
-          (bundle.install "-" (binary i64::-))
-          (bundle.install "*" (binary i64::*))
-          (bundle.install "/" (binary i64::/))
-          (bundle.install "%" (binary i64::%))
-          (bundle.install "f64" (unary i64::f64))
-          (bundle.install "char" (unary i64::char)))))
-
-(def: bundle::f64
-  Bundle
-  (<| (bundle.prefix "f64")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary f64::+))
-          (bundle.install "-" (binary f64::-))
-          (bundle.install "*" (binary f64::*))
-          (bundle.install "/" (binary f64::/))
-          (bundle.install "%" (binary f64::%))
-          (bundle.install "=" (binary f64::=))
-          (bundle.install "<" (binary f64::<))
-          (bundle.install "smallest" (nullary f64::smallest))
-          (bundle.install "min" (nullary f64::min))
-          (bundle.install "max" (nullary f64::max))
-          (bundle.install "i64" (unary f64::i64))
-          (bundle.install "encode" (unary f64::encode))
-          (bundle.install "decode" (unary f64::decode)))))
-
-(def: bundle::text
-  Bundle
-  (<| (bundle.prefix "text")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "=" (binary text::=))
-          (bundle.install "<" (binary text::<))
-          (bundle.install "concat" (binary text::concat))
-          (bundle.install "index" (trinary text::index))
-          (bundle.install "size" (unary text::size))
-          (bundle.install "char" (binary text::char))
-          (bundle.install "clip" (trinary text::clip)))))
-
-(def: bundle::io
-  Bundle
-  (<| (bundle.prefix "io")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "log" (unary io::log))
-          (bundle.install "error" (unary io::error))
-          (bundle.install "exit" (unary io::exit))
-          (bundle.install "current-time" (nullary io::current-time)))))
-
-(def: #export bundle
-  Bundle
-  (<| (bundle.prefix "lux")
-      (|> bundle::lux
-          (dictionary.merge bundle::i64)
-          (dictionary.merge bundle::f64)
-          (dictionary.merge bundle::text)
-          (dictionary.merge bundle::io))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
deleted file mode 100644
index 7b90a8e4f..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
+++ /dev/null
@@ -1,1047 +0,0 @@
-(.module:
-  [lux (#- Type primitive int char type)
-   [host (#+ import:)]
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." exception (#+ exception:)]
-    ["." function]
-    ["<>" parser ("#@." monad)
-     ["" text]
-     ["" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." text ("#@." equivalence)
-     ["%" format (#+ format)]]
-    [number
-     ["." nat]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary (#+ Dictionary)]
-     ["." set]]]
-   [target
-    [jvm
-     ["." type (#+ Type Typed Argument)
-      ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
-      ["." box]
-      ["." reflection]
-      ["." signature]
-      ["." parser]]]]
-   [tool
-    [compiler
-     ["." reference (#+ Variable)]
-     ["." phase ("#@." monad)]
-     [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]
-         [analysis
-          ["/" jvm]]]]]]]]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
-      ["_" inst]
-      ["_." def]]]]]
-  ["." // #_
-   [common (#+ custom)]
-   ["/#" //
-    ["#." reference]
-    ["#." function]]])
-
-(template [  ]
-  [(def: #export 
-     (Parser (Type ))
-     (.embed  .text))]
-
-  [var Var parser.var]
-  [class Class parser.class]
-  [object Object parser.object]
-  [value Value parser.value]
-  [return Return parser.return]
-  )
-
-(exception: #export (not-an-object-array {arrayJT (Type Array)})
-  (exception.report
-   ["JVM Type" (|> arrayJT type.signature signature.signature)]))
-
-(def: #export object-array
-  (Parser (Type Object))
-  (do <>.monad
-    [arrayJT (.embed parser.array .text)]
-    (case (parser.array? arrayJT)
-      (#.Some elementJT)
-      (case (parser.object? elementJT)
-        (#.Some elementJT)
-        (wrap elementJT)
-
-        #.None
-        (<>.fail (exception.construct ..not-an-object-array arrayJT)))
-      
-      #.None
-      (undefined))))
-
-(template [ ]
-  [(def: 
-     Inst
-     )]
-
-  [L2S (|>> _.L2I _.I2S)]
-  [L2B (|>> _.L2I _.I2B)]
-  [L2C (|>> _.L2I _.I2C)]
-  )
-
-(template [ ]
-  [(def: ( inputI)
-     (Unary Inst)
-     (if (is? _.NOP )
-       inputI
-       (|>> inputI
-            )))]
-  
-  [_.D2F conversion::double-to-float]
-  [_.D2I conversion::double-to-int]
-  [_.D2L conversion::double-to-long]
-  [_.F2D conversion::float-to-double]
-  [_.F2I conversion::float-to-int]
-  [_.F2L conversion::float-to-long]
-  [_.I2B conversion::int-to-byte]
-  [_.I2C conversion::int-to-char]
-  [_.I2D conversion::int-to-double]
-  [_.I2F conversion::int-to-float]
-  [_.I2L conversion::int-to-long]
-  [_.I2S conversion::int-to-short]
-  [_.L2D conversion::long-to-double]
-  [_.L2F conversion::long-to-float]
-  [_.L2I conversion::long-to-int]
-  [..L2S conversion::long-to-short]
-  [..L2B conversion::long-to-byte]
-  [..L2C conversion::long-to-char]
-  [_.I2B conversion::char-to-byte]
-  [_.I2S conversion::char-to-short]
-  [_.NOP conversion::char-to-int]
-  [_.I2L conversion::char-to-long]
-  [_.I2L conversion::byte-to-long]
-  [_.I2L conversion::short-to-long]
-  )
-
-(def: conversion
-  Bundle
-  (<| (bundle.prefix "conversion")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "double-to-float" (unary conversion::double-to-float))
-          (bundle.install "double-to-int" (unary conversion::double-to-int))
-          (bundle.install "double-to-long" (unary conversion::double-to-long))
-          (bundle.install "float-to-double" (unary conversion::float-to-double))
-          (bundle.install "float-to-int" (unary conversion::float-to-int))
-          (bundle.install "float-to-long" (unary conversion::float-to-long))
-          (bundle.install "int-to-byte" (unary conversion::int-to-byte))
-          (bundle.install "int-to-char" (unary conversion::int-to-char))
-          (bundle.install "int-to-double" (unary conversion::int-to-double))
-          (bundle.install "int-to-float" (unary conversion::int-to-float))
-          (bundle.install "int-to-long" (unary conversion::int-to-long))
-          (bundle.install "int-to-short" (unary conversion::int-to-short))
-          (bundle.install "long-to-double" (unary conversion::long-to-double))
-          (bundle.install "long-to-float" (unary conversion::long-to-float))
-          (bundle.install "long-to-int" (unary conversion::long-to-int))
-          (bundle.install "long-to-short" (unary conversion::long-to-short))
-          (bundle.install "long-to-byte" (unary conversion::long-to-byte))
-          (bundle.install "long-to-char" (unary conversion::long-to-char))
-          (bundle.install "char-to-byte" (unary conversion::char-to-byte))
-          (bundle.install "char-to-short" (unary conversion::char-to-short))
-          (bundle.install "char-to-int" (unary conversion::char-to-int))
-          (bundle.install "char-to-long" (unary conversion::char-to-long))
-          (bundle.install "byte-to-long" (unary conversion::byte-to-long))
-          (bundle.install "short-to-long" (unary conversion::short-to-long))
-          )))
-
-(template [ ]
-  [(def: ( [xI yI])
-     (Binary Inst)
-     (|>> xI
-          yI
-          ))]
-
-  [int::+ _.IADD]
-  [int::- _.ISUB]
-  [int::* _.IMUL]
-  [int::/ _.IDIV]
-  [int::% _.IREM]
-  [int::and _.IAND]
-  [int::or _.IOR]
-  [int::xor _.IXOR]
-  [int::shl _.ISHL]
-  [int::shr _.ISHR]
-  [int::ushr _.IUSHR]
-  
-  [long::+ _.LADD]
-  [long::- _.LSUB]
-  [long::* _.LMUL]
-  [long::/ _.LDIV]
-  [long::% _.LREM]
-  [long::and _.LAND]
-  [long::or _.LOR]
-  [long::xor _.LXOR]
-  [long::shl _.LSHL]
-  [long::shr _.LSHR]
-  [long::ushr _.LUSHR]
-
-  [float::+ _.FADD]
-  [float::- _.FSUB]
-  [float::* _.FMUL]
-  [float::/ _.FDIV]
-  [float::% _.FREM]
-  
-  [double::+ _.DADD]
-  [double::- _.DSUB]
-  [double::* _.DMUL]
-  [double::/ _.DDIV]
-  [double::% _.DREM]
-  )
-
-(def: $Boolean (type.class box.boolean (list)))
-(def: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean))
-(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean))
-
-(template [ ]
-  [(def: ( [xI yI])
-     (Binary Inst)
-     (<| _.with-label (function (_ @then))
-         _.with-label (function (_ @end))
-         (|>> xI
-              yI
-              ( @then)
-              falseI
-              (_.GOTO @end)
-              (_.label @then)
-              trueI
-              (_.label @end))))]
-
-  [int::= _.IF_ICMPEQ]
-  [int::< _.IF_ICMPLT]
-
-  [char::= _.IF_ICMPEQ]
-  [char::< _.IF_ICMPLT]
-  )
-
-(template [  ]
-  [(def: ( [xI yI])
-     (Binary Inst)
-     (<| _.with-label (function (_ @then))
-         _.with-label (function (_ @end))
-         (|>> xI
-              yI
-              
-              (_.int )
-              (_.IF_ICMPEQ @then)
-              falseI
-              (_.GOTO @end)
-              (_.label @then)
-              trueI
-              (_.label @end))))]
-
-  [long::= _.LCMP +0]
-  [long::< _.LCMP -1]
-  
-  [float::= _.FCMPG +0]
-  [float::< _.FCMPG -1]
-
-  [double::= _.DCMPG +0]
-  [double::< _.DCMPG -1]
-  )
-
-(def: int
-  Bundle
-  (<| (bundle.prefix (reflection.reflection reflection.int))
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary int::+))
-          (bundle.install "-" (binary int::-))
-          (bundle.install "*" (binary int::*))
-          (bundle.install "/" (binary int::/))
-          (bundle.install "%" (binary int::%))
-          (bundle.install "=" (binary int::=))
-          (bundle.install "<" (binary int::<))
-          (bundle.install "and" (binary int::and))
-          (bundle.install "or" (binary int::or))
-          (bundle.install "xor" (binary int::xor))
-          (bundle.install "shl" (binary int::shl))
-          (bundle.install "shr" (binary int::shr))
-          (bundle.install "ushr" (binary int::ushr))
-          )))
-
-(def: long
-  Bundle
-  (<| (bundle.prefix (reflection.reflection reflection.long))
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary long::+))
-          (bundle.install "-" (binary long::-))
-          (bundle.install "*" (binary long::*))
-          (bundle.install "/" (binary long::/))
-          (bundle.install "%" (binary long::%))
-          (bundle.install "=" (binary long::=))
-          (bundle.install "<" (binary long::<))
-          (bundle.install "and" (binary long::and))
-          (bundle.install "or" (binary long::or))
-          (bundle.install "xor" (binary long::xor))
-          (bundle.install "shl" (binary long::shl))
-          (bundle.install "shr" (binary long::shr))
-          (bundle.install "ushr" (binary long::ushr))
-          )))
-
-(def: float
-  Bundle
-  (<| (bundle.prefix (reflection.reflection reflection.float))
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary float::+))
-          (bundle.install "-" (binary float::-))
-          (bundle.install "*" (binary float::*))
-          (bundle.install "/" (binary float::/))
-          (bundle.install "%" (binary float::%))
-          (bundle.install "=" (binary float::=))
-          (bundle.install "<" (binary float::<))
-          )))
-
-(def: double
-  Bundle
-  (<| (bundle.prefix (reflection.reflection reflection.double))
-      (|> (: Bundle bundle.empty)
-          (bundle.install "+" (binary double::+))
-          (bundle.install "-" (binary double::-))
-          (bundle.install "*" (binary double::*))
-          (bundle.install "/" (binary double::/))
-          (bundle.install "%" (binary double::%))
-          (bundle.install "=" (binary double::=))
-          (bundle.install "<" (binary double::<))
-          )))
-
-(def: char
-  Bundle
-  (<| (bundle.prefix (reflection.reflection reflection.char))
-      (|> (: Bundle bundle.empty)
-          (bundle.install "=" (binary char::=))
-          (bundle.install "<" (binary char::<))
-          )))
-
-(def: (primitive-array-length-handler jvm-primitive)
-  (-> (Type Primitive) Handler)
-  (..custom
-   [.any
-    (function (_ extension-name generate archive arrayS)
-      (do phase.monad
-        [arrayI (generate archive arrayS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array jvm-primitive))
-                   _.ARRAYLENGTH))))]))
-
-(def: array::length::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array .any)
-    (function (_ extension-name generate archive [elementJT arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array elementJT))
-                   _.ARRAYLENGTH))))]))
-
-(def: (new-primitive-array-handler jvm-primitive)
-  (-> (Type Primitive) Handler)
-  (function (_ extension-name generate archive inputs)
-    (case inputs
-      (^ (list lengthS))
-      (do phase.monad
-        [lengthI (generate archive lengthS)]
-        (wrap (|>> lengthI
-                   (_.array jvm-primitive))))
-
-      _
-      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::new::object
-  Handler
-  (..custom
-   [($_ <>.and ..object .any)
-    (function (_ extension-name generate archive [objectJT lengthS])
-      (do phase.monad
-        [lengthI (generate archive lengthS)]
-        (wrap (|>> lengthI
-                   (_.ANEWARRAY objectJT)))))]))
-
-(def: (read-primitive-array-handler jvm-primitive loadI)
-  (-> (Type Primitive) Inst Handler)
-  (function (_ extension-name generate archive inputs)
-    (case inputs
-      (^ (list idxS arrayS))
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array jvm-primitive))
-                   idxI
-                   loadI)))
-
-      _
-      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::read::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array .any .any)
-    (function (_ extension-name generate archive [elementJT idxS arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array elementJT))
-                   idxI
-                   _.AALOAD))))]))
-
-(def: (write-primitive-array-handler jvm-primitive storeI)
-  (-> (Type Primitive) Inst Handler)
-  (function (_ extension-name generate archive inputs)
-    (case inputs
-      (^ (list idxS valueS arrayS))
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)
-         valueI (generate archive valueS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array jvm-primitive))
-                   _.DUP
-                   idxI
-                   valueI
-                   storeI)))
-
-      _
-      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
-
-(def: array::write::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array .any .any .any)
-    (function (_ extension-name generate archive [elementJT idxS valueS arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)
-         valueI (generate archive valueS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array elementJT))
-                   _.DUP
-                   idxI
-                   valueI
-                   _.AASTORE))))]))
-
-(def: array
-  Bundle
-  (<| (bundle.prefix "array")
-      (|> bundle.empty
-          (dictionary.merge (<| (bundle.prefix "length")
-                                (|> bundle.empty
-                                    (bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean))
-                                    (bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte))
-                                    (bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short))
-                                    (bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int))
-                                    (bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long))
-                                    (bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float))
-                                    (bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double))
-                                    (bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char))
-                                    (bundle.install "object" array::length::object))))
-          (dictionary.merge (<| (bundle.prefix "new")
-                                (|> bundle.empty
-                                    (bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler type.boolean))
-                                    (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte))
-                                    (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short))
-                                    (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int))
-                                    (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long))
-                                    (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float))
-                                    (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double))
-                                    (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.char))
-                                    (bundle.install "object" array::new::object))))
-          (dictionary.merge (<| (bundle.prefix "read")
-                                (|> bundle.empty
-                                    (bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.BALOAD))
-                                    (bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.BALOAD))
-                                    (bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.SALOAD))
-                                    (bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.IALOAD))
-                                    (bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.LALOAD))
-                                    (bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.FALOAD))
-                                    (bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.DALOAD))
-                                    (bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.CALOAD))
-                                    (bundle.install "object" array::read::object))))
-          (dictionary.merge (<| (bundle.prefix "write")
-                                (|> bundle.empty
-                                    (bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.BASTORE))
-                                    (bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.BASTORE))
-                                    (bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.SASTORE))
-                                    (bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.IASTORE))
-                                    (bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.LASTORE))
-                                    (bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.FASTORE))
-                                    (bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.DASTORE))
-                                    (bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.CASTORE))
-                                    (bundle.install "object" array::write::object))))
-          )))
-
-(def: (object::null _)
-  (Nullary Inst)
-  _.NULL)
-
-(def: (object::null? objectI)
-  (Unary Inst)
-  (<| _.with-label (function (_ @then))
-      _.with-label (function (_ @end))
-      (|>> objectI
-           (_.IFNULL @then)
-           falseI
-           (_.GOTO @end)
-           (_.label @then)
-           trueI
-           (_.label @end))))
-
-(def: (object::synchronized [monitorI exprI])
-  (Binary Inst)
-  (|>> monitorI
-       _.DUP
-       _.MONITORENTER
-       exprI
-       _.SWAP
-       _.MONITOREXIT))
-
-(def: (object::throw exceptionI)
-  (Unary Inst)
-  (|>> exceptionI
-       _.ATHROW))
-
-(def: $Class (type.class "java.lang.Class" (list)))
-
-(def: (object::class extension-name generate archive inputs)
-  Handler
-  (case inputs
-    (^ (list (synthesis.text class)))
-    (do phase.monad
-      []
-      (wrap (|>> (_.string class)
-                 (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)])))))
-
-    _
-    (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: object::instance?
-  Handler
-  (..custom
-   [($_ <>.and .text .any)
-    (function (_ extension-name generate archive [class objectS])
-      (do phase.monad
-        [objectI (generate archive objectS)]
-        (wrap (|>> objectI
-                   (_.INSTANCEOF (type.class class (list)))
-                   (_.wrap type.boolean)))))]))
-
-(def: (object::cast extension-name generate archive inputs)
-  Handler
-  (case inputs
-    (^ (list (synthesis.text from) (synthesis.text to) valueS))
-    (do phase.monad
-      [valueI (generate archive valueS)]
-      (`` (cond (~~ (template [ ]
-                      [(and (text@= (reflection.reflection (type.reflection ))
-                                    from)
-                            (text@= 
-                                    to))
-                       (wrap (|>> valueI (_.wrap )))
-
-                       (and (text@= 
-                                    from)
-                            (text@= (reflection.reflection (type.reflection ))
-                                    to))
-                       (wrap (|>> valueI (_.unwrap )))]
-                      
-                      [box.boolean type.boolean]
-                      [box.byte    type.byte]
-                      [box.short   type.short]
-                      [box.int     type.int]
-                      [box.long    type.long]
-                      [box.float   type.float]
-                      [box.double  type.double]
-                      [box.char    type.char]))
-                ## else
-                (wrap valueI))))
-
-    _
-    (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
-
-(def: object-bundle
-  Bundle
-  (<| (bundle.prefix "object")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "null" (nullary object::null))
-          (bundle.install "null?" (unary object::null?))
-          (bundle.install "synchronized" (binary object::synchronized))
-          (bundle.install "throw" (unary object::throw))
-          (bundle.install "class" object::class)
-          (bundle.install "instance?" object::instance?)
-          (bundle.install "cast" object::cast)
-          )))
-
-(def: primitives
-  (Dictionary Text (Type Primitive))
-  (|> (list [(reflection.reflection reflection.boolean) type.boolean]
-            [(reflection.reflection reflection.byte) type.byte]
-            [(reflection.reflection reflection.short) type.short]
-            [(reflection.reflection reflection.int) type.int]
-            [(reflection.reflection reflection.long) type.long]
-            [(reflection.reflection reflection.float) type.float]
-            [(reflection.reflection reflection.double) type.double]
-            [(reflection.reflection reflection.char) type.char])
-      (dictionary.from-list text.hash)))
-
-(def: get::static
-  Handler
-  (..custom
-   [($_ <>.and .text .text .text)
-    (function (_ extension-name generate archive [class field unboxed])
-      (do phase.monad
-        []
-        (case (dictionary.get unboxed ..primitives)
-          (#.Some primitive)
-          (wrap (_.GETSTATIC (type.class class (list)) field primitive))
-          
-          #.None
-          (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
-
-(def: put::static
-  Handler
-  (..custom
-   [($_ <>.and .text .text .text .any)
-    (function (_ extension-name generate archive [class field unboxed valueS])
-      (do phase.monad
-        [valueI (generate archive valueS)
-         #let [$class (type.class class (list))]]
-        (case (dictionary.get unboxed ..primitives)
-          (#.Some primitive)
-          (wrap (|>> valueI
-                     (_.PUTSTATIC $class field primitive)
-                     (_.string synthesis.unit)))
-          
-          #.None
-          (wrap (|>> valueI
-                     (_.CHECKCAST $class)
-                     (_.PUTSTATIC $class field $class)
-                     (_.string synthesis.unit))))))]))
-
-(def: get::virtual
-  Handler
-  (..custom
-   [($_ <>.and .text .text .text .any)
-    (function (_ extension-name generate archive [class field unboxed objectS])
-      (do phase.monad
-        [objectI (generate archive objectS)
-         #let [$class (type.class class (list))
-               getI (case (dictionary.get unboxed ..primitives)
-                      (#.Some primitive)
-                      (_.GETFIELD $class field primitive)
-                      
-                      #.None
-                      (_.GETFIELD $class field (type.class unboxed (list))))]]
-        (wrap (|>> objectI
-                   (_.CHECKCAST $class)
-                   getI))))]))
-
-(def: put::virtual
-  Handler
-  (..custom
-   [($_ <>.and .text .text .text .any .any)
-    (function (_ extension-name generate archive [class field unboxed valueS objectS])
-      (do phase.monad
-        [valueI (generate archive valueS)
-         objectI (generate archive objectS)
-         #let [$class (type.class class (list))
-               putI (case (dictionary.get unboxed ..primitives)
-                      (#.Some primitive)
-                      (_.PUTFIELD $class field primitive)
-                      
-                      #.None
-                      (let [$unboxed (type.class unboxed (list))]
-                        (|>> (_.CHECKCAST $unboxed)
-                             (_.PUTFIELD $class field $unboxed))))]]
-        (wrap (|>> objectI
-                   (_.CHECKCAST $class)
-                   _.DUP
-                   valueI
-                   putI))))]))
-
-(type: Input (Typed Synthesis))
-
-(def: input
-  (Parser Input)
-  (.tuple (<>.and ..value .any)))
-
-(def: (generate-input generate archive [valueT valueS])
-  (-> Phase Archive Input
-      (Operation (Typed Inst)))
-  (do phase.monad
-    [valueI (generate archive valueS)]
-    (case (type.primitive? valueT)
-      (#.Right valueT)
-      (wrap [valueT valueI])
-      
-      (#.Left valueT)
-      (wrap [valueT (|>> valueI
-                         (_.CHECKCAST valueT))]))))
-
-(def: voidI (_.string synthesis.unit))
-
-(def: (prepare-output outputT)
-  (-> (Type Return) Inst)
-  (case (type.void? outputT)
-    (#.Right outputT)
-    ..voidI
-    
-    (#.Left outputT)
-    function.identity))
-
-(def: invoke::static
-  Handler
-  (..custom
-   [($_ <>.and ..class .text ..return (<>.some ..input))
-    (function (_ extension-name generate archive [class method outputT inputsTS])
-      (do {@ phase.monad}
-        [inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
-        (wrap (|>> (_.fuse (list@map product.right inputsTI))
-                   (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) outputT (list)]))
-                   (prepare-output outputT)))))]))
-
-(template [ ]
-  [(def: 
-     Handler
-     (..custom
-      [($_ <>.and ..class .text ..return .any (<>.some ..input))
-       (function (_ extension-name generate archive [class method outputT objectS inputsTS])
-         (do {@ phase.monad}
-           [objectI (generate archive objectS)
-            inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
-           (wrap (|>> objectI
-                      (_.CHECKCAST class)
-                      (_.fuse (list@map product.right inputsTI))
-                      ( class method
-                                (type.method [(list@map product.left inputsTI)
-                                              outputT
-                                              (list)]))
-                      (prepare-output outputT)))))]))]
-
-  [invoke::virtual _.INVOKEVIRTUAL]
-  [invoke::special _.INVOKESPECIAL]
-  [invoke::interface _.INVOKEINTERFACE]
-  )
-
-(def: invoke::constructor
-  Handler
-  (..custom
-   [($_ <>.and ..class (<>.some ..input))
-    (function (_ extension-name generate archive [class inputsTS])
-      (do {@ phase.monad}
-        [inputsTI (monad.map @ (generate-input generate archive) inputsTS)]
-        (wrap (|>> (_.NEW class)
-                   _.DUP
-                   (_.fuse (list@map product.right inputsTI))
-                   (_.INVOKESPECIAL class "" (type.method [(list@map product.left inputsTI) type.void (list)]))))))]))
-
-(def: member
-  Bundle
-  (<| (bundle.prefix "member")
-      (|> (: Bundle bundle.empty)
-          (dictionary.merge (<| (bundle.prefix "get")
-                                (|> (: Bundle bundle.empty)
-                                    (bundle.install "static" get::static)
-                                    (bundle.install "virtual" get::virtual))))
-          (dictionary.merge (<| (bundle.prefix "put")
-                                (|> (: Bundle bundle.empty)
-                                    (bundle.install "static" put::static)
-                                    (bundle.install "virtual" put::virtual))))
-          (dictionary.merge (<| (bundle.prefix "invoke")
-                                (|> (: Bundle bundle.empty)
-                                    (bundle.install "static" invoke::static)
-                                    (bundle.install "virtual" invoke::virtual)
-                                    (bundle.install "special" invoke::special)
-                                    (bundle.install "interface" invoke::interface)
-                                    (bundle.install "constructor" invoke::constructor))))
-          )))
-
-(def: annotation-parameter
-  (Parser (/.Annotation-Parameter Synthesis))
-  (.tuple (<>.and .text .any)))
-
-(def: annotation
-  (Parser (/.Annotation Synthesis))
-  (.tuple (<>.and .text (<>.some ..annotation-parameter))))
-
-(def: argument
-  (Parser Argument)
-  (.tuple (<>.and .text ..value)))
-
-(def: overriden-method-definition
-  (Parser [Environment (/.Overriden-Method Synthesis)])
-  (.tuple (do <>.monad
-               [_ (.text! /.overriden-tag)
-                ownerT ..class
-                name .text
-                strict-fp? .bit
-                annotations (.tuple (<>.some ..annotation))
-                vars (.tuple (<>.some ..var))
-                self-name .text
-                arguments (.tuple (<>.some ..argument))
-                returnT ..return
-                exceptionsT (.tuple (<>.some ..class))
-                [environment body] (.function 1
-                                     (.tuple .any))]
-               (wrap [environment
-                      [ownerT name
-                       strict-fp? annotations vars
-                       self-name arguments returnT exceptionsT
-                       body]]))))
-
-(def: (normalize-path normalize)
-  (-> (-> Synthesis Synthesis)
-      (-> Path Path))
-  (function (recur path)
-    (case path
-      (^ (synthesis.path/then bodyS))
-      (synthesis.path/then (normalize bodyS))
-
-      (^template []
-        (^ ( leftP rightP))
-        ( (recur leftP) (recur rightP)))
-      ([#synthesis.Alt]
-       [#synthesis.Seq])
-
-      (^template []
-        (^ ( value))
-        path)
-      ([#synthesis.Pop]
-       [#synthesis.Test]
-       [#synthesis.Bind]
-       [#synthesis.Access]))))
-
-(def: (normalize-method-body mapping)
-  (-> (Dictionary Variable Variable) Synthesis Synthesis)
-  (function (recur body)
-    (case body
-      (^template []
-        (^ ( value))
-        body)
-      ([#synthesis.Primitive]
-       [synthesis.constant])
-
-      (^ (synthesis.variant [lefts right? sub]))
-      (synthesis.variant [lefts right? (recur sub)])
-
-      (^ (synthesis.tuple members))
-      (synthesis.tuple (list@map recur members))
-
-      (^ (synthesis.variable var))
-      (|> mapping
-          (dictionary.get var)
-          (maybe.default var)
-          synthesis.variable)
-
-      (^ (synthesis.branch/case [inputS pathS]))
-      (synthesis.branch/case [(recur inputS) (normalize-path recur pathS)])
-
-      (^ (synthesis.branch/let [inputS register outputS]))
-      (synthesis.branch/let [(recur inputS) register (recur outputS)])
-
-      (^ (synthesis.branch/if [testS thenS elseS]))
-      (synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
-
-      (^ (synthesis.loop/scope [offset initsS+ bodyS]))
-      (synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
-
-      (^ (synthesis.loop/recur updatesS+))
-      (synthesis.loop/recur (list@map recur updatesS+))
-
-      (^ (synthesis.function/abstraction [environment arity bodyS]))
-      (synthesis.function/abstraction [(|> environment (list@map (function (_ local)
-                                                                   (|> mapping
-                                                                       (dictionary.get local)
-                                                                       (maybe.default local)))))
-                                       arity
-                                       bodyS])
-
-      (^ (synthesis.function/apply [functionS inputsS+]))
-      (synthesis.function/apply [(recur functionS) (list@map recur inputsS+)])
-
-      (#synthesis.Extension [name inputsS+])
-      (#synthesis.Extension [name (list@map recur inputsS+)]))))
-
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: (anonymous-init-method env)
-  (-> Environment (Type Method))
-  (type.method [(list.repeat (list.size env) $Object)
-                type.void
-                (list)]))
-
-(def: (with-anonymous-init class env super-class inputsTI)
-  (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def)
-  (let [store-capturedI (|> env
-                            list.size
-                            list.indices
-                            (list@map (.function (_ register)
-                                        (|>> (_.ALOAD 0)
-                                             (_.ALOAD (inc register))
-                                             (_.PUTFIELD class (///reference.foreign-name register) $Object))))
-                            _.fuse)]
-    (_def.method #$.Public $.noneM "" (anonymous-init-method env)
-                 (|>> (_.ALOAD 0)
-                      ((_.fuse (list@map product.right inputsTI)))
-                      (_.INVOKESPECIAL super-class "" (type.method [(list@map product.left inputsTI) type.void (list)]))
-                      store-capturedI
-                      _.RETURN))))
-
-(def: (anonymous-instance archive class env)
-  (-> Archive (Type Class) Environment (Operation Inst))
-  (do {@ phase.monad}
-    [captureI+ (monad.map @ (///reference.variable archive) env)]
-    (wrap (|>> (_.NEW class)
-               _.DUP
-               (_.fuse captureI+)
-               (_.INVOKESPECIAL class "" (anonymous-init-method env))))))
-
-(def: (returnI returnT)
-  (-> (Type Return) Inst)
-  (case (type.void? returnT)
-    (#.Right returnT)
-    _.RETURN
-
-    (#.Left returnT)
-    (case (type.primitive? returnT)
-      (#.Left returnT)
-      (|>> (_.CHECKCAST returnT)
-           _.ARETURN)
-      
-      (#.Right returnT)
-      (cond (or (:: type.equivalence = type.boolean returnT)
-                (:: type.equivalence = type.byte returnT)
-                (:: type.equivalence = type.short returnT)
-                (:: type.equivalence = type.int returnT)
-                (:: type.equivalence = type.char returnT))
-            _.IRETURN
-
-            (:: type.equivalence = type.long returnT)
-            _.LRETURN
-
-            (:: type.equivalence = type.float returnT)
-            _.FRETURN
-
-            ## (:: type.equivalence = type.double returnT)
-            _.DRETURN))))
-
-(def: class::anonymous
-  Handler
-  (..custom
-   [($_ <>.and
-        ..class
-        (.tuple (<>.some ..class))
-        (.tuple (<>.some ..input))
-        (.tuple (<>.some ..overriden-method-definition)))
-    (function (_ extension-name generate archive [super-class super-interfaces
-                                                  inputsTS
-                                                  overriden-methods])
-      (do {@ phase.monad}
-        [[context _] (generation.with-new-context archive (wrap []))
-         #let [[module-id artifact-id] context
-               anonymous-class-name (///.class-name context)
-               class (type.class anonymous-class-name (list))
-               total-environment (|> overriden-methods
-                                     ## Get all the environments.
-                                     (list@map product.left)
-                                     ## Combine them.
-                                     list@join
-                                     ## Remove duplicates.
-                                     (set.from-list reference.hash)
-                                     set.to-list)
-               global-mapping (|> total-environment
-                                  ## Give them names as "foreign" variables.
-                                  list.enumerate
-                                  (list@map (function (_ [id capture])
-                                              [capture (#reference.Foreign id)]))
-                                  (dictionary.from-list reference.hash))
-               normalized-methods (list@map (function (_ [environment
-                                                          [ownerT name
-                                                           strict-fp? annotations vars
-                                                           self-name arguments returnT exceptionsT
-                                                           body]])
-                                              (let [local-mapping (|> environment
-                                                                      list.enumerate
-                                                                      (list@map (function (_ [foreign-id capture])
-                                                                                  [(#reference.Foreign foreign-id)
-                                                                                   (|> global-mapping
-                                                                                       (dictionary.get capture)
-                                                                                       maybe.assume)]))
-                                                                      (dictionary.from-list reference.hash))]
-                                                [ownerT name
-                                                 strict-fp? annotations vars
-                                                 self-name arguments returnT exceptionsT
-                                                 (normalize-method-body local-mapping body)]))
-                                            overriden-methods)]
-         inputsTI (monad.map @ (generate-input generate archive) inputsTS)
-         method-definitions (|> normalized-methods
-                                (monad.map @ (function (_ [ownerT name
-                                                           strict-fp? annotations vars
-                                                           self-name arguments returnT exceptionsT
-                                                           bodyS])
-                                               (do @
-                                                 [bodyG (generation.with-context artifact-id
-                                                          (generate archive bodyS))]
-                                                 (wrap (_def.method #$.Public
-                                                                    (if strict-fp?
-                                                                      ($_ $.++M $.finalM $.strictM)
-                                                                      $.finalM)
-                                                                    name
-                                                                    (type.method [(list@map product.right arguments)
-                                                                                  returnT
-                                                                                  exceptionsT])
-                                                                    (|>> bodyG (returnI returnT)))))))
-                                (:: @ map _def.fuse))
-         _ (generation.save! true ["" (%.nat artifact-id)]
-                             [anonymous-class-name
-                              (_def.class #$.V1_6 #$.Public $.finalC
-                                          anonymous-class-name (list)
-                                          super-class super-interfaces
-                                          (|>> (///function.with-environment total-environment)
-                                               (..with-anonymous-init class total-environment super-class inputsTI)
-                                               method-definitions))])]
-        (anonymous-instance archive class total-environment)))]))
-
-(def: bundle::class
-  Bundle
-  (<| (bundle.prefix "class")
-      (|> (: Bundle bundle.empty)
-          (bundle.install "anonymous" class::anonymous)
-          )))
-
-(def: #export bundle
-  Bundle
-  (<| (bundle.prefix "jvm")
-      (|> ..conversion
-          (dictionary.merge ..int)
-          (dictionary.merge ..long)
-          (dictionary.merge ..float)
-          (dictionary.merge ..double)
-          (dictionary.merge ..char)
-          (dictionary.merge ..array)
-          (dictionary.merge ..object-bundle)
-          (dictionary.merge ..member)
-          (dictionary.merge ..bundle::class)
-          )))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
deleted file mode 100644
index 888ad9545..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ /dev/null
@@ -1,331 +0,0 @@
-(.module:
-  [lux (#- Type function)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    [pipe (#+ when> new>)]
-    ["." function]]
-   [data
-    ["." product]
-    [text
-     ["%" format (#+ format)]]
-    [number
-     ["n" nat]
-     ["i" int]]
-    [collection
-     ["." list ("#@." functor monoid)]]]
-   [target
-    [jvm
-     ["." type (#+ Type)
-      ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]]]]
-   [tool
-    [compiler
-     [arity (#+ Arity)]
-     [reference (#+ Register)]
-     ["." phase]
-     [language
-      [lux
-       [analysis (#+ Environment)]
-       [synthesis (#+ Synthesis Abstraction Apply)]
-       ["." generation]]]
-     [meta
-      [archive (#+ Archive)]]]]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Label Inst Def Operation Phase Generator)
-      ["." def]
-      ["_" inst]]]]]
-  ["." //
-   ["#." runtime]
-   ["." reference]])
-
-(def: arity-field Text "arity")
-
-(def: (poly-arg? arity)
-  (-> Arity Bit)
-  (n.> 1 arity))
-
-(def: (captured-args env)
-  (-> Environment (List (Type Value)))
-  (list.repeat (list.size env) //.$Value))
-
-(def: (init-method env arity)
-  (-> Environment Arity (Type Method))
-  (if (poly-arg? arity)
-    (type.method [(list.concat (list (captured-args env)
-                                     (list type.int)
-                                     (list.repeat (dec arity) //.$Value)))
-                  type.void
-                  (list)])
-    (type.method [(captured-args env) type.void (list)])))
-
-(def: (implementation-method arity)
-  (type.method [(list.repeat arity //.$Value) //.$Value (list)]))
-
-(def: get-amount-of-partialsI
-  Inst
-  (|>> (_.ALOAD 0)
-       (_.GETFIELD //.$Function //runtime.partials-field type.int)))
-
-(def: (load-fieldI class field)
-  (-> (Type Class) Text Inst)
-  (|>> (_.ALOAD 0)
-       (_.GETFIELD class field //.$Value)))
-
-(def: (inputsI start amount)
-  (-> Register Nat Inst)
-  (|> (list.n/range start (n.+ start (dec amount)))
-      (list@map _.ALOAD)
-      _.fuse))
-
-(def: (applysI start amount)
-  (-> Register Nat Inst)
-  (let [max-args (n.min amount //runtime.num-apply-variants)
-        later-applysI (if (n.> //runtime.num-apply-variants amount)
-                        (applysI (n.+ //runtime.num-apply-variants start) (n.- //runtime.num-apply-variants amount))
-                        function.identity)]
-    (|>> (_.CHECKCAST //.$Function)
-         (inputsI start max-args)
-         (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature max-args))
-         later-applysI)))
-
-(def: (inc-intI by)
-  (-> Nat Inst)
-  (|>> (_.int (.int by))
-       _.IADD))
-
-(def: (nullsI amount)
-  (-> Nat Inst)
-  (|> _.NULL
-      (list.repeat amount)
-      _.fuse))
-
-(def: (instance archive class arity env)
-  (-> Archive (Type Class) Arity Environment (Operation Inst))
-  (do {@ phase.monad}
-    [captureI+ (monad.map @ (reference.variable archive) env)
-     #let [argsI (if (poly-arg? arity)
-                   (|> (nullsI (dec arity))
-                       (list (_.int +0))
-                       _.fuse)
-                   function.identity)]]
-    (wrap (|>> (_.NEW class)
-               _.DUP
-               (_.fuse captureI+)
-               argsI
-               (_.INVOKESPECIAL class "" (init-method env arity))))))
-
-(def: (reset-method return)
-  (-> (Type Class) (Type Method))
-  (type.method [(list) return (list)]))
-
-(def: (with-reset class arity env)
-  (-> (Type Class) Arity Environment Def)
-  (def.method #$.Public $.noneM "reset" (reset-method class)
-              (if (poly-arg? arity)
-                (let [env-size (list.size env)
-                      captureI (|> (case env-size
-                                     0 (list)
-                                     _ (list.n/range 0 (dec env-size)))
-                                   (list@map (.function (_ source)
-                                               (|>> (_.ALOAD 0)
-                                                    (_.GETFIELD class (reference.foreign-name source) //.$Value))))
-                                   _.fuse)
-                      argsI (|> (nullsI (dec arity))
-                                (list (_.int +0))
-                                _.fuse)]
-                  (|>> (_.NEW class)
-                       _.DUP
-                       captureI
-                       argsI
-                       (_.INVOKESPECIAL class "" (init-method env arity))
-                       _.ARETURN))
-                (|>> (_.ALOAD 0)
-                     _.ARETURN))))
-
-(def: (with-implementation arity @begin bodyI)
-  (-> Nat Label Inst Def)
-  (def.method #$.Public $.strictM "impl" (implementation-method arity)
-              (|>> (_.label @begin)
-                   bodyI
-                   _.ARETURN)))
-
-(def: function-init-method
-  (type.method [(list type.int) type.void (list)]))
-
-(def: (function-init arity env-size)
-  (-> Arity Nat Inst)
-  (if (n.= 1 arity)
-    (|>> (_.int +0)
-         (_.INVOKESPECIAL //.$Function "" function-init-method))
-    (|>> (_.ILOAD (inc env-size))
-         (_.INVOKESPECIAL //.$Function "" function-init-method))))
-
-(def: (with-init class env arity)
-  (-> (Type Class) Environment Arity Def)
-  (let [env-size (list.size env)
-        offset-partial (: (-> Nat Nat)
-                          (|>> inc (n.+ env-size)))
-        store-capturedI (|> (case env-size
-                              0 (list)
-                              _ (list.n/range 0 (dec env-size)))
-                            (list@map (.function (_ register)
-                                        (|>> (_.ALOAD 0)
-                                             (_.ALOAD (inc register))
-                                             (_.PUTFIELD class (reference.foreign-name register) //.$Value))))
-                            _.fuse)
-        store-partialI (if (poly-arg? arity)
-                         (|> (list.n/range 0 (n.- 2 arity))
-                             (list@map (.function (_ idx)
-                                         (let [register (offset-partial idx)]
-                                           (|>> (_.ALOAD 0)
-                                                (_.ALOAD (inc register))
-                                                (_.PUTFIELD class (reference.partial-name idx) //.$Value)))))
-                             _.fuse)
-                         function.identity)]
-    (def.method #$.Public $.noneM "" (init-method env arity)
-                (|>> (_.ALOAD 0)
-                     (function-init arity env-size)
-                     store-capturedI
-                     store-partialI
-                     _.RETURN))))
-
-(def: (with-apply class env function-arity @begin bodyI apply-arity)
-  (-> (Type Class) Environment Arity Label Inst Arity
-      Def)
-  (let [num-partials (dec function-arity)
-        @default ($.new-label [])
-        @labels (list@map $.new-label (list.repeat num-partials []))
-        over-extent (|> (.int function-arity) (i.- (.int apply-arity)))
-        casesI (|> (list@compose @labels (list @default))
-                   (list.zip2 (list.n/range 0 num-partials))
-                   (list@map (.function (_ [stage @label])
-                               (let [load-partialsI (if (n.> 0 stage)
-                                                      (|> (list.n/range 0 (dec stage))
-                                                          (list@map (|>> reference.partial-name (load-fieldI class)))
-                                                          _.fuse)
-                                                      function.identity)]
-                                 (cond (i.= over-extent (.int stage))
-                                       (|>> (_.label @label)
-                                            (_.ALOAD 0)
-                                            (when> [(new> (n.> 0 stage) [])]
-                                                   [(_.INVOKEVIRTUAL class "reset" (reset-method class))])
-                                            load-partialsI
-                                            (inputsI 1 apply-arity)
-                                            (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity))
-                                            _.ARETURN)
-
-                                       (i.> over-extent (.int stage))
-                                       (let [args-to-completion (|> function-arity (n.- stage))
-                                             args-left (|> apply-arity (n.- args-to-completion))]
-                                         (|>> (_.label @label)
-                                              (_.ALOAD 0)
-                                              (_.INVOKEVIRTUAL class "reset" (reset-method class))
-                                              load-partialsI
-                                              (inputsI 1 args-to-completion)
-                                              (_.INVOKEVIRTUAL class "impl" (implementation-method function-arity))
-                                              (applysI (inc args-to-completion) args-left)
-                                              _.ARETURN))
-
-                                       ## (i.< over-extent (.int stage))
-                                       (let [env-size (list.size env)
-                                             load-capturedI (|> (case env-size
-                                                                  0 (list)
-                                                                  _ (list.n/range 0 (dec env-size)))
-                                                                (list@map (|>> reference.foreign-name (load-fieldI class)))
-                                                                _.fuse)]
-                                         (|>> (_.label @label)
-                                              (_.NEW class)
-                                              _.DUP
-                                              load-capturedI
-                                              get-amount-of-partialsI
-                                              (inc-intI apply-arity)
-                                              load-partialsI
-                                              (inputsI 1 apply-arity)
-                                              (nullsI (|> num-partials (n.- apply-arity) (n.- stage)))
-                                              (_.INVOKESPECIAL class "" (init-method env function-arity))
-                                              _.ARETURN))
-                                       ))))
-                   _.fuse)]
-    (def.method #$.Public $.noneM //runtime.apply-method (//runtime.apply-signature apply-arity)
-                (|>> get-amount-of-partialsI
-                     (_.TABLESWITCH +0 (|> num-partials dec .int)
-                                    @default @labels)
-                     casesI
-                     ))))
-
-(def: #export with-environment
-  (-> Environment Def)
-  (|>> list.enumerate
-       (list@map (.function (_ [env-idx env-source])
-                   (def.field #$.Private $.finalF (reference.foreign-name env-idx) //.$Value)))
-       def.fuse))
-
-(def: (with-partial arity)
-  (-> Arity Def)
-  (if (poly-arg? arity)
-    (|> (list.n/range 0 (n.- 2 arity))
-        (list@map (.function (_ idx)
-                    (def.field #$.Private $.finalF (reference.partial-name idx) //.$Value)))
-        def.fuse)
-    function.identity))
-
-(def: #export (with-function archive @begin class env arity bodyI)
-  (-> Archive Label Text Environment Arity Inst
-      (Operation [Def Inst]))
-  (let [classD (type.class class (list))
-        applyD (: Def
-                  (if (poly-arg? arity)
-                    (|> (n.min arity //runtime.num-apply-variants)
-                        (list.n/range 1)
-                        (list@map (with-apply classD env arity @begin bodyI))
-                        (list& (with-implementation arity @begin bodyI))
-                        def.fuse)
-                    (def.method #$.Public $.strictM //runtime.apply-method (//runtime.apply-signature 1)
-                                (|>> (_.label @begin)
-                                     bodyI
-                                     _.ARETURN))))
-        functionD (: Def
-                     (|>> (def.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity))
-                          (with-environment env)
-                          (with-partial arity)
-                          (with-init classD env arity)
-                          (with-reset classD arity env)
-                          applyD
-                          ))]
-    (do phase.monad
-      [instanceI (instance archive classD arity env)]
-      (wrap [functionD instanceI]))))
-
-(def: #export (function generate archive [env arity bodyS])
-  (Generator Abstraction)
-  (do phase.monad
-    [@begin _.make-label
-     [function-context bodyI] (generation.with-new-context archive
-                                (generation.with-anchor [@begin 1]
-                                  (generate archive bodyS)))
-     #let [function-class (//.class-name function-context)]
-     [functionD instanceI] (with-function archive @begin function-class env arity bodyI)
-     _ (generation.save! true ["" (%.nat (product.right function-context))]
-                         [function-class
-                          (def.class #$.V1_6 #$.Public $.finalC
-                                     function-class (list)
-                                     //.$Function (list)
-                                     functionD)])]
-    (wrap instanceI)))
-
-(def: #export (call generate archive [functionS argsS])
-  (Generator Apply)
-  (do {@ phase.monad}
-    [functionI (generate archive functionS)
-     argsI (monad.map @ (generate archive) argsS)
-     #let [applyI (|> argsI
-                      (list.split-all //runtime.num-apply-variants)
-                      (list@map (.function (_ chunkI+)
-                                  (|>> (_.CHECKCAST //.$Function)
-                                       (_.fuse chunkI+)
-                                       (_.INVOKEVIRTUAL //.$Function //runtime.apply-method (//runtime.apply-signature (list.size chunkI+))))))
-                      _.fuse)]]
-    (wrap (|>> functionI
-               applyI))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.lux
deleted file mode 100644
index 1f2168fed..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/loop.lux
+++ /dev/null
@@ -1,81 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." function]]
-   [data
-    [number
-     ["n" nat]]
-    [collection
-     ["." list ("#/." functor monoid)]]]
-   [tool
-    [compiler
-     [reference (#+ Register)]
-     ["." phase]
-     [language
-      [lux
-       ["." synthesis (#+ Synthesis)]
-       ["." generation]]]]]]
-  [luxc
-   [lang
-    [host
-     [jvm (#+ Inst Operation Phase Generator)
-      ["_" inst]]]]]
-  ["." //])
-
-(def: (invariant? register changeS)
-  (-> Register Synthesis Bit)
-  (case changeS
-    (^ (synthesis.variable/local var))
-    (n.= register var)
-
-    _
-    false))
-
-(def: #export (recur translate archive argsS)
-  (Generator (List Synthesis))
-  (do {@ phase.monad}
-    [[@begin start] generation.anchor
-     #let [end (|> argsS list.size dec (n.+ start))
-           pairs (list.zip2 (list.n/range start end)
-                            argsS)]
-     ## It may look weird that first I compile the values separately,
-     ## and then I compile the stores/allocations.
-     ## It must be done that way in order to avoid a potential bug.
-     ## Let's say that you'll recur with 2 expressions: X and Y.
-     ## If Y depends on the value of X, and you don't compile values
-     ## and stores separately, then by the time Y is evaluated, it
-     ## will refer to the new value of X, instead of the old value, as
-     ## should be the case.
-     valuesI+ (monad.map @ (function (_ [register argS])
-                             (: (Operation Inst)
-                                (if (invariant? register argS)
-                                  (wrap function.identity)
-                                  (translate archive argS))))
-                         pairs)
-     #let [storesI+ (list/map (function (_ [register argS])
-                                (: Inst
-                                   (if (invariant? register argS)
-                                     function.identity
-                                     (_.ASTORE register))))
-                              (list.reverse pairs))]]
-    (wrap (|>> (_.fuse valuesI+)
-               (_.fuse storesI+)
-               (_.GOTO @begin)))))
-
-(def: #export (scope translate archive [start initsS+ iterationS])
-  (Generator [Nat (List Synthesis) Synthesis])
-  (do {@ phase.monad}
-    [@begin _.make-label
-     initsI+ (monad.map @ (translate archive) initsS+)
-     iterationI (generation.with-anchor [@begin start]
-                  (translate archive iterationS))
-     #let [initializationI (|> (list.enumerate initsI+)
-                               (list/map (function (_ [register initI])
-                                           (|>> initI
-                                                (_.ASTORE (n.+ start register)))))
-                               _.fuse)]]
-    (wrap (|>> initializationI
-               (_.label @begin)
-               iterationI))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
deleted file mode 100644
index 873c363bd..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.lux
+++ /dev/null
@@ -1,30 +0,0 @@
-(.module:
-  [lux (#- i64)
-   [target
-    [jvm
-     ["." type]]]
-   [tool
-    [compiler
-     [phase ("operation@." monad)]]]]
-  [luxc
-   [lang
-    [host
-     ["." jvm (#+ Inst Operation)
-      ["_" inst]]]]])
-
-(def: #export bit
-  (-> Bit (Operation Inst))
-  (let [Boolean (type.class "java.lang.Boolean" (list))]
-    (function (_ value)
-      (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean)))))
-
-(template [   ]
-  [(def: #export ( value)
-     (->  (Operation Inst))
-     (let [loadI (|> value )]
-       (operation@wrap (|>> loadI ))))]
-
-  [i64  (I64 Any) (<| _.long .int) (_.wrap type.long)]
-  [f64  Frac      _.double         (_.wrap type.double)]
-  [text Text      _.string         (<|)]
-  )
diff --git a/new-luxc/source/luxc/lang/translation/jvm/program.lux b/new-luxc/source/luxc/lang/translation/jvm/program.lux
deleted file mode 100644
index 7ac897009..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/program.lux
+++ /dev/null
@@ -1,82 +0,0 @@
-(.module:
-  [lux #*
-   [target
-    [jvm
-     ["$t" type]]]]
-  [luxc
-   [lang
-    [host
-     ["_" jvm
-      ["$d" def]
-      ["$i" inst]]]
-    [translation
-     ["." jvm
-      ["." runtime]]]]])
-
-(def: #export class "LuxProgram")
-
-(def: ^Object ($t.class "java.lang.Object" (list)))
-
-(def: #export (program programI)
-  (-> _.Inst _.Definition)
-  (let [nilI runtime.noneI
-        num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
-        decI (|>> ($i.int +1) $i.ISUB)
-        headI (|>> $i.DUP
-                   ($i.ALOAD 0)
-                   $i.SWAP
-                   $i.AALOAD
-                   $i.SWAP
-                   $i.DUP_X2
-                   $i.POP)
-        pairI (|>> ($i.int +2)
-                   ($i.ANEWARRAY ..^Object)
-                   $i.DUP_X1
-                   $i.SWAP
-                   ($i.int +0)
-                   $i.SWAP
-                   $i.AASTORE
-                   $i.DUP_X1
-                   $i.SWAP
-                   ($i.int +1)
-                   $i.SWAP
-                   $i.AASTORE)
-        consI (|>> ($i.int +1)
-                   ($i.string "")
-                   $i.DUP2_X1
-                   $i.POP2
-                   runtime.variantI)
-        prepare-input-listI (<| $i.with-label (function (_ @loop))
-                                $i.with-label (function (_ @end))
-                                (|>> nilI
-                                     num-inputsI
-                                     ($i.label @loop)
-                                     decI
-                                     $i.DUP
-                                     ($i.IFLT @end)
-                                     headI
-                                     pairI
-                                     consI
-                                     $i.SWAP
-                                     ($i.GOTO @loop)
-                                     ($i.label @end)
-                                     $i.POP))
-        feed-inputsI ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1))
-        run-ioI (|>> ($i.CHECKCAST jvm.$Function)
-                     $i.NULL
-                     ($i.INVOKEVIRTUAL jvm.$Function runtime.apply-method (runtime.apply-signature 1)))
-        main-type ($t.method [(list ($t.array ($t.class "java.lang.String" (list))))
-                              $t.void
-                              (list)])]
-    [..class
-     ($d.class #_.V1_6
-               #_.Public _.finalC
-               ..class
-               (list) ..^Object
-               (list)
-               (|>> ($d.method #_.Public _.staticM "main" main-type
-                               (|>> programI
-                                    prepare-input-listI
-                                    feed-inputsI
-                                    run-ioI
-                                    $i.RETURN))))]))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.lux
deleted file mode 100644
index 6bcf4a2e5..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/reference.lux
+++ /dev/null
@@ -1,65 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [monad (#+ do)]]
-   [data
-    [text
-     ["%" format (#+ format)]]]
-   [target
-    [jvm
-     ["." type]]]
-   [tool
-    [compiler
-     ["." reference (#+ Register Variable)]
-     ["." phase ("operation@." monad)]
-     [meta
-      [archive (#+ Archive)]]
-     [language
-      [lux
-       ["." generation]]]]]]
-  [luxc
-   [lang
-    [host
-     [jvm (#+ Inst Operation)
-      ["_" inst]]]]]
-  ["." //
-   ["#." runtime]])
-
-(template [ ]
-  [(def: #export 
-     (-> Nat Text)
-     (|>> %.nat (format )))]
-
-  [foreign-name "f"]
-  [partial-name "p"]
-  )
-
-(def: (foreign archive variable)
-  (-> Archive Register (Operation Inst))
-  (do {@ phase.monad}
-    [class-name (:: @ map //.class-name
-                    (generation.context archive))]
-    (wrap (|>> (_.ALOAD 0)
-               (_.GETFIELD (type.class class-name (list))
-                           (|> variable .nat foreign-name)
-                           //.$Value)))))
-
-(def: local
-  (-> Register Inst)
-  (|>> _.ALOAD))
-
-(def: #export (variable archive variable)
-  (-> Archive Variable (Operation Inst))
-  (case variable
-    (#reference.Local variable)
-    (operation@wrap (local variable))
-    
-    (#reference.Foreign variable)
-    (foreign archive variable)))
-
-(def: #export (constant archive name)
-  (-> Archive Name (Operation Inst))
-  (do {@ phase.monad}
-    [class-name (:: @ map //.class-name
-                    (generation.remember archive name))]
-    (wrap (_.GETSTATIC (type.class class-name (list)) //.value-field //.$Value))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
deleted file mode 100644
index a657a7a38..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ /dev/null
@@ -1,387 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    [monad (#+ do)]]
-   [data
-    [binary (#+ Binary)]
-    ["." product]
-    [text
-     ["%" format (#+ format)]]
-    [collection
-     ["." list ("#@." functor)]
-     ["." row]]]
-   ["." math]
-   [target
-    [jvm
-     ["." type (#+ Type)
-      ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)]
-      ["." reflection]]]]
-   [tool
-    [compiler (#+ Output)
-     [arity (#+ Arity)]
-     ["." phase]
-     [language
-      [lux
-       ["." synthesis]
-       ["." generation]]]
-     [meta
-      [archive
-       ["." artifact (#+ Registry)]]]]]]
-  [luxc
-   [lang
-    [host
-     ["$" jvm (#+ Label Inst Def Operation)
-      ["$d" def]
-      ["_" inst]]]]]
-  ["." // (#+ ByteCode)])
-
-(def: $Text (type.class "java.lang.String" (list)))
-(def: #export $Tag type.int)
-(def: #export $Flag (type.class "java.lang.Object" (list)))
-(def: #export $Value (type.class "java.lang.Object" (list)))
-(def: #export $Index type.int)
-(def: #export $Stack (type.array $Value))
-(def: $Throwable (type.class "java.lang.Throwable" (list)))
-
-(def: nullary-init-methodT
-  (type.method [(list) type.void (list)]))
-
-(def: throw-methodT
-  (type.method [(list) type.void (list)]))
-
-(def: #export logI
-  Inst
-  (let [PrintStream (type.class "java.io.PrintStream" (list))
-        outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
-        printI (function (_ method)
-                 (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)])))]
-    (|>> outI (_.string "LOG: ") (printI "print")
-         outI _.SWAP (printI "println"))))
-
-(def: variant-method
-  (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))
-
-(def: #export variantI
-  Inst
-  (_.INVOKESTATIC //.$Runtime "variant_make" variant-method))
-
-(def: #export leftI
-  Inst
-  (|>> (_.int +0)
-       _.NULL
-       _.DUP2_X1
-       _.POP2
-       variantI))
-
-(def: #export rightI
-  Inst
-  (|>> (_.int +1)
-       (_.string "")
-       _.DUP2_X1
-       _.POP2
-       variantI))
-
-(def: #export someI Inst rightI)
-
-(def: #export noneI
-  Inst
-  (|>> (_.int +0)
-       _.NULL
-       (_.string synthesis.unit)
-       variantI))
-
-(def: (tryI unsafeI)
-  (-> Inst Inst)
-  (<| _.with-label (function (_ @from))
-      _.with-label (function (_ @to))
-      _.with-label (function (_ @handler))
-      (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
-           (_.label @from)
-           unsafeI
-           someI
-           _.ARETURN
-           (_.label @to)
-           (_.label @handler)
-           noneI
-           _.ARETURN)))
-
-(def: #export partials-field Text "partials")
-(def: #export apply-method Text "apply")
-(def: #export num-apply-variants Nat 8)
-
-(def: #export (apply-signature arity)
-  (-> Arity (Type Method))
-  (type.method [(list.repeat arity $Value) $Value (list)]))
-
-(def: adt-methods
-  Def
-  (let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
-        store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
-        store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
-    (|>> ($d.method #$.Public $.staticM "variant_make"
-                    (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
-                    (|>> (_.int +3)
-                         (_.ANEWARRAY $Value)
-                         store-tagI
-                         store-flagI
-                         store-valueI
-                         _.ARETURN)))))
-
-(def: frac-methods
-  Def
-  (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
-                  (tryI
-                   (|>> (_.ALOAD 0)
-                        (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]))
-                        (_.wrap type.double))))
-       ))
-
-(def: (illegal-state-exception message)
-  (-> Text Inst)
-  (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
-    (|>> (_.NEW IllegalStateException)
-         _.DUP
-         (_.string message)
-         (_.INVOKESPECIAL IllegalStateException "" (type.method [(list $Text) type.void (list)])))))
-
-(def: pm-methods
-  Def
-  (let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
-        last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB)
-        leftsI (_.ILOAD 1)
-        left-indexI leftsI
-        sub-leftsI (|>> leftsI
-                        last-rightI
-                        _.ISUB)
-        sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST //.$Tuple))
-        recurI (: (-> Label Inst)
-                  (function (_ @loop)
-                    (|>> sub-leftsI (_.ISTORE 1)
-                         sub-tupleI (_.ASTORE 0)
-                         (_.GOTO @loop))))]
-    (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT
-                    (|>> (illegal-state-exception "Invalid expression for pattern-matching.")
-                         _.ATHROW))
-         ($d.method #$.Public $.staticM "apply_fail" throw-methodT
-                    (|>> (illegal-state-exception "Error while applying function.")
-                         _.ATHROW))
-         ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)])
-                    (|>> (_.int +2)
-                         (_.ANEWARRAY $Value)
-                         _.DUP
-                         (_.int +1)
-                         (_.ALOAD 0)
-                         _.AASTORE
-                         _.DUP
-                         (_.int +0)
-                         (_.ALOAD 1)
-                         _.AASTORE
-                         _.ARETURN))
-         ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @perfect-match!))
-                        _.with-label (function (_ @tags-match!))
-                        _.with-label (function (_ @maybe-nested))
-                        _.with-label (function (_ @mismatch!))
-                        (let [$variant (_.ALOAD 0)
-                              $tag (_.ILOAD 1)
-                              $last? (_.ALOAD 2)
-                              
-                              variant-partI (: (-> Nat Inst)
-                                               (function (_ idx)
-                                                 (|>> (_.int (.int idx)) _.AALOAD)))
-                              ::tag (: Inst
-                                       (|>> (variant-partI 0) (_.unwrap type.int)))
-                              ::last? (variant-partI 1)
-                              ::value (variant-partI 2)
-
-                              super-nested-tag (|>> _.SWAP ## variant::tag, tag
-                                                    _.ISUB)
-                              super-nested (|>> super-nested-tag ## super-tag
-                                                $variant ::last? ## super-tag, super-last
-                                                $variant ::value ## super-tag, super-last, super-value
-                                                ..variantI)
-                              
-                              update-$tag _.ISUB
-                              update-$variant (|>> $variant ::value
-                                                   (_.CHECKCAST //.$Variant)
-                                                   (_.ASTORE 0))
-                              iterate! (: (-> Label Inst)
-                                          (function (_ @loop)
-                                            (|>> update-$variant
-                                                 update-$tag
-                                                 (_.GOTO @loop))))
-                              
-                              not-found _.NULL])
-                        (|>> $tag ## tag
-                             (_.label @loop)
-                             $variant ::tag ## tag, variant::tag
-                             _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag
-                             _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag
-                             $last? (_.IFNULL @mismatch!) ## tag, variant::tag
-                             super-nested ## super-variant
-                             _.ARETURN
-                             (_.label @tags-match!) ## tag, variant::tag
-                             $last? ## tag, variant::tag, last?
-                             $variant ::last? ## tag, variant::tag, last?, variant::last?
-                             (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag
-                             (_.label @maybe-nested) ## tag, variant::tag
-                             $variant ::last? ## tag, variant::tag, variant::last?
-                             (_.IFNULL @mismatch!) ## tag, variant::tag
-                             (iterate! @loop)
-                             (_.label @perfect-match!) ## tag, variant::tag
-                             ## _.POP2
-                             $variant ::value
-                             _.ARETURN
-                             (_.label @mismatch!) ## tag, variant::tag
-                             ## _.POP2
-                             not-found
-                             _.ARETURN)))
-         ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @recursive))
-                        (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
-                        (|>> (_.label @loop)
-                             leftsI last-rightI (_.IF_ICMPGE @recursive)
-                             left-accessI
-                             _.ARETURN
-                             (_.label @recursive)
-                             ## Recursive
-                             (recurI @loop))))
-         ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)])
-                    (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @not-tail))
-                        _.with-label (function (_ @slice))
-                        (let [right-indexI (|>> leftsI
-                                                (_.int +1)
-                                                _.IADD)
-                              right-accessI (|>> (_.ALOAD 0)
-                                                 _.SWAP
-                                                 _.AALOAD)
-                              sub-rightI (|>> (_.ALOAD 0)
-                                              right-indexI
-                                              tuple-sizeI
-                                              (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
-                                                              (type.method [(list //.$Tuple $Index $Index)
-                                                                            //.$Tuple
-                                                                            (list)])))])
-                        (|>> (_.label @loop)
-                             last-rightI right-indexI
-                             _.DUP2 (_.IF_ICMPNE @not-tail)
-                             ## _.POP
-                             right-accessI
-                             _.ARETURN
-                             (_.label @not-tail)
-                             (_.IF_ICMPGT @slice)
-                             ## Must recurse
-                             (recurI @loop)
-                             (_.label @slice)
-                             sub-rightI
-                             _.ARETURN
-                             )))
-         )))
-
-(def: #export try (type.method [(list //.$Function) //.$Variant (list)]))
-
-(def: io-methods
-  Def
-  (let [StringWriter (type.class "java.io.StringWriter" (list))
-        PrintWriter (type.class "java.io.PrintWriter" (list))
-        string-writerI (|>> (_.NEW StringWriter)
-                            _.DUP
-                            (_.INVOKESPECIAL StringWriter "" nullary-init-methodT))
-        print-writerI (|>> (_.NEW PrintWriter)
-                           _.SWAP
-                           _.DUP2
-                           _.POP
-                           _.SWAP
-                           (_.boolean true)
-                           (_.INVOKESPECIAL PrintWriter "" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
-                           )]
-    (|>> ($d.method #$.Public $.staticM "try" ..try
-                    (<| _.with-label (function (_ @from))
-                        _.with-label (function (_ @to))
-                        _.with-label (function (_ @handler))
-                        (|>> (_.try @from @to @handler $Throwable)
-                             (_.label @from)
-                             (_.ALOAD 0)
-                             _.NULL
-                             (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
-                             rightI
-                             _.ARETURN
-                             (_.label @to)
-                             (_.label @handler)
-                             string-writerI ## TW
-                             _.DUP2 ## TWTW
-                             print-writerI ## TWTP
-                             (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW
-                             (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS
-                             _.SWAP _.POP leftI
-                             _.ARETURN)))
-         )))
-
-(def: reflection
-  (All [category]
-    (-> (Type (<| Return' Value' category)) Text))
-  (|>> type.reflection reflection.reflection))
-
-(def: translate-runtime
-  (Operation [Text Binary])
-  (let [runtime-class (..reflection //.$Runtime)
-        bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime-class (list) (type.class "java.lang.Object" (list)) (list)
-                           (|>> adt-methods
-                                frac-methods
-                                pm-methods
-                                io-methods))
-        payload ["0" bytecode]]
-    (do phase.monad
-      [_ (generation.execute! runtime-class [runtime-class bytecode])
-       _ (generation.save! false ["" "0"] payload)]
-      (wrap payload))))
-
-(def: translate-function
-  (Operation [Text Binary])
-  (let [applyI (|> (list.n/range 2 num-apply-variants)
-                   (list@map (function (_ arity)
-                               ($d.method #$.Public $.noneM apply-method (apply-signature arity)
-                                          (let [preI (|> (list.n/range 0 (dec arity))
-                                                         (list@map _.ALOAD)
-                                                         _.fuse)]
-                                            (|>> preI
-                                                 (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity)))
-                                                 (_.CHECKCAST //.$Function)
-                                                 (_.ALOAD arity)
-                                                 (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
-                                                 _.ARETURN)))))
-                   (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
-                   $d.fuse)
-        $Object (type.class "java.lang.Object" (list))
-        function-class (..reflection //.$Function)
-        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function-class (list) $Object (list)
-                              (|>> ($d.field #$.Public $.finalF partials-field type.int)
-                                   ($d.method #$.Public $.noneM "" (type.method [(list type.int) type.void (list)])
-                                              (|>> (_.ALOAD 0)
-                                                   (_.INVOKESPECIAL $Object "" nullary-init-methodT)
-                                                   (_.ALOAD 0)
-                                                   (_.ILOAD 1)
-                                                   (_.PUTFIELD //.$Function partials-field type.int)
-                                                   _.RETURN))
-                                   applyI))
-        payload ["1" bytecode]]
-    (do phase.monad
-      [_ (generation.execute! function-class [function-class bytecode])
-       _ (generation.save! false ["" "1"] payload)]
-      (wrap payload))))
-
-(def: #export translate
-  (Operation [Registry Output])
-  (do phase.monad
-    [runtime-payload ..translate-runtime
-     function-payload ..translate-function]
-    (wrap [(|> artifact.empty
-               artifact.resource
-               product.right
-               artifact.resource
-               product.right)
-           (row.row runtime-payload
-                    function-payload)])))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.lux
deleted file mode 100644
index 46f87142a..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.lux
+++ /dev/null
@@ -1,79 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["ex" exception (#+ exception:)]]
-   [data
-    [number
-     ["n" nat]]
-    [text
-     ["%" format (#+ format)]]
-    [collection
-     ["." list]]]
-   [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
-     [jvm (#+ Inst Operation Phase Generator)
-      ["_" inst]]]]]
-  ["." //
-   ["#." runtime]])
-
-(exception: #export (not-a-tuple {size Nat})
-  (ex.report ["Expected size" ">= 2"]
-             ["Actual size" (%.nat size)]))
-
-(def: #export (tuple generate archive members)
-  (Generator (List Synthesis))
-  (do {@ phase.monad}
-    [#let [size (list.size members)]
-     _ (phase.assert not-a-tuple size
-                     (n.>= 2 size))
-     membersI (|> members
-                  list.enumerate
-                  (monad.map @ (function (_ [idx member])
-                                 (do @
-                                   [memberI (generate archive member)]
-                                   (wrap (|>> _.DUP
-                                              (_.int (.int idx))
-                                              memberI
-                                              _.AASTORE)))))
-                  (:: @ map _.fuse))]
-    (wrap (|>> (_.int (.int size))
-               (_.array //runtime.$Value)
-               membersI))))
-
-(def: (flagI right?)
-  (-> Bit Inst)
-  (if right?
-    (_.string "")
-    _.NULL))
-
-(def: #export (variant generate archive [lefts right? member])
-  (Generator [Nat Bit Synthesis])
-  (do phase.monad
-    [memberI (generate archive member)]
-    (wrap (|>> (_.int (.int (if right?
-                              (.inc lefts)
-                              lefts)))
-               (flagI right?)
-               memberI
-               (_.INVOKESTATIC //.$Runtime
-                               "variant_make"
-                               (type.method [(list //runtime.$Tag //runtime.$Flag //runtime.$Value)
-                                             //.$Variant
-                                             (list)]))))))
diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux
deleted file mode 100644
index a4a3db1f5..000000000
--- a/new-luxc/source/luxc/lang/translation/r.lux
+++ /dev/null
@@ -1,216 +0,0 @@
-(.module:
-  lux
-  (lux (control ["ex" exception #+ exception:]
-                pipe
-                [monad #+ do])
-       (data [bit]
-             [maybe]
-             ["e" error #+ Error]
-             [text "text/" Eq]
-             text/format
-             (coll [array]))
-       [macro]
-       [io #+ IO Process io]
-       [host #+ class: interface: object]
-       (world [file #+ File]))
-  (luxc [lang]
-        (lang [".L" variable #+ Register]
-              (host [r #+ Expression]))
-        [".C" io]))
-
-(template []
-  [(exception: #export ( {message Text})
-     message)]
-
-  [No-Active-Module-Buffer]
-  [Cannot-Execute]
-
-  [No-Anchor]
-  )
-
-(host.import: java/lang/Object)
-
-(host.import: java/lang/String
-  (getBytes [String] #try [byte]))
-
-(host.import: java/lang/CharSequence)
-
-(host.import: java/lang/Appendable
-  (append [CharSequence] Appendable))
-
-(host.import: java/lang/StringBuilder
-  (new [])
-  (toString [] String))
-
-(host.import: javax/script/ScriptEngine
-  (eval [String] #try #? Object))
-
-(host.import: javax/script/ScriptEngineFactory
-  (getScriptEngine [] ScriptEngine))
-
-(type: #export Anchor [Text Register])
-
-(type: #export Host
-  {#context [Text Nat]
-   #anchor (Maybe Anchor)
-   #loader (-> Expression (Error Any))
-   #interpreter (-> Expression (Error Object))
-   #module-buffer (Maybe StringBuilder)
-   #program-buffer StringBuilder})
-
-(def: #export init
-  (IO Host)
-  (io (let [interpreter (|> (undefined)
-                            (ScriptEngineFactory::getScriptEngine []))]
-        {#context ["" +0]
-         #anchor #.None
-         #loader (function (_ code)
-                   (do e.Monad
-                     [_ (ScriptEngine::eval [(r.expression code)] interpreter)]
-                     (wrap [])))
-         #interpreter (function (_ code)
-                        (do e.Monad
-                          [output (ScriptEngine::eval [(r.expression code)] interpreter)]
-                          (wrap (maybe.default (:coerce Object [])
-                                               output))))
-         #module-buffer #.None
-         #program-buffer (StringBuilder::new [])})))
-
-(def: #export r-module-name Text "module.r")
-
-(def: #export init-module-buffer
-  (Meta Any)
-  (function (_ compiler)
-    (#e.Success [(update@ #.host
-                          (|>> (:coerce Host)
-                               (set@ #module-buffer (#.Some (StringBuilder::new [])))
-                               (:coerce Nothing))
-                          compiler)
-                 []])))
-
-(def: #export (with-sub-context expr)
-  (All [a] (-> (Meta a) (Meta [Text a])))
-  (function (_ compiler)
-    (let [old (:coerce Host (get@ #.host compiler))
-          [old-name old-sub] (get@ #context old)
-          new-name (format old-name "f___" (%i (.int old-sub)))]
-      (case (expr (set@ #.host
-                        (:coerce Nothing (set@ #context [new-name +0] old))
-                        compiler))
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.host
-                              (|>> (:coerce Host)
-                                   (set@ #context [old-name (inc old-sub)])
-                                   (:coerce Nothing))
-                              compiler')
-                     [new-name output]])
-
-        (#e.Error error)
-        (#e.Error error)))))
-
-(def: #export context
-  (Meta Text)
-  (function (_ compiler)
-    (#e.Success [compiler
-                 (|> (get@ #.host compiler)
-                     (:coerce Host)
-                     (get@ #context)
-                     (let> [name sub]
-                           name))])))
-
-(def: #export (with-anchor anchor expr)
-  (All [a] (-> Anchor (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [old (:coerce Host (get@ #.host compiler))]
-      (case (expr (set@ #.host
-                        (:coerce Nothing (set@ #anchor (#.Some anchor) old))
-                        compiler))
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.host
-                              (|>> (:coerce Host)
-                                   (set@ #anchor (get@ #anchor old))
-                                   (:coerce Nothing))
-                              compiler')
-                     output])
-
-        (#e.Error error)
-        (#e.Error error)))))
-
-(def: #export anchor
-  (Meta Anchor)
-  (function (_ compiler)
-    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor))
-      (#.Some anchor)
-      (#e.Success [compiler anchor])
-
-      #.None
-      ((lang.throw No-Anchor "") compiler))))
-
-(def: #export module-buffer
-  (Meta StringBuilder)
-  (function (_ compiler)
-    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer))
-      #.None
-      ((lang.throw No-Active-Module-Buffer "") compiler)
-      
-      (#.Some module-buffer)
-      (#e.Success [compiler module-buffer]))))
-
-(def: #export program-buffer
-  (Meta StringBuilder)
-  (function (_ compiler)
-    (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))])))
-
-(template [  ]
-  [(def: ( code)
-     (-> Expression (Meta ))
-     (function (_ compiler)
-       (let [runner (|> compiler (get@ #.host) (:coerce Host) (get@ ))]
-         (case (runner code)
-           (#e.Error error)
-           ((lang.throw Cannot-Execute error) compiler)
-           
-           (#e.Success output)
-           (#e.Success [compiler output])))))]
-
-  [load!     #loader      Any]
-  [interpret #interpreter Object]
-  )
-
-(def: #export variant-tag-field "luxVT")
-(def: #export variant-flag-field "luxVF")
-(def: #export variant-value-field "luxVV")
-
-(def: #export int-high-field "luxIH")
-(def: #export int-low-field "luxIL")
-
-(def: #export unit Text "")
-
-(def: #export (definition-name [module name])
-  (-> Name Text)
-  (lang.normalize-name (format module "$" name)))
-
-(def: #export (save code)
-  (-> Expression (Meta Any))
-  (do macro.Monad
-    [module-buffer module-buffer
-     #let [_ (Appendable::append [(:coerce CharSequence (r.expression code))]
-                                 module-buffer)]]
-    (load! code)))
-
-(def: #export run interpret)
-
-(def: #export (save-module! target)
-  (-> File (Meta (Process Any)))
-  (do macro.Monad
-    [module macro.current-module-name
-     module-buffer module-buffer
-     program-buffer program-buffer
-     #let [module-code (StringBuilder::toString [] module-buffer)
-           _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))]
-                                 program-buffer)]]
-    (wrap (ioC.write target
-                     (format (lang.normalize-name module) "/" r-module-name)
-                     (|> module-code
-                         (String::getBytes ["UTF-8"])
-                         e.assume)))))
diff --git a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux b/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
deleted file mode 100644
index 42460b620..000000000
--- a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
+++ /dev/null
@@ -1,195 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data [number]
-             [text]
-             text/format
-             (coll [list "list/" Functor Fold]
-                   (set ["set" unordered #+ Set])))
-       [macro #+ "meta/" Monad]
-       (macro [code]))
-  (luxc [lang]
-        (lang [".L" variable #+ Register Variable]
-              ["ls" synthesis #+ Synthesis Path]
-              (host [r #+ Expression SVar @@])))
-  [//]
-  (// [".T" runtime]
-      [".T" primitive]
-      [".T" reference]))
-
-(def: #export (translate-let translate register valueS bodyS)
-  (-> (-> Synthesis (Meta Expression)) Register Synthesis Synthesis
-      (Meta Expression))
-  (do macro.Monad
-    [valueO (translate valueS)
-     bodyO (translate bodyS)
-     #let [$register (referenceT.variable register)]]
-    (wrap (r.block
-           ($_ r.then
-               (r.set! $register valueO)
-               bodyO)))))
-
-(def: #export (translate-record-get translate valueS pathP)
-  (-> (-> Synthesis (Meta Expression)) Synthesis (List [Nat Bit])
-      (Meta Expression))
-  (do macro.Monad
-    [valueO (translate valueS)]
-    (wrap (list/fold (function (_ [idx tail?] source)
-                       (let [method (if tail?
-                                      runtimeT.product//right
-                                      runtimeT.product//left)]
-                         (method source (r.int (:coerce Int idx)))))
-                     valueO
-                     pathP))))
-
-(def: #export (translate-if testO thenO elseO)
-  (-> Expression Expression Expression Expression)
-  (r.if testO thenO elseO))
-
-(def: $savepoint (r.var "lux_pm_cursor_savepoint"))
-(def: $cursor (r.var "lux_pm_cursor"))
-
-(def: top r.length)
-(def: next (|>> r.length (r.+ (r.int 1))))
-(def: (push! value var)
-  (-> Expression SVar Expression)
-  (r.set-nth! (next (@@ var)) value var))
-(def: (pop! var)
-  (-> SVar Expression)
-  (r.set-nth! (top (@@ var)) r.null var))
-
-(def: (push-cursor! value)
-  (-> Expression Expression)
-  (push! value $cursor))
-
-(def: save-cursor!
-  Expression
-  (push! (r.slice (r.float 1.0) (r.length (@@ $cursor)) (@@ $cursor))
-         $savepoint))
-
-(def: restore-cursor!
-  Expression
-  (r.set! $cursor (r.nth (top (@@ $savepoint)) (@@ $savepoint))))
-
-(def: cursor-top
-  Expression
-  (|> (@@ $cursor) (r.nth (top (@@ $cursor)))))
-
-(def: pop-cursor!
-  Expression
-  (pop! $cursor))
-
-(def: pm-error (r.string "PM-ERROR"))
-
-(def: fail-pm! (r.stop pm-error))
-
-(def: $temp (r.var "lux_pm_temp"))
-
-(exception: #export (Unrecognized-Path {message Text})
-  message)
-
-(def: $alt_error (r.var "alt_error"))
-
-(def: (pm-catch handler)
-  (-> Expression Expression)
-  (r.function (list $alt_error)
-    (r.if (|> (@@ $alt_error) (r.= pm-error))
-      handler
-      (r.stop (@@ $alt_error)))))
-
-(def: (translate-pattern-matching' translate pathP)
-  (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
-  (case pathP
-    (^code ("lux case exec" (~ bodyS)))
-    (do macro.Monad
-      [bodyO (translate bodyS)]
-      (wrap bodyO))
-
-    (^code ("lux case pop"))
-    (meta/wrap pop-cursor!)
-
-    (^code ("lux case bind" (~ [_ (#.Nat register)])))
-    (meta/wrap (r.set! (referenceT.variable register) cursor-top))
-
-    (^template [ ]
-      [_ ( value)]
-      (meta/wrap (r.when (r.not (r.= (|> value ) cursor-top))
-                         fail-pm!)))
-    ([#.Bit  r.bool]
-     [#.Frac r.float]
-     [#.Text r.string])
-
-    (^template [ ]
-      [_ ( value)]
-      (meta/wrap (r.when (r.not (runtimeT.int//= (|> value ) cursor-top))
-                         fail-pm!)))
-    ([#.Nat  (<| runtimeT.int (:coerce Int))]
-     [#.Int  runtimeT.int]
-     [#.Rev  (<| runtimeT.int (:coerce Int))])
-
-    (^template [ ]
-      (^code ( (~ [_ (#.Nat idx)])))
-      (meta/wrap (push-cursor! ( cursor-top (r.int (:coerce Int idx))))))
-    (["lux case tuple left" runtimeT.product//left]
-     ["lux case tuple right" runtimeT.product//right])
-
-    (^template [ ]
-      (^code ( (~ [_ (#.Nat idx)])))
-      (meta/wrap ($_ r.then
-                     (r.set! $temp (runtimeT.sum//get cursor-top (r.int (:coerce Int idx)) ))
-                     (r.if (r.= r.null (@@ $temp))
-                       fail-pm!
-                       (push-cursor! (@@ $temp))))))
-    (["lux case variant left" r.null]
-     ["lux case variant right" (r.string "")])
-
-    (^code ("lux case seq" (~ leftP) (~ rightP)))
-    (do macro.Monad
-      [leftO (translate-pattern-matching' translate leftP)
-       rightO (translate-pattern-matching' translate rightP)]
-      (wrap ($_ r.then
-                leftO
-                rightO)))
-
-    (^code ("lux case alt" (~ leftP) (~ rightP)))
-    (do macro.Monad
-      [leftO (translate-pattern-matching' translate leftP)
-       rightO (translate-pattern-matching' translate rightP)]
-      (wrap (r.try ($_ r.then
-                       save-cursor!
-                       leftO)
-                   #.None
-                   (#.Some (pm-catch ($_ r.then
-                                         restore-cursor!
-                                         rightO)))
-                   #.None)))
-
-    _
-    (lang.throw Unrecognized-Path (%code pathP))
-    ))
-
-(def: (translate-pattern-matching translate pathP)
-  (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
-  (do macro.Monad
-    [pattern-matching! (translate-pattern-matching' translate pathP)]
-    (wrap (r.try pattern-matching!
-                 #.None
-                 (#.Some (pm-catch (r.stop (r.string "Invalid expression for pattern-matching."))))
-                 #.None))))
-
-(def: (initialize-pattern-matching! stack-init)
-  (-> Expression Expression)
-  ($_ r.then
-      (r.set! $cursor (r.list (list stack-init)))
-      (r.set! $savepoint (r.list (list)))))
-
-(def: #export (translate-case translate valueS pathP)
-  (-> (-> Synthesis (Meta Expression)) Synthesis Path (Meta Expression))
-  (do macro.Monad
-    [valueO (translate valueS)
-     pattern-matching! (translate-pattern-matching translate pathP)]
-    (wrap (r.block
-           ($_ r.then
-               (initialize-pattern-matching! valueO)
-               pattern-matching!)))))
diff --git a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
deleted file mode 100644
index 3c41fbe63..000000000
--- a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
+++ /dev/null
@@ -1,88 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                ["p" parser])
-       (data ["e" error]
-             text/format)
-       [macro]
-       (macro ["s" syntax]))
-  (luxc ["&" lang]
-        (lang [".L" variable #+ Variable Register]
-              [".L" extension]
-              ["ls" synthesis]
-              (host [r #+ Expression])))
-  [//]
-  (// [".T" runtime]
-      [".T" primitive]
-      [".T" structure]
-      [".T" reference]
-      [".T" function]
-      [".T" case]
-      [".T" procedure])
-  )
-
-(template []
-  [(exception: #export ( {message Text})
-     message)]
-
-  [Invalid-Function-Syntax]
-  [Unrecognized-Synthesis]
-  )
-
-(def: #export (translate synthesis)
-  (-> ls.Synthesis (Meta Expression))
-  (case synthesis
-    (^code [])
-    (:: macro.Monad wrap runtimeT.unit)
-
-    (^template [ ]
-      [_ ( value)]
-      ( value))
-    ([#.Bit primitiveT.translate-bit]
-     [#.Nat  primitiveT.translate-nat]
-     [#.Int  primitiveT.translate-int]
-     [#.Rev  primitiveT.translate-rev]
-     [#.Frac primitiveT.translate-frac]
-     [#.Text primitiveT.translate-text])
-
-    (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS)))
-    (structureT.translate-variant translate tag last? valueS)
-
-    (^code [(~ singleton)])
-    (translate singleton)
-
-    (^code [(~+ members)])
-    (structureT.translate-tuple translate members)
-
-    (^ [_ (#.Form (list [_ (#.Int var)]))])
-    (referenceT.translate-variable var)
-
-    [_ (#.Identifier definition)]
-    (referenceT.translate-definition definition)
-
-    (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
-    (caseT.translate-let translate register inputS exprS)
-
-    (^code ("lux case" (~ inputS) (~ pathPS)))
-    (caseT.translate-case translate inputS pathPS)
-
-    (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
-    (case (s.run environment (p.some s.int))
-      (#e.Success environment)
-      (functionT.translate-function translate environment arity bodyS)
-
-      _
-      (&.throw Invalid-Function-Syntax (%code synthesis)))
-
-    (^code ("lux call" (~ functionS) (~+ argsS)))
-    (functionT.translate-apply translate functionS argsS)
-
-    (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
-    (procedureT.translate-procedure translate procedure argsS)
-    ## (do macro.Monad
-    ##   [translation (extensionL.find-translation procedure)]
-    ##   (translation argsS))
-
-    _
-    (&.throw Unrecognized-Synthesis (%code synthesis))))
diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
deleted file mode 100644
index f39a5e1a2..000000000
--- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
+++ /dev/null
@@ -1,94 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                pipe)
-       (data [product]
-             [text]
-             text/format
-             (coll [list "list/" Functor Fold]))
-       [macro])
-  (luxc ["&" lang]
-        (lang ["ls" synthesis]
-              [".L" variable #+ Variable]
-              (host [r #+ Expression @@])))
-  [//]
-  (// [".T" reference]))
-
-(def: #export (translate-apply translate functionS argsS+)
-  (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression))
-  (do {@ macro.Monad}
-    [functionO (translate functionS)
-     argsO+ (monad.map @ translate argsS+)]
-    (wrap (r.apply argsO+ functionO))))
-
-(def: $curried (r.var "curried"))
-
-(def: (input-declaration register)
-  (r.set! (referenceT.variable (inc register))
-          (|> (@@ $curried) (r.nth (|> register inc .int r.int)))))
-
-(def: (with-closure function-name inits function-definition)
-  (-> Text (List Expression) Expression (Meta Expression))
-  (let [$closure (r.var (format function-name "___CLOSURE"))]
-    (case inits
-      #.Nil
-      (do macro.Monad
-        [_ (//.save function-definition)]
-        (wrap (r.global function-name)))
-
-      _
-      (do macro.Monad
-        [_ (//.save (r.set! $closure
-                            (r.function (|> (list.enumerate inits)
-                                            (list/map (|>> product.left referenceT.closure)))
-                              ($_ r.then
-                                  function-definition
-                                  (r.global function-name)))))]
-        (wrap (r.apply inits (@@ $closure)))))))
-
-(def: #export (translate-function translate env arity bodyS)
-  (-> (-> ls.Synthesis (Meta Expression))
-      (List Variable) ls.Arity ls.Synthesis
-      (Meta Expression))
-  (do {@ macro.Monad}
-    [[function-name bodyO] (//.with-sub-context
-                             (do @
-                               [function-name //.context]
-                               (//.with-anchor [function-name +1]
-                                 (translate bodyS))))
-     closureO+ (monad.map @ referenceT.translate-variable env)
-     #let [arityO (|> arity .int r.int)
-           $num_args (r.var "num_args")
-           $function (r.var function-name)
-           var-args (r.code (format "list" (r.expression (@@ r.var-args))))
-           apply-poly (function (_ args func)
-                        (r.apply (list func args) (r.global "do.call")))]]
-    (with-closure function-name closureO+
-      (r.set! $function
-              (r.function (list r.var-args)
-                ($_ r.then
-                    (r.set! $curried var-args)
-                    (r.set! $num_args (r.length (@@ $curried)))
-                    (r.cond (list [(|> (@@ $num_args) (r.= arityO))
-                                   ($_ r.then
-                                       (r.set! (referenceT.variable +0) (@@ $function))
-                                       (|> (list.n/range +0 (dec arity))
-                                           (list/map input-declaration)
-                                           (list/fold r.then bodyO)))]
-                                  [(|> (@@ $num_args) (r.> arityO))
-                                   (let [arity-args (r.slice (r.int 1) arityO (@@ $curried))
-                                         output-func-args (r.slice (|> arityO (r.+ (r.int 1)))
-                                                                   (@@ $num_args)
-                                                                   (@@ $curried))]
-                                     (|> (@@ $function)
-                                         (apply-poly arity-args)
-                                         (apply-poly output-func-args)))])
-                            ## (|> (@@ $num_args) (r.< arityO))
-                            (let [$missing (r.var "missing")]
-                              (r.function (list r.var-args)
-                                ($_ r.then
-                                    (r.set! $missing var-args)
-                                    (|> (@@ $function)
-                                        (apply-poly (r.apply (list (@@ $curried) (@@ $missing))
-                                                             (r.global "append"))))))))))))
-    ))
diff --git a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
deleted file mode 100644
index f1197e5ce..000000000
--- a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
+++ /dev/null
@@ -1,37 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       (data [text]
-             text/format
-             (coll [list "list/" Functor]))
-       [macro])
-  (luxc [lang]
-        (lang ["ls" synthesis]
-              (host [r #+ Expression @@])))
-  [//]
-  (// [".T" reference]))
-
-(def: #export (translate-loop translate offset initsS+ bodyS)
-  (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis
-      (Meta Expression))
-  (do {@ macro.Monad}
-    [loop-name (|> (macro.gensym "loop")
-                   (:: @ map (|>> %code lang.normalize-name)))
-     initsO+ (monad.map @ translate initsS+)
-     bodyO (//.with-anchor [loop-name offset]
-             (translate bodyS))
-     #let [$loop-name (r.var loop-name)
-           @loop-name (@@ $loop-name)]
-     _ (//.save (r.set! $loop-name
-                        (r.function (|> (list.n/range +0 (dec (list.size initsS+)))
-                                        (list/map (|>> (n/+ offset) referenceT.variable)))
-                          bodyO)))]
-    (wrap (r.apply initsO+ @loop-name))))
-
-(def: #export (translate-recur translate argsS+)
-  (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis)
-      (Meta Expression))
-  (do {@ macro.Monad}
-    [[loop-name offset] //.anchor
-     argsO+ (monad.map @ translate argsS+)]
-    (wrap (r.apply argsO+ (r.global loop-name)))))
diff --git a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
deleted file mode 100644
index 8bc7da848..000000000
--- a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
+++ /dev/null
@@ -1,22 +0,0 @@
-(.module:
-  lux
-  (lux [macro "meta/" Monad])
-  (luxc (lang (host [r #+ Expression])))
-  [//]
-  (// [".T" runtime]))
-
-(def: #export translate-bit
-  (-> Bit (Meta Expression))
-  (|>> r.bool meta/wrap))
-
-(def: #export translate-int
-  (-> Int (Meta Expression))
-  (|>> runtimeT.int meta/wrap))
-
-(def: #export translate-frac
-  (-> Frac (Meta Expression))
-  (|>> r.float meta/wrap))
-
-(def: #export translate-text
-  (-> Text (Meta Expression))
-  (|>> r.string meta/wrap))
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
deleted file mode 100644
index 85ccd90dc..000000000
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ /dev/null
@@ -1,339 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                ["p" parser])
-       (data ["e" error]
-             [text]
-             text/format
-             [number]
-             (coll [list "list/" Functor]
-                   (dictionary ["dict" unordered #+ Dict])))
-       [macro #+ with-gensyms]
-       (macro [code]
-              ["s" syntax #+ syntax:])
-       [host])
-  (luxc ["&" lang]
-        (lang ["la" analysis]
-              ["ls" synthesis]
-              (host [r #+ Expression])))
-  [///]
-  (/// [".T" runtime]
-       [".T" case]
-       [".T" function]
-       [".T" loop]))
-
-## [Types]
-(type: #export Translator
-  (-> ls.Synthesis (Meta Expression)))
-
-(type: #export Proc
-  (-> Translator (List ls.Synthesis) (Meta Expression)))
-
-(type: #export Bundle
-  (Dict Text Proc))
-
-(syntax: (Vector {size s.nat} elemT)
-  (wrap (list (` [(~+ (list.repeat size elemT))]))))
-
-(type: #export Nullary (-> (Vector +0 Expression) Expression))
-(type: #export Unary   (-> (Vector +1 Expression) Expression))
-(type: #export Binary  (-> (Vector +2 Expression) Expression))
-(type: #export Trinary (-> (Vector +3 Expression) Expression))
-(type: #export Variadic (-> (List Expression) Expression))
-
-## [Utils]
-(def: #export (install name unnamed)
-  (-> Text (-> Text Proc)
-      (-> Bundle Bundle))
-  (dict.put name (unnamed name)))
-
-(def: #export (prefix prefix bundle)
-  (-> Text Bundle Bundle)
-  (|> bundle
-      dict.entries
-      (list/map (function (_ [key val]) [(format prefix " " key) val]))
-      (dict.from-list text.Hash)))
-
-(def: (wrong-arity proc expected actual)
-  (-> Text Nat Nat Text)
-  (format "Wrong number of arguments for " (%t proc) "\n"
-          "Expected: " (|> expected .int %i) "\n"
-          "  Actual: " (|> actual .int %i)))
-
-(syntax: (arity: {name s.local-identifier} {arity s.nat})
-  (with-gensyms [g!_ g!proc g!name g!translate g!inputs]
-    (do {@ macro.monad}
-      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
-      (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc))
-                       (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression)
-                           (-> Text ..Proc))
-                       (function ((~ g!_) (~ g!name))
-                         (function ((~ g!_) (~ g!translate) (~ g!inputs))
-                           (case (~ g!inputs)
-                             (^ (list (~+ g!input+)))
-                             (do macro.Monad
-                               [(~+ (|> g!input+
-                                        (list/map (function (_ g!input)
-                                                    (list g!input (` ((~ g!translate) (~ g!input))))))
-                                        list.concat))]
-                               ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
-
-                             (~' _)
-                             (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
-
-(arity: nullary +0)
-(arity: unary +1)
-(arity: binary +2)
-(arity: trinary +3)
-
-(def: #export (variadic proc)
-  (-> Variadic (-> Text Proc))
-  (function (_ proc-name)
-    (function (_ translate inputsS)
-      (do {@ macro.Monad}
-        [inputsI (monad.map @ translate inputsS)]
-        (wrap (proc inputsI))))))
-
-## [Procedures]
-## [[Lux]]
-(def: (lux//is [leftO rightO])
-  Binary
-  (r.apply (list leftO rightO)
-           (r.global "identical")))
-
-(def: (lux//if [testO thenO elseO])
-  Trinary
-  (caseT.translate-if testO thenO elseO))
-
-(def: (lux//try riskyO)
-  Unary
-  (runtimeT.lux//try riskyO))
-
-(exception: #export (Wrong-Syntax {message Text})
-  message)
-
-(def: #export (wrong-syntax procedure args)
-  (-> Text (List ls.Synthesis) Text)
-  (format "Procedure: " procedure "\n"
-          "Arguments: " (%code (code.tuple args))))
-
-(def: lux//loop
-  (-> Text Proc)
-  (function (_ proc-name)
-    (function (_ translate inputsS)
-      (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any))
-        (#e.Success [offset initsS+ bodyS])
-        (loopT.translate-loop translate offset initsS+ bodyS)
-
-        (#e.Error error)
-        (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
-      )))
-
-(def: lux//recur
-  (-> Text Proc)
-  (function (_ proc-name)
-    (function (_ translate inputsS)
-      (loopT.translate-recur translate inputsS))))
-
-(def: lux-procs
-  Bundle
-  (|> (dict.new text.Hash)
-      (install "is" (binary lux//is))
-      (install "try" (unary lux//try))
-      (install "if" (trinary lux//if))
-      (install "loop" lux//loop)
-      (install "recur" lux//recur)
-      ))
-
-## [[Bits]]
-(template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-  
-  [bit//and runtimeT.bit//and]
-  [bit//or  runtimeT.bit//or]
-  [bit//xor runtimeT.bit//xor]
-  )
-
-(template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( (runtimeT.int64-low paramO) subjectO))]
-
-  [bit//left-shift          runtimeT.bit//left-shift]
-  [bit//arithmetic-right-shift  runtimeT.bit//arithmetic-right-shift]
-  [bit//logical-right-shift runtimeT.bit//logical-right-shift]
-  )
-
-(def: bit-procs
-  Bundle
-  (<| (prefix "bit")
-      (|> (dict.new text.Hash)
-          (install "and" (binary bit//and))
-          (install "or" (binary bit//or))
-          (install "xor" (binary bit//xor))
-          (install "left-shift" (binary bit//left-shift))
-          (install "logical-right-shift" (binary bit//logical-right-shift))
-          (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
-          )))
-
-## [[Numbers]]
-(host.import: java/lang/Double
-  (#static MIN_VALUE Double)
-  (#static MAX_VALUE Double))
-
-(template [  ]
-  [(def: ( _)
-     Nullary
-     ( ))]
-
-  [frac//smallest Double::MIN_VALUE            r.float]
-  [frac//min      (f/* -1.0 Double::MAX_VALUE) r.float]
-  [frac//max      Double::MAX_VALUE            r.float]
-  )
-
-(template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     (|> subjectO ( paramO)))]
-
-  [int//add        runtimeT.int//+]
-  [int//sub        runtimeT.int//-]
-  [int//mul        runtimeT.int//*]
-  [int//div        runtimeT.int///]
-  [int//rem        runtimeT.int//%]
-  )
-
-(template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-
-  [frac//add r.+]
-  [frac//sub r.-]
-  [frac//mul r.*]
-  [frac//div r./]
-  [frac//rem r.%%]
-  [frac//=   r.=]
-  [frac//<   r.<]
-
-  [text//=   r.=]
-  [text//<   r.<]
-  )
-
-(template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-
-  [int//= runtimeT.int//=]
-  [int//< runtimeT.int//<]
-  )
-
-(def: (apply1 func)
-  (-> Expression (-> Expression Expression))
-  (function (_ value)
-    (r.apply (list value) func)))
-
-(def: int//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8"))))
-
-(def: int-procs
-  Bundle
-  (<| (prefix "int")
-      (|> (dict.new text.Hash)
-          (install "+" (binary int//add))
-          (install "-" (binary int//sub))
-          (install "*" (binary int//mul))
-          (install "/" (binary int//div))
-          (install "%" (binary int//rem))
-          (install "=" (binary int//=))
-          (install "<" (binary int//<))
-          (install "to-frac" (unary runtimeT.int//to-float))
-          (install "char" (unary int//char)))))
-
-(def: (frac//encode value)
-  (-> Expression Expression)
-  (r.apply (list (r.string "%f") value) (r.global "sprintf")))
-
-(def: frac-procs
-  Bundle
-  (<| (prefix "frac")
-      (|> (dict.new text.Hash)
-          (install "+" (binary frac//add))
-          (install "-" (binary frac//sub))
-          (install "*" (binary frac//mul))
-          (install "/" (binary frac//div))
-          (install "%" (binary frac//rem))
-          (install "=" (binary frac//=))
-          (install "<" (binary frac//<))
-          (install "smallest" (nullary frac//smallest))
-          (install "min" (nullary frac//min))
-          (install "max" (nullary frac//max))
-          (install "to-int" (unary (apply1 (r.global "as.integer"))))
-          (install "encode" (unary frac//encode))
-          (install "decode" (unary runtimeT.frac//decode)))))
-
-## [[Text]]
-(def: (text//concat [subjectO paramO])
-  Binary
-  (r.apply (list subjectO paramO) (r.global "paste0")))
-
-(def: (text//char [subjectO paramO])
-  Binary
-  (runtimeT.text//char subjectO paramO))
-
-(def: (text//clip [subjectO paramO extraO])
-  Trinary
-  (runtimeT.text//clip subjectO paramO extraO))
-
-(def: (text//index [textO partO startO])
-  Trinary
-  (runtimeT.text//index textO partO startO))
-
-(def: text-procs
-  Bundle
-  (<| (prefix "text")
-      (|> (dict.new text.Hash)
-          (install "=" (binary text//=))
-          (install "<" (binary text//<))
-          (install "concat" (binary text//concat))
-          (install "index" (trinary text//index))
-          (install "size" (unary (|>> (apply1 (r.global "nchar")) runtimeT.int//from-float)))
-          (install "char" (binary text//char))
-          (install "clip" (trinary text//clip))
-          )))
-
-## [[IO]]
-(def: (io//exit input)
-  Unary
-  (r.apply-kw (list)
-              (list ["status" (runtimeT.int//to-float input)])
-              (r.global "quit")))
-
-(def: (void code)
-  (-> Expression Expression)
-  (r.block (r.then code runtimeT.unit)))
-
-(def: io-procs
-  Bundle
-  (<| (prefix "io")
-      (|> (dict.new text.Hash)
-          (install "log" (unary (|>> r.print ..void)))
-          (install "error" (unary r.stop))
-          (install "exit" (unary io//exit))
-          (install "current-time" (nullary (function (_ _)
-                                             (runtimeT.io//current-time! runtimeT.unit)))))))
-
-## [Bundles]
-(def: #export procedures
-  Bundle
-  (<| (prefix "lux")
-      (|> lux-procs
-          (dict.merge bit-procs)
-          (dict.merge int-procs)
-          (dict.merge frac-procs)
-          (dict.merge text-procs)
-          (dict.merge io-procs)
-          )))
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux
deleted file mode 100644
index 3bd33955f..000000000
--- a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux
+++ /dev/null
@@ -1,89 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       (data [text]
-             text/format
-             (coll [list "list/" Functor]
-                   (dictionary ["dict" unordered #+ Dict])))
-       [macro "macro/" Monad])
-  (luxc ["&" lang]
-        (lang ["la" analysis]
-              ["ls" synthesis]
-              (host [ruby #+ Ruby Expression Statement])))
-  [///]
-  (/// [".T" runtime])
-  (// ["@" common]))
-
-## (template [ ]
-##   [(def: ( _) @.Nullary )]
-
-##   [lua//nil      "nil"]
-##   [lua//table    "{}"]
-##   )
-
-## (def: (lua//global proc translate inputs)
-##   (-> Text @.Proc)
-##   (case inputs
-##     (^ (list [_ (#.Text name)]))
-##     (do macro.Monad
-##       []
-##       (wrap name))
-
-##     _
-##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
-
-## (def: (lua//call proc translate inputs)
-##   (-> Text @.Proc)
-##   (case inputs
-##     (^ (list& functionS argsS+))
-##     (do {@ macro.Monad}
-##       [functionO (translate functionS)
-##        argsO+ (monad.map @ translate argsS+)]
-##       (wrap (lua.apply functionO argsO+)))
-
-##     _
-##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
-
-## (def: lua-procs
-##   @.Bundle
-##   (|> (dict.new text.Hash)
-##       (@.install "nil" (@.nullary lua//nil))
-##       (@.install "table" (@.nullary lua//table))
-##       (@.install "global" lua//global)
-##       (@.install "call" lua//call)))
-
-## (def: (table//call proc translate inputs)
-##   (-> Text @.Proc)
-##   (case inputs
-##     (^ (list& tableS [_ (#.Text field)] argsS+))
-##     (do {@ macro.Monad}
-##       [tableO (translate tableS)
-##        argsO+ (monad.map @ translate argsS+)]
-##       (wrap (lua.method field tableO argsO+)))
-
-##     _
-##     (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
-
-## (def: (table//get [fieldO tableO])
-##   @.Binary
-##   (runtimeT.lua//get tableO fieldO))
-
-## (def: (table//set [fieldO valueO tableO])
-##   @.Trinary
-##   (runtimeT.lua//set tableO fieldO valueO))
-
-## (def: table-procs
-##   @.Bundle
-##   (<| (@.prefix "table")
-##       (|> (dict.new text.Hash)
-##           (@.install "call" table//call)
-##           (@.install "get" (@.binary table//get))
-##           (@.install "set" (@.trinary table//set)))))
-
-(def: #export procedures
-  @.Bundle
-  (<| (@.prefix "lua")
-      (dict.new text.Hash)
-      ## (|> lua-procs
-      ##     (dict.merge table-procs))
-      ))
diff --git a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
deleted file mode 100644
index 7de1c74ee..000000000
--- a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
+++ /dev/null
@@ -1,42 +0,0 @@
-(.module:
-  lux
-  (lux [macro]
-       (data [text]
-             text/format))
-  (luxc ["&" lang]
-        (lang [".L" variable #+ Variable Register]
-              (host [r #+ Expression SVar @@])))
-  [//]
-  (// [".T" runtime]))
-
-(template [  ]
-  [(def: #export ( register)
-     (-> Register SVar)
-     (r.var (format  (%i (.int register)))))
-   
-   (def: #export ( register)
-     (-> Register (Meta Expression))
-     (:: macro.Monad wrap (@@ ( register))))]
-
-  [closure  translate-captured "c"]
-  [variable translate-local    "v"])
-
-(def: #export (local var)
-  (-> Variable SVar)
-  (if (variableL.captured? var)
-    (closure (variableL.captured-register var))
-    (variable (.nat var))))
-
-(def: #export (translate-variable var)
-  (-> Variable (Meta Expression))
-  (if (variableL.captured? var)
-    (translate-captured (variableL.captured-register var))
-    (translate-local (.nat var))))
-
-(def: #export global
-  (-> Name SVar)
-  (|>> //.definition-name r.var))
-
-(def: #export (translate-definition name)
-  (-> Name (Meta Expression))
-  (:: macro.Monad wrap (@@ (global name))))
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
deleted file mode 100644
index d641041d2..000000000
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ /dev/null
@@ -1,802 +0,0 @@
-(.module:
-  lux
-  (lux (control ["p" parser "p/" Monad]
-                [monad #+ do])
-       (data [bit]
-             [number (#+ hex) ("int/" Interval)]
-             text/format
-             (coll [list "list/" Monad]))
-       [macro]
-       (macro [code]
-              ["s" syntax #+ syntax:])
-       [io #+ Process])
-  [//]
-  (luxc [lang]
-        (lang (host [r #+ SVar Expression @@]))))
-
-(def: prefix Text "LuxRuntime")
-
-(def: #export unit Expression (r.string //.unit))
-
-(def: full-32 (hex "+FFFFFFFF"))
-(def: half-32 (hex "+7FFFFFFF"))
-(def: post-32 (hex "+100000000"))
-
-(def: (cap-32 input)
-  (-> Nat Int)
-  (cond (n/> full-32 input)
-        (|> input (bit.and full-32) cap-32)
-        
-        (n/> half-32 input)
-        (|> post-32 (n/- input) .int (i/* -1))
-        
-        ## else
-        (.int input)))
-
-(def: high-32 (bit.logical-right-shift +32))
-(def: low-32 (|>> (bit.and (hex "+FFFFFFFF"))))
-
-(def: #export (int value)
-  (-> Int Expression)
-  (let [value (.nat value)
-        high (|> value ..high-32 cap-32)
-        low (|> value ..low-32 cap-32)]
-    (r.named-list (list [//.int-high-field (r.int high)]
-                        [//.int-low-field (r.int low)]))))
-
-(def: (flag value)
-  (-> Bit Expression)
-  (if value
-    (r.string "")
-    r.null))
-
-(def: (variant' tag last? value)
-  (-> Expression Expression Expression Expression)
-  (r.named-list (list [//.variant-tag-field tag]
-                      [//.variant-flag-field last?]
-                      [//.variant-value-field value])))
-
-(def: #export (variant tag last? value)
-  (-> Nat Bit Expression Expression)
-  (variant' (r.int (.int tag))
-            (flag last?)
-            value))
-
-(def: #export none
-  Expression
-  (variant +0 #0 unit))
-
-(def: #export some
-  (-> Expression Expression)
-  (variant +1 #1))
-
-(def: #export left
-  (-> Expression Expression)
-  (variant +0 #0))
-
-(def: #export right
-  (-> Expression Expression)
-  (variant +1 #1))
-
-(type: Runtime Expression)
-
-(def: declaration
-  (s.Syntax [Text (List Text)])
-  (p.either (p.seq s.local-identifier (p/wrap (list)))
-            (s.form (p.seq s.local-identifier (p.some s.local-identifier)))))
-
-(syntax: (runtime: {[name args] declaration}
-           definition)
-  (let [implementation (code.local-identifier (format "@@" name))
-        runtime (format prefix "__" (lang.normalize-name name))
-        $runtime (` (r.var (~ (code.text runtime))))
-        @runtime (` (@@ (~ $runtime)))
-        argsC+ (list/map code.local-identifier args)
-        argsLC+ (list/map (|>> lang.normalize-name (format "LRV__") code.text (~) (r.var) (`))
-                          args)
-        declaration (` ((~ (code.local-identifier name))
-                        (~+ argsC+)))
-        type (` (-> (~+ (list.repeat (list.size argsC+) (` r.Expression)))
-                    r.Expression))]
-    (wrap (list (` (def: (~' #export) (~ declaration)
-                     (~ type)
-                     (~ (case argsC+
-                          #.Nil
-                          @runtime
-
-                          _
-                          (` (r.apply (list (~+ argsC+)) (~ @runtime)))))))
-                (` (def: (~ implementation)
-                     r.Expression
-                     (~ (case argsC+
-                          #.Nil
-                          (` (r.set! (~ $runtime) (~ definition)))
-
-                          _
-                          (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
-                                           (list/map (function (_ [left right])
-                                                       (list left right)))
-                                           list/join))]
-                               (r.set! (~ $runtime)
-                                       (r.function (list (~+ argsLC+))
-                                         (~ definition)))))))))))))
-
-(syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))}
-                   body)
-  (wrap (list (` (let [(~+ (|> vars
-                               (list/map (function (_ var)
-                                           (list (code.local-identifier var)
-                                                 (` (r.var (~ (code.text (format "LRV__" (lang.normalize-name var)))))))))
-                               list/join))]
-                   (~ body))))))
-
-(def: high-shift (r.bit-shl (r.int 32)))
-
-(runtime: f2^32 (|> (r.int 2) (r.** (r.int 32))))
-(runtime: f2^63 (|> (r.int 2) (r.** (r.int 63))))
-
-(def: (as-double value)
-  (-> Expression Expression)
-  (r.apply (list value) (r.global "as.double")))
-
-(def: (as-integer value)
-  (-> Expression Expression)
-  (r.apply (list value) (r.global "as.integer")))
-
-(runtime: (int//unsigned-low input)
-  (with-vars [low]
-    ($_ r.then
-        (r.set! low (|> (@@ input) (r.nth (r.string //.int-low-field))))
-        (r.if (|> (@@ low) (r.>= (r.int 0)))
-          (@@ low)
-          (|> (@@ low) (r.+ f2^32))))))
-
-(runtime: (int//to-float input)
-  (let [high (|> (@@ input)
-                 (r.nth (r.string //.int-high-field))
-                 high-shift)
-        low (|> (@@ input)
-                int//unsigned-low)]
-    (|> high (r.+ low) as-double)))
-
-(runtime: (int//new high low)
-  (r.named-list (list [//.int-high-field (as-integer (@@ high))]
-                      [//.int-low-field (as-integer (@@ low))])))
-
-(template [ ]
-  [(runtime: 
-     (..int ))]
-
-  [int//zero 0]
-  [int//one 1]
-  [int//min int/bottom]
-  [int//max int/top]
-  )
-
-(def: #export int64-high (r.nth (r.string //.int-high-field)))
-(def: #export int64-low (r.nth (r.string //.int-low-field)))
-
-(runtime: (bit//not input)
-  (int//new (|> (@@ input) int64-high r.bit-not)
-            (|> (@@ input) int64-low r.bit-not)))
-
-(runtime: (int//+ param subject)
-  (with-vars [sH sL pH pL
-              x00 x16 x32 x48]
-    ($_ r.then
-        (r.set! sH (|> (@@ subject) int64-high))
-        (r.set! sL (|> (@@ subject) int64-low))
-        (r.set! pH (|> (@@ param) int64-high))
-        (r.set! pL (|> (@@ param) int64-low))
-        (let [bits16 (r.code "0xFFFF")
-              move-top-16 (r.bit-shl (r.int 16))
-              top-16 (r.bit-ushr (r.int 16))
-              bottom-16 (r.bit-and bits16)
-              split-16 (function (_ source)
-                         [(|> source top-16)
-                          (|> source bottom-16)])
-              split-int (function (_ high low)
-                          [(split-16 high)
-                           (split-16 low)])
-              
-              [[s48 s32] [s16 s00]] (split-int (@@ sH) (@@ sL))
-              [[p48 p32] [p16 p00]] (split-int (@@ pH) (@@ pL))
-              new-half (function (_ top bottom)
-                         (|> top bottom-16 move-top-16
-                             (r.bit-or (bottom-16 bottom))))]
-          ($_ r.then
-              (r.set! x00 (|> s00 (r.+ p00)))
-              (r.set! x16 (|> (@@ x00) top-16 (r.+ s16) (r.+ p16)))
-              (r.set! x32 (|> (@@ x16) top-16 (r.+ s32) (r.+ p32)))
-              (r.set! x48 (|> (@@ x32) top-16 (r.+ s48) (r.+ p48)))
-              (int//new (new-half (@@ x48) (@@ x32))
-                        (new-half (@@ x16) (@@ x00))))))))
-
-(runtime: (int//= reference sample)
-  (let [n/a? (function (_ value)
-               (r.apply (list value) (r.global "is.na")))
-        isTRUE? (function (_ value)
-                  (r.apply (list value) (r.global "isTRUE")))
-        comparison (: (-> (-> Expression Expression) Expression)
-                      (function (_ field)
-                        (|> (|> (field (@@ sample)) (r.= (field (@@ reference))))
-                            (r.or (|> (n/a? (field (@@ sample)))
-                                      (r.and (n/a? (field (@@ reference)))))))))]
-    (|> (comparison int64-high)
-        (r.and (comparison int64-low))
-        isTRUE?)))
-
-(runtime: (int//negate input)
-  (r.if (|> (@@ input) (int//= int//min))
-    int//min
-    (|> (@@ input) bit//not (int//+ int//one))))
-
-(runtime: int//-one
-  (int//negate int//one))
-
-(runtime: (int//- param subject)
-  (int//+ (int//negate (@@ param)) (@@ subject)))
-
-(runtime: (int//< reference sample)
-  (with-vars [r-? s-?]
-    ($_ r.then
-        (r.set! s-? (|> (@@ sample) int64-high (r.< (r.int 0))))
-        (r.set! r-? (|> (@@ reference) int64-high (r.< (r.int 0))))
-        (|> (|> (@@ s-?) (r.and (r.not (@@ r-?))))
-            (r.or (|> (r.not (@@ s-?)) (r.and (@@ r-?)) r.not))
-            (r.or (|> (@@ sample)
-                      (int//- (@@ reference))
-                      int64-high
-                      (r.< (r.int 0))))))))
-
-(runtime: (int//from-float input)
-  (r.cond (list [(r.apply (list (@@ input)) (r.global "is.nan"))
-                 int//zero]
-                [(|> (@@ input) (r.<= (r.negate f2^63)))
-                 int//min]
-                [(|> (@@ input) (r.+ (r.float 1.0)) (r.>= f2^63))
-                 int//max]
-                [(|> (@@ input) (r.< (r.float 0.0)))
-                 (|> (@@ input) r.negate int//from-float int//negate)])
-          (int//new (|> (@@ input) (r./ f2^32))
-                    (|> (@@ input) (r.%% f2^32)))))
-
-(runtime: (int//* param subject)
-  (with-vars [sH sL pH pL
-              x00 x16 x32 x48]
-    ($_ r.then
-        (r.set! sH (|> (@@ subject) int64-high))
-        (r.set! pH (|> (@@ param) int64-high))
-        (let [negative-subject? (|> (@@ sH) (r.< (r.int 0)))
-              negative-param? (|> (@@ pH) (r.< (r.int 0)))]
-          (r.cond (list [negative-subject?
-                         (r.if negative-param?
-                           (int//* (int//negate (@@ param))
-                                   (int//negate (@@ subject)))
-                           (int//negate (int//* (@@ param)
-                                                (int//negate (@@ subject)))))]
-
-                        [negative-param?
-                         (int//negate (int//* (int//negate (@@ param))
-                                              (@@ subject)))])
-                  ($_ r.then
-                      (r.set! sL (|> (@@ subject) int64-low))
-                      (r.set! pL (|> (@@ param) int64-low))
-                      (let [bits16 (r.code "0xFFFF")
-                            move-top-16 (r.bit-shl (r.int 16))
-                            top-16 (r.bit-ushr (r.int 16))
-                            bottom-16 (r.bit-and bits16)
-                            split-16 (function (_ source)
-                                       [(|> source top-16)
-                                        (|> source bottom-16)])
-                            split-int (function (_ high low)
-                                        [(split-16 high)
-                                         (split-16 low)])
-                            new-half (function (_ top bottom)
-                                       (|> top bottom-16 move-top-16
-                                           (r.bit-or (bottom-16 bottom))))
-                            x16-top (|> (@@ x16) top-16)
-                            x32-top (|> (@@ x32) top-16)]
-                        (with-vars [s48 s32 s16 s00
-                                    p48 p32 p16 p00]
-                          (let [[[_s48 _s32] [_s16 _s00]] (split-int (@@ sH) (@@ sL))
-                                [[_p48 _p32] [_p16 _p00]] (split-int (@@ pH) (@@ pL))
-                                set-subject-chunks! ($_ r.then (r.set! s48 _s48) (r.set! s32 _s32) (r.set! s16 _s16) (r.set! s00 _s00))
-                                set-param-chunks! ($_ r.then (r.set! p48 _p48) (r.set! p32 _p32) (r.set! p16 _p16) (r.set! p00 _p00))]
-                            ($_ r.then
-                                set-subject-chunks!
-                                set-param-chunks!
-                                (r.set! x00 (|> (@@ s00) (r.* (@@ p00))))
-                                (r.set! x16 (|> (@@ x00) top-16 (r.+ (|> (@@ s16) (r.* (@@ p00))))))
-                                (r.set! x32 x16-top)
-                                (r.set! x16 (|> (@@ x16) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p16))))))
-                                (r.set! x32 (|> (@@ x32) (r.+ x16-top) (r.+ (|> (@@ s32) (r.* (@@ p00))))))
-                                (r.set! x48 x32-top)
-                                (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s16) (r.* (@@ p16))))))
-                                (r.set! x48 (|> (@@ x48) (r.+ x32-top)))
-                                (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p32))))))
-                                (r.set! x48 (|> (@@ x48) (r.+ x32-top)
-                                                (r.+ (|> (@@ s48) (r.* (@@ p00))))
-                                                (r.+ (|> (@@ s32) (r.* (@@ p16))))
-                                                (r.+ (|> (@@ s16) (r.* (@@ p32))))
-                                                (r.+ (|> (@@ s00) (r.* (@@ p48))))))
-                                (int//new (new-half (@@ x48) (@@ x32))
-                                          (new-half (@@ x16) (@@ x00))))))
-                        )))))))
-
-(def: (limit-shift! shift)
-  (-> SVar Expression)
-  (r.set! shift (|> (@@ shift) (r.bit-and (r.int 63)))))
-
-(def: (no-shift-clause shift input)
-  (-> SVar SVar [Expression Expression])
-  [(|> (@@ shift) (r.= (r.int 0)))
-   (@@ input)])
-
-(runtime: (bit//left-shift shift input)
-  ($_ r.then
-      (limit-shift! shift)
-      (r.cond (list (no-shift-clause shift input)
-                    [(|> (@@ shift) (r.< (r.int 32)))
-                     (let [mid (|> (int64-low (@@ input)) (r.bit-ushr (|> (r.int 32) (r.- (@@ shift)))))
-                           high (|> (int64-high (@@ input))
-                                    (r.bit-shl (@@ shift))
-                                    (r.bit-or mid))
-                           low (|> (int64-low (@@ input))
-                                   (r.bit-shl (@@ shift)))]
-                       (int//new high low))])
-              (let [high (|> (int64-high (@@ input))
-                             (r.bit-shl (|> (@@ shift) (r.- (r.int 32)))))]
-                (int//new high (r.int 0))))))
-
-(runtime: (bit//arithmetic-right-shift-32 shift input)
-  (let [top-bit (|> (@@ input) (r.bit-and (r.int (hex "80000000"))))]
-    (|> (@@ input)
-        (r.bit-ushr (@@ shift))
-        (r.bit-or top-bit))))
-
-(runtime: (bit//arithmetic-right-shift shift input)
-  ($_ r.then
-      (limit-shift! shift)
-      (r.cond (list (no-shift-clause shift input)
-                    [(|> (@@ shift) (r.< (r.int 32)))
-                     (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
-                           high (|> (int64-high (@@ input))
-                                    (bit//arithmetic-right-shift-32 (@@ shift)))
-                           low (|> (int64-low (@@ input))
-                                   (r.bit-ushr (@@ shift))
-                                   (r.bit-or mid))]
-                       (int//new high low))])
-              (let [low (|> (int64-high (@@ input))
-                            (bit//arithmetic-right-shift-32 (|> (@@ shift) (r.- (r.int 32)))))
-                    high (r.if (|> (int64-high (@@ input)) (r.>= (r.int 0)))
-                           (r.int 0)
-                           (r.int -1))]
-                (int//new high low)))))
-
-(runtime: (int/// param subject)
-  (let [negative? (|>> (int//< int//zero))
-        valid-division-check [(|> (@@ param) (int//= int//zero))
-                              (r.stop (r.string "Cannot divide by zero!"))]
-        short-circuit-check [(|> (@@ subject) (int//= int//zero))
-                             int//zero]]
-    (r.cond (list valid-division-check
-                  short-circuit-check
-
-                  [(|> (@@ subject) (int//= int//min))
-                   (r.cond (list [(|> (|> (@@ param) (int//= int//one))
-                                      (r.or (|> (@@ param) (int//= int//-one))))
-                                  int//min]
-                                 [(|> (@@ param) (int//= int//min))
-                                  int//one])
-                           (with-vars [approximation]
-                             ($_ r.then
-                                 (r.set! approximation
-                                         (|> (@@ subject)
-                                             (bit//arithmetic-right-shift (r.int 1))
-                                             (int/// (@@ param))
-                                             (bit//left-shift (r.int 1))))
-                                 (r.if (|> (@@ approximation) (int//= int//zero))
-                                   (r.if (negative? (@@ param))
-                                     int//one
-                                     int//-one)
-                                   (let [remainder (int//- (int//* (@@ param) (@@ approximation))
-                                                           (@@ subject))]
-                                     (|> remainder
-                                         (int/// (@@ param))
-                                         (int//+ (@@ approximation))))))))]
-                  [(|> (@@ param) (int//= int//min))
-                   int//zero]
-
-                  [(negative? (@@ subject))
-                   (r.if (negative? (@@ param))
-                     (|> (int//negate (@@ subject))
-                         (int/// (int//negate (@@ param))))
-                     (|> (int//negate (@@ subject))
-                         (int/// (@@ param))
-                         int//negate))]
-
-                  [(negative? (@@ param))
-                   (|> (@@ param)
-                       int//negate
-                       (int/// (@@ subject))
-                       int//negate)])
-            (with-vars [result remainder approximate approximate-result log2 approximate-remainder]
-              ($_ r.then
-                  (r.set! result int//zero)
-                  (r.set! remainder (@@ subject))
-                  (r.while (|> (|> (@@ remainder) (int//< (@@ param)))
-                               (r.or (|> (@@ remainder) (int//= (@@ param)))))
-                           (let [calc-rough-estimate (r.apply (list (|> (int//to-float (@@ remainder)) (r./ (int//to-float (@@ param)))))
-                                                              (r.global "floor"))
-                                 calc-approximate-result (int//from-float (@@ approximate))
-                                 calc-approximate-remainder (|> (@@ approximate-result) (int//* (@@ param)))
-                                 delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
-                                         (r.float 1.0)
-                                         (r.** (|> (@@ log2) (r.- (r.float 48.0)))
-                                               (r.float 2.0)))]
-                             ($_ r.then
-                                 (r.set! approximate (r.apply (list (r.float 1.0) calc-rough-estimate)
-                                                              (r.global "max")))
-                                 (r.set! log2 (let [log (function (_ input)
-                                                          (r.apply (list input) (r.global "log")))]
-                                                (r.apply (list (|> (log (r.int 2))
-                                                                   (r./ (log (@@ approximate)))))
-                                                         (r.global "ceil"))))
-                                 (r.set! approximate-result calc-approximate-result)
-                                 (r.set! approximate-remainder calc-approximate-remainder)
-                                 (r.while (|> (negative? (@@ approximate-remainder))
-                                              (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
-                                          ($_ r.then
-                                              (r.set! approximate (|> delta (r.- (@@ approximate))))
-                                              (r.set! approximate-result calc-approximate-result)
-                                              (r.set! approximate-remainder calc-approximate-remainder)))
-                                 (r.set! result (|> (r.if (|> (@@ approximate-result) (int//= int//zero))
-                                                      int//one
-                                                      (@@ approximate-result))
-                                                    (int//+ (@@ result))))
-                                 (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder)))))))
-                  (@@ result)))
-            )))
-
-(runtime: (int//% param subject)
-  (let [flat (|> (@@ subject) (int/// (@@ param)) (int//* (@@ param)))]
-    (|> (@@ subject) (int//- flat))))
-
-(def: runtime//int
-  Runtime
-  ($_ r.then
-      @@int//zero
-      @@int//one
-      @@int//min
-      @@int//max
-      @@int//=
-      @@int//<
-      @@int//+
-      @@int//-
-      @@int//negate
-      @@int//-one
-      @@int//unsigned-low
-      @@int//to-float
-      @@int//*
-      @@int///
-      @@int//%))
-
-(runtime: (lux//try op)
-  (with-vars [error value]
-    (r.try ($_ r.then
-               (r.set! value (r.apply (list ..unit) (@@ op)))
-               (..right (@@ value)))
-           #.None
-           (#.Some (r.function (list error)
-                     (..left (r.nth (r.string "message")
-                                    (@@ error)))))
-           #.None)))
-
-(runtime: (lux//program-args program-args)
-  (with-vars [inputs value]
-    ($_ r.then
-        (r.set! inputs ..none)
-        (<| (r.for-in value (@@ program-args))
-            (r.set! inputs (..some (r.list (list (@@ value) (@@ inputs))))))
-        (@@ inputs))))
-
-(def: runtime//lux
-  Runtime
-  ($_ r.then
-      @@lux//try
-      @@lux//program-args))
-
-(def: current-time-float
-  Expression
-  (let [raw-time (r.apply (list) (r.global "Sys.time"))]
-    (r.apply (list raw-time) (r.global "as.numeric"))))
-
-(runtime: (io//current-time! _)
-  (|> current-time-float
-      (r.* (r.float 1,000.0))
-      int//from-float))
-
-(def: runtime//io
-  Runtime
-  ($_ r.then
-      @@io//current-time!))
-
-(def: minimum-index-length
-  (-> SVar Expression)
-  (|>> @@ (r.+ (r.int 1))))
-
-(def: (product-element product index)
-  (-> Expression Expression Expression)
-  (|> product (r.nth (|> index (r.+ (r.int 1))))))
-
-(def: (product-tail product)
-  (-> SVar Expression)
-  (|> (@@ product) (r.nth (r.length (@@ product)))))
-
-(def: (updated-index min-length product)
-  (-> Expression Expression Expression)
-  (|> min-length (r.- (r.length product))))
-
-(runtime: (product//left product index)
-  (let [$index_min_length (r.var "index_min_length")]
-    ($_ r.then
-        (r.set! $index_min_length (minimum-index-length index))
-        (r.if (|> (r.length (@@ product)) (r.> (@@ $index_min_length)))
-          ## No need for recursion
-          (product-element (@@ product) (@@ index))
-          ## Needs recursion
-          (product//left (product-tail product)
-                         (updated-index (@@ $index_min_length) (@@ product)))))))
-
-(runtime: (product//right product index)
-  (let [$index_min_length (r.var "index_min_length")]
-    ($_ r.then
-        (r.set! $index_min_length (minimum-index-length index))
-        (r.cond (list [## Last element.
-                       (|> (r.length (@@ product)) (r.= (@@ $index_min_length)))
-                       (product-element (@@ product) (@@ index))]
-                      [## Needs recursion
-                       (|> (r.length (@@ product)) (r.< (@@ $index_min_length)))
-                       (product//right (product-tail product)
-                                       (updated-index (@@ $index_min_length) (@@ product)))])
-                ## Must slice
-                (|> (@@ product) (r.slice-from (@@ index)))))))
-
-(runtime: (sum//get sum wanted_tag wants_last)
-  (let [no-match r.null
-        sum-tag (|> (@@ sum) (r.nth (r.string //.variant-tag-field)))
-        sum-flag (|> (@@ sum) (r.nth (r.string //.variant-flag-field)))
-        sum-value (|> (@@ sum) (r.nth (r.string //.variant-value-field)))
-        is-last? (|> sum-flag (r.= (r.string "")))
-        test-recursion (r.if is-last?
-                         ## Must recurse.
-                         (sum//get sum-value
-                                   (|> (@@ wanted_tag) (r.- sum-tag))
-                                   (@@ wants_last))
-                         no-match)]
-    (r.cond (list [(r.= sum-tag (@@ wanted_tag))
-                   (r.if (r.= (@@ wants_last) sum-flag)
-                     sum-value
-                     test-recursion)]
-
-                  [(|> (@@ wanted_tag) (r.> sum-tag))
-                   test-recursion]
-
-                  [(|> (|> (@@ wants_last) (r.= (r.string "")))
-                       (r.and (|> (@@ wanted_tag) (r.< sum-tag))))
-                   (variant' (|> sum-tag (r.- (@@ wanted_tag))) sum-flag sum-value)])
-
-            no-match)))
-
-(def: runtime//adt
-  Runtime
-  ($_ r.then
-      @@product//left
-      @@product//right
-      @@sum//get
-      ))
-
-(template [ ]
-  [(runtime: ( mask input)
-     (int//new ( (int64-high (@@ mask))
-                     (int64-high (@@ input)))
-               ( (int64-low (@@ mask))
-                     (int64-low (@@ input)))))]
-
-  [bit//and r.bit-and]
-  [bit//or  r.bit-or]
-  [bit//xor r.bit-xor]
-  )
-
-(runtime: (bit//logical-right-shift shift input)
-  ($_ r.then
-      (limit-shift! shift)
-      (r.cond (list (no-shift-clause shift input)
-                    [(|> (@@ shift) (r.< (r.int 32)))
-                     (with-vars [$mid]
-                       (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
-                             high (|> (int64-high (@@ input)) (r.bit-ushr (@@ shift)))
-                             low (|> (int64-low (@@ input))
-                                     (r.bit-ushr (@@ shift))
-                                     (r.bit-or (r.if (r.apply (list (@@ $mid)) (r.global "is.na"))
-                                                 (r.int 0)
-                                                 (@@ $mid))))]
-                         ($_ r.then
-                             (r.set! $mid mid)
-                             (int//new high low))))]
-                    [(|> (@@ shift) (r.= (r.int 32)))
-                     (let [high (int64-high (@@ input))]
-                       (int//new (r.int 0) high))])
-              (let [low (|> (int64-high (@@ input)) (r.bit-ushr (|> (@@ shift) (r.- (r.int 32)))))]
-                (int//new (r.int 0) low)))))
-
-(def: runtime//bit
-  Runtime
-  ($_ r.then
-      @@bit//and
-      @@bit//or
-      @@bit//xor
-      @@bit//not
-      @@bit//left-shift
-      @@bit//arithmetic-right-shift-32
-      @@bit//arithmetic-right-shift
-      @@bit//logical-right-shift
-      ))
-
-(runtime: (frac//decode input)
-  (with-vars [output]
-    ($_ r.then
-        (r.set! output (r.apply (list (@@ input)) (r.global "as.numeric")))
-        (r.if (|> (@@ output) (r.= r.n/a))
-          ..none
-          (..some (@@ output))))))
-
-(def: runtime//frac
-  Runtime
-  ($_ r.then
-      @@frac//decode))
-
-(def: inc (-> Expression Expression) (|>> (r.+ (r.int 1))))
-
-(template [ ]
-  [(def: ( top value)
-     (-> Expression Expression Expression)
-     (|> (|> value (r.>= (r.int 0)))
-         (r.and (|> value ( top)))))]
-
-  [within? r.<]
-  [up-to?  r.<=]
-  )
-
-(def: (text-clip start end text)
-  (-> Expression Expression Expression Expression)
-  (r.apply (list text start end)
-           (r.global "substr")))
-
-(def: (text-length text)
-  (-> Expression Expression)
-  (r.apply (list text) (r.global "nchar")))
-
-(runtime: (text//index subject param start)
-  (with-vars [idx startF subjectL]
-    ($_ r.then
-        (r.set! startF (int//to-float (@@ start)))
-        (r.set! subjectL (text-length (@@ subject)))
-        (r.if (|> (@@ startF) (within? (@@ subjectL)))
-          ($_ r.then
-              (r.set! idx (|> (r.apply-kw (list (@@ param) (r.if (|> (@@ startF) (r.= (r.int 0)))
-                                                             (@@ subject)
-                                                             (text-clip (inc (@@ startF))
-                                                                        (inc (@@ subjectL))
-                                                                        (@@ subject))))
-                                          (list ["fixed" (r.bool #1)])
-                                          (r.global "regexpr"))
-                              (r.nth (r.int 1))))
-              (r.if (|> (@@ idx) (r.= (r.int -1)))
-                ..none
-                (..some (int//from-float (|> (@@ idx) (r.+ (@@ startF)))))))
-          ..none))))
-
-(runtime: (text//clip text from to)
-  (with-vars [length]
-    ($_ r.then
-        (r.set! length (r.length (@@ text)))
-        (r.if ($_ r.and
-                  (|> (@@ to) (within? (@@ length)))
-                  (|> (@@ from) (up-to? (@@ to))))
-          (..some (text-clip (inc (@@ from)) (inc (@@ to)) (@@ text)))
-          ..none))))
-
-(def: (char-at idx text)
-  (-> Expression Expression Expression)
-  (r.apply (list (text-clip idx idx text))
-           (r.global "utf8ToInt")))
-
-(runtime: (text//char text idx)
-  (r.if (|> (@@ idx) (within? (r.length (@@ text))))
-    ($_ r.then
-        (r.set! idx (inc (@@ idx)))
-        (..some (int//from-float (char-at (@@ idx) (@@ text)))))
-    ..none))
-
-(def: runtime//text
-  Runtime
-  ($_ r.then
-      @@text//index
-      @@text//clip
-      @@text//char))
-
-(def: (check-index-out-of-bounds array idx body)
-  (-> Expression Expression Expression Expression)
-  (r.if (|> idx (r.<= (r.length array)))
-    body
-    (r.stop (r.string "Array index out of bounds!"))))
-
-(runtime: (array//new size)
-  (with-vars [output]
-    ($_ r.then
-        (r.set! output (r.list (list)))
-        (r.set-nth! (|> (@@ size) (r.+ (r.int 1)))
-                    r.null
-                    output)
-        (@@ output))))
-
-(runtime: (array//get array idx)
-  (with-vars [temp]
-    (<| (check-index-out-of-bounds (@@ array) (@@ idx))
-        ($_ r.then
-            (r.set! temp (|> (@@ array) (r.nth (@@ idx))))
-            (r.if (|> (@@ temp) (r.= r.null))
-              ..none
-              (..some (@@ temp)))))))
-
-(runtime: (array//put array idx value)
-  (<| (check-index-out-of-bounds (@@ array) (@@ idx))
-      ($_ r.then
-          (r.set-nth! (@@ idx) (@@ value) array)
-          (@@ array))))
-
-(def: runtime//array
-  Runtime
-  ($_ r.then
-      @@array//new
-      @@array//get
-      @@array//put))
-
-(runtime: (box//write value box)
-  ($_ r.then
-      (r.set-nth! (r.int 1) (@@ value) box)
-      ..unit))
-
-(def: runtime//box
-  Runtime
-  ($_ r.then
-      @@box//write))
-
-(def: runtime
-  Runtime
-  ($_ r.then
-      runtime//lux
-      @@f2^32
-      @@f2^63
-      @@int//new
-      @@int//from-float
-      runtime//bit
-      runtime//int
-      runtime//adt
-      runtime//frac
-      runtime//text
-      runtime//array
-      runtime//box
-      runtime//io
-      ))
-
-(def: #export artifact Text (format prefix ".r"))
-
-(def: #export translate
-  (Meta (Process Any))
-  (do macro.Monad
-    [_ //.init-module-buffer
-     _ (//.save runtime)]
-    (//.save-module! artifact)))
diff --git a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
deleted file mode 100644
index 1798cb56d..000000000
--- a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
+++ /dev/null
@@ -1,45 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       [macro]
-       (data text/format))
-  (luxc (lang [".L" module]
-              (host [r #+ Expression @@])))
-  [//]
-  (// [".T" runtime]
-      [".T" reference]
-      [".T" eval]))
-
-(def: #export (translate-def name expressionT expressionO metaV)
-  (-> Text Type Expression Code (Meta Any))
-  (do {@ macro.Monad}
-    [current-module macro.current-module-name
-     #let [def-name [current-module name]]]
-    (case (macro.get-identifier-ann (name-of #.alias) metaV)
-      (#.Some real-def)
-      (do @
-        [[realT realA realV] (macro.find-def real-def)
-         _ (moduleL.define def-name [realT metaV realV])]
-        (wrap []))
-
-      _
-      (do @
-        [#let [def-name (referenceT.global def-name)]
-         _ (//.save (r.set! def-name expressionO))
-         expressionV (evalT.eval (@@ def-name))
-         _ (moduleL.define def-name [expressionT metaV expressionV])
-         _ (if (macro.type? metaV)
-             (case (macro.declared-tags metaV)
-               #.Nil
-               (wrap [])
-
-               tags
-               (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV)))
-             (wrap []))
-         #let [_ (log! (format "DEF " (%name def-name)))]]
-        (wrap []))
-      )))
-
-(def: #export (translate-program programO)
-  (-> Expression (Meta Expression))
-  (macro.fail "translate-program NOT IMPLEMENTED YET"))
diff --git a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
deleted file mode 100644
index cea8fcd59..000000000
--- a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
+++ /dev/null
@@ -1,31 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       (data [text]
-             text/format)
-       [macro])
-  (luxc ["&" lang]
-        (lang [synthesis #+ Synthesis]
-              (host [r #+ Expression])))
-  [//]
-  (// [".T" runtime]))
-
-(def: #export (translate-tuple translate elemsS+)
-  (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression))
-  (case elemsS+
-    #.Nil
-    (:: macro.Monad wrap runtimeT.unit)
-
-    (#.Cons singletonS #.Nil)
-    (translate singletonS)
-
-    _
-    (do {@ macro.Monad}
-      [elemsT+ (monad.map @ translate elemsS+)]
-      (wrap (r.list elemsT+)))))
-
-(def: #export (translate-variant translate tag tail? valueS)
-  (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression))
-  (do macro.Monad
-    [valueT (translate valueS)]
-    (wrap (runtimeT.variant tag tail? valueT))))
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
deleted file mode 100644
index e2cf047e9..000000000
--- a/new-luxc/source/program.lux
+++ /dev/null
@@ -1,180 +0,0 @@
-(.module:
-  [lux (#- Definition)
-   ["@" target]
-   ["." host (#+ import:)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    ["." io (#+ IO)]
-    ["." try (#+ Try)]
-    [parser
-     [cli (#+ program:)]]
-    [concurrency
-     ["." promise (#+ Promise)]]]
-   [data
-    ["." product]
-    [text
-     ["%" format (#+ format)]]
-    [collection
-     [array (#+ Array)]
-     ["." dictionary]]]
-   [world
-    ["." file]]
-   [target
-    [jvm
-     [bytecode (#+ Bytecode)]]]
-   [tool
-    [compiler
-     [default
-      ["." platform (#+ Platform)]]
-     [language
-      [lux
-       [analysis
-        ["." macro (#+ Expander)]]
-       [phase
-        [extension (#+ Phase Bundle Operation Handler Extender)
-         ["." analysis #_
-          ["#" jvm]]
-         ["." generation #_
-          ["#" jvm]]
-         ## ["." directive #_
-         ##  ["#" jvm]]
-         ]
-        [generation
-         ["." jvm #_
-          ## ["." runtime (#+ Anchor Definition)]
-          ["." packager]
-          ## ["#/." host]
-          ]]]]]]]]
-  [program
-   ["/" compositor
-    ["/." cli]
-    ["/." static]]]
-  [luxc
-   [lang
-    [host
-     ["_" jvm]]
-    ["." directive #_
-     ["#" jvm]]
-    [translation
-     ["." jvm
-      ["." runtime]
-      ["." expression]
-      ["#/." program]
-      ["translation" extension]]]]])
-
-(import: #long java/lang/reflect/Method
-  (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
-
-(import: #long (java/lang/Class c)
-  (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method))
-
-(import: #long java/lang/Object
-  (getClass [] (java/lang/Class java/lang/Object)))
-
-(def: _object-class
-  (java/lang/Class java/lang/Object)
-  (host.class-for java/lang/Object))
-
-(def: _apply2-args
-  (Array (java/lang/Class java/lang/Object))
-  (|> (host.array (java/lang/Class java/lang/Object) 2)
-      (host.array-write 0 _object-class)
-      (host.array-write 1 _object-class)))
-
-(def: _apply4-args
-  (Array (java/lang/Class java/lang/Object))
-  (|> (host.array (java/lang/Class java/lang/Object) 4)
-      (host.array-write 0 _object-class)
-      (host.array-write 1 _object-class)
-      (host.array-write 2 _object-class)
-      (host.array-write 3 _object-class)))
-
-(def: #export (expander macro inputs lux)
-  Expander
-  (do try.monad
-    [apply-method (|> macro
-                      (:coerce java/lang/Object)
-                      (java/lang/Object::getClass)
-                      (java/lang/Class::getMethod "apply" _apply2-args))]
-    (:coerce (Try (Try [Lux (List Code)]))
-             (java/lang/reflect/Method::invoke
-              (:coerce java/lang/Object macro)
-              (|> (host.array java/lang/Object 2)
-                  (host.array-write 0 (:coerce java/lang/Object inputs))
-                  (host.array-write 1 (:coerce java/lang/Object lux)))
-              apply-method))))
-
-(def: #export platform
-  ## (IO (Platform Anchor (Bytecode Any) Definition))
-  (IO (Platform _.Anchor _.Inst _.Definition))
-  (do io.monad
-    [## host jvm/host.host
-     host jvm.host]
-    (wrap {#platform.&file-system (file.async file.system)
-           #platform.host host
-           ## #platform.phase jvm.generate
-           #platform.phase expression.translate
-           ## #platform.runtime runtime.generate
-           #platform.runtime runtime.translate
-           #platform.write product.right})))
-
-(def: extender
-  Extender
-  ## TODO: Stop relying on coercions ASAP.
-  (<| (:coerce Extender)
-      (function (@self handler))
-      (:coerce Handler)
-      (function (@self name phase))
-      (:coerce Phase)
-      (function (@self parameters))
-      (:coerce Operation)
-      (function (@self state))
-      (:coerce Try)
-      try.assume
-      (:coerce Try)
-      (do try.monad
-        [method (|> handler
-                    (:coerce java/lang/Object)
-                    (java/lang/Object::getClass)
-                    (java/lang/Class::getMethod "apply" _apply4-args))]
-        (java/lang/reflect/Method::invoke
-         (:coerce java/lang/Object handler)
-         (|> (host.array java/lang/Object 4)
-             (host.array-write 0 (:coerce java/lang/Object name))
-             (host.array-write 1 (:coerce java/lang/Object phase))
-             (host.array-write 2 (:coerce java/lang/Object parameters))
-             (host.array-write 3 (:coerce java/lang/Object state)))
-         method))))
-
-(def: (target service)
-  (-> /cli.Service /cli.Target)
-  (case service
-    (^or (#/cli.Compilation [sources libraries target module])
-         (#/cli.Interpretation [sources libraries target module])
-         (#/cli.Export [sources target]))
-    target))
-
-(def: (declare-success! _)
-  (-> Any (Promise Any))
-  (promise.future (io.exit +0)))
-
-(program: [{service /cli.service}]
-  (let [jar-path (format (..target service) (:: file.system separator) "program.jar")]
-    (exec (do promise.monad
-            [_ (/.compiler {#/static.host @.jvm
-                            #/static.host-module-extension ".jvm"
-                            #/static.target (..target service)
-                            #/static.artifact-extension ".class"}
-                           ..expander
-                           analysis.bundle
-                           ..platform
-                           ## generation.bundle
-                           translation.bundle
-                           (directive.bundle ..extender)
-                           jvm/program.program
-                           ..extender
-                           service
-                           [(packager.package jvm/program.class) jar-path])]
-            (..declare-success! []))
-      (io.io []))))
diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux
deleted file mode 100644
index 270f9005d..000000000
--- a/new-luxc/source/test/program.lux
+++ /dev/null
@@ -1,18 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [control
-    ["." io]
-    [parser
-     [cli (#+ program:)]]]]
-  [spec
-   ["." compositor]]
-  {1
-   ["." /]})
-
-(program: args
-  (<| io.io
-      _.run!
-      ## (_.times 100)
-      (_.seed 1985013625126912890)
-      (compositor.spec /.jvm /.bundle /.expander /.program)))
diff --git a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux
deleted file mode 100644
index f9905c8bc..000000000
--- a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux
+++ /dev/null
@@ -1,549 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["e" error]
-    ["." product]
-    ["." maybe]
-    [text ("text/" Equivalence)
-     format]
-    [collection
-     ["." array]
-     [list ("list/" Fold)]
-     ["dict" dictionary]]]
-   [math
-    ["r" random "r/" Monad]]
-   ["." type]
-   [macro (#+ Monad)
-    ["." code]]
-   [compiler
-    ["." default
-     [".L" init]
-     [phase
-      [analysis
-       [".A" type]]
-      [extension
-       [analysis
-        [".AE" host]]]]]]
-   test]
-  [///
-   ["_." primitive]])
-
-(template [  ]
-  [(def: ( procedure params output-type)
-     (-> Text (List Code) Type Bit)
-     (|> (do Monad
-           [## runtime-bytecode @runtime.translate
-            ]
-           (default.with-scope
-             (typeA.with-type output-type
-               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
-         (analysis.with-current-module "")
-         (macro.run (initL.compiler []))
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [success #1 #0]
-  [failure #0 #1]
-  )
-
-(template [  ]
-  [(def: ( syntax output-type)
-     (-> Code Type Bit)
-     (|> (do Monad
-           [## runtime-bytecode @runtime.translate
-            ]
-           (default.with-scope
-             (typeA.with-type output-type
-               (_primitive.analyse syntax))))
-         (analysis.with-current-module "")
-         (macro.run (initL.compiler []))
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [success' #1 #0]
-  [failure' #0 #1]
-  )
-
-(context: "Conversions [double + float]."
-  (with-expansions [ (template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
-                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
-                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
-                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
-                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
-                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [int]."
-  (with-expansions [ (template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
-                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
-                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
-                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
-                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
-                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [long]."
-  (with-expansions [ (template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
-                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
-                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
-                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
-                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [char + byte + short]."
-  (with-expansions [ (template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
-                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
-                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
-                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
-                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
-                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(template [  ]
-  [(context: (format "Arithmetic " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " +")   ]
-                                        [(format "jvm "  " -")   ]
-                                        [(format "jvm "  " *")   ]
-                                        [(format "jvm "  " /")   ]
-                                        [(format "jvm "  " %")   ]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Order " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Bitwise " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " and")   ]
-                                        [(format "jvm "  " or")   ]
-                                        [(format "jvm "  " xor")   ]
-                                        [(format "jvm "  " shl")  "java.lang.Integer" ]
-                                        [(format "jvm "  " shr")  "java.lang.Integer" ]
-                                        [(format "jvm "  " ushr")  "java.lang.Integer" ]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["int" "java.lang.Integer" hostAE.Integer]
-  ["long" "java.lang.Long" hostAE.Long]
-  )
-
-(template [  ]
-  [(context: (format "Arithmetic " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " +")   ]
-                                        [(format "jvm "  " -")   ]
-                                        [(format "jvm "  " *")   ]
-                                        [(format "jvm "  " /")   ]
-                                        [(format "jvm "  " %")   ]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Order " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["float" "java.lang.Float" hostAE.Float]
-  ["double" "java.lang.Double" hostAE.Double]
-  )
-
-(template [  ]
-  [(context: (format "Order " "["  "].")
-     (with-expansions [ (template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["char" "java.lang.Character" hostAE.Character]
-  )
-
-(def: array-type
-  (r.Random [Text Text])
-  (let [entries (dict.entries hostAE.boxes)
-        num-entries (list.size entries)]
-    (do r.Monad
-      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
-       #let [[unboxed boxed] (: [Text Text]
-                                (|> entries
-                                    (list.nth choice)
-                                    (maybe.default ["java.lang.Object" "java.lang.Object"])))]]
-      (wrap [unboxed boxed]))))
-
-(context: "Array."
-  (<| (times +100)
-      (do @
-        [#let [cap (|>> (n/% +10) (n/max +1))]
-         [unboxed boxed] array-type
-         size (|> r.nat (:: @ map cap))
-         idx (|> r.nat (:: @ map (n/% size)))
-         level (|> r.nat (:: @ map cap))
-         #let [unboxedT (#.Primitive unboxed (list))
-               arrayT (#.Primitive "#Array" (list unboxedT))
-               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0)))
-                           ("jvm array new" (~ (code.nat size)))))
-               boxedT (#.Primitive boxed (list))
-               boxedTC (` (+0 (~ (code.text boxed)) (+0)))
-               multi-arrayT (list/fold (function (_ _ innerT)
-                                         (|> innerT (list) (#.Primitive "#Array")))
-                                       boxedT
-                                       (list.n/range +1 level))]]
-        ($_ seq
-            (test "jvm array new"
-                  (success "jvm array new"
-                           (list (code.nat size))
-                           arrayT))
-            (test "jvm array new (no nesting)"
-                  (failure "jvm array new"
-                           (list (code.nat size))
-                           unboxedT))
-            (test "jvm array new (nested/multi-level)"
-                  (success "jvm array new"
-                           (list (code.nat size))
-                           multi-arrayT))
-            (test "jvm array length"
-                  (success "jvm array length"
-                           (list arrayC)
-                           Nat))
-            (test "jvm array read"
-                  (success' (` ("jvm object cast"
-                                ("jvm array read" (~ arrayC) (~ (code.nat idx)))))
-                            boxedT))
-            (test "jvm array write"
-                  (success "jvm array write"
-                           (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) [])))
-                           arrayT))
-            ))))
-
-(def: throwables
-  (List Text)
-  (list "java.lang.Throwable"
-        "java.lang.Error"
-        "java.io.IOError"
-        "java.lang.VirtualMachineError"
-        "java.lang.Exception"
-        "java.io.IOException"
-        "java.lang.RuntimeException"))
-
-(context: "Object."
-  (<| (times +100)
-      (do @
-        [[unboxed boxed] array-type
-         [!unboxed !boxed] (|> array-type
-                               (r.filter (function (_ [!unboxed !boxed])
-                                           (not (text/= boxed !boxed)))))
-         #let [boxedT (#.Primitive boxed (list))
-               boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0))
-                           ("jvm object null")))
-               !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0))
-                            ("jvm object null")))
-               unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
-                             ("jvm object null")))]
-         throwable (|> r.nat
-                       (:: @ map (n/% (inc (list.size throwables))))
-                       (:: @ map (function (_ idx)
-                                   (|> throwables
-                                       (list.nth idx)
-                                       (maybe.default "java.lang.Object")))))
-         #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0))
-                               ("jvm object null")))]]
-        ($_ seq
-            (test "jvm object null"
-                  (success "jvm object null"
-                           (list)
-                           (#.Primitive boxed (list))))
-            (test "jvm object null (no primitives)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object null"
-                               (list)
-                               (#.Primitive unboxed (list)))))
-            (test "jvm object null?"
-                  (success "jvm object null?"
-                           (list boxedC)
-                           Bit))
-            (test "jvm object synchronized"
-                  (success "jvm object synchronized"
-                           (list boxedC boxedC)
-                           boxedT))
-            (test "jvm object synchronized (no primitives)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object synchronized"
-                               (list unboxedC boxedC)
-                               boxedT)))
-            (test "jvm object throw"
-                  (or (text/= "java.lang.Object" throwable)
-                      (success "jvm object throw"
-                               (list throwableC)
-                               Nothing)))
-            (test "jvm object class"
-                  (success "jvm object class"
-                           (list (code.text boxed))
-                           (#.Primitive "java.lang.Class" (list boxedT))))
-            (test "jvm object instance?"
-                  (success "jvm object instance?"
-                           (list (code.text boxed)
-                                 boxedC)
-                           Bit))
-            (test "jvm object instance? (lineage)"
-                  (success "jvm object instance?"
-                           (list (' "java.lang.Object")
-                                 boxedC)
-                           Bit))
-            (test "jvm object instance? (no lineage)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object instance?"
-                               (list (code.text boxed)
-                                     !boxedC)
-                               Bit)))
-            ))))
-
-(context: "Member [Static Field]."
-  ($_ seq
-      (test "jvm member static get"
-            (success "jvm member static get"
-                     (list (code.text "java.lang.System")
-                           (code.text "out"))
-                     (#.Primitive "java.io.PrintStream" (list))))
-      (test "jvm member static get (inheritance out)"
-            (success "jvm member static get"
-                     (list (code.text "java.lang.System")
-                           (code.text "out"))
-                     (#.Primitive "java.lang.Object" (list))))
-      (test "jvm member static put"
-            (success "jvm member static put"
-                     (list (code.text "java.awt.datatransfer.DataFlavor")
-                           (code.text "allHtmlFlavor")
-                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
-                                ("jvm object null"))))
-                     Any))
-      (test "jvm member static put (final)"
-            (failure "jvm member static put"
-                     (list (code.text "java.lang.System")
-                           (code.text "out")
-                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
-                                ("jvm object null"))))
-                     Any))
-      (test "jvm member static put (inheritance in)"
-            (success "jvm member static put"
-                     (list (code.text "java.awt.datatransfer.DataFlavor")
-                           (code.text "allHtmlFlavor")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
-                                 ("jvm object null")))))
-                     Any))
-      ))
-
-(context: "Member [Virtual Field]."
-  ($_ seq
-      (test "jvm member virtual get"
-            (success "jvm member virtual get"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.String" (list))))
-      (test "jvm member virtual get (inheritance out)"
-            (success "jvm member virtual get"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.Object" (list))))
-      (test "jvm member virtual put"
-            (success "jvm member virtual put"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "java.lang.String" (+0))
-                                ("jvm object null")))
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (primitive "org.omg.CORBA.ValueMember")))
-      (test "jvm member virtual put (final)"
-            (failure "jvm member virtual put"
-                     (list (code.text "javax.swing.text.html.parser.DTD")
-                           (code.text "applet")
-                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
-                                ("jvm object null")))
-                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
-                                ("jvm object null"))))
-                     (primitive "javax.swing.text.html.parser.DTD")))
-      (test "jvm member virtual put (inheritance in)"
-            (success "jvm member virtual put"
-                     (list (code.text "java.awt.GridBagConstraints")
-                           (code.text "insets")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
-                                 ("jvm object null"))))
-                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
-                                ("jvm object null"))))
-                     (primitive "java.awt.GridBagConstraints")))
-      ))
-
-(context: "Boxing/Unboxing."
-  ($_ seq
-      (test "jvm member static get"
-            (success "jvm member static get"
-                     (list (code.text "java.util.GregorianCalendar")
-                           (code.text "AD"))
-                     (#.Primitive "java.lang.Integer" (list))))
-      (test "jvm member virtual get"
-            (success "jvm member virtual get"
-                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
-                           (code.text "startIndex")
-                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.Integer" (list))))
-      (test "jvm member virtual put"
-            (success "jvm member virtual put"
-                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
-                           (code.text "startIndex")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "java.lang.Integer" (+0))
-                                 ("jvm object null"))))
-                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
-                                ("jvm object null"))))
-                     (primitive "javax.accessibility.AccessibleAttributeSequence")))
-      ))
-
-(context: "Member [Method]."
-  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
-                  +123))
-        intC (`' ("jvm convert long-to-int" (~ longC)))
-        stringC (' ("lux coerce" (+0 "java.lang.String" (+0))
-                    "YOLO"))
-        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
-                     ("jvm member invoke constructor" "java.util.ArrayList"
-                      ["int" ("jvm object cast" (~ intC))])))]
-    ($_ seq
-        (test "jvm member invoke static"
-              (success' (` ("jvm member invoke static"
-                            "java.lang.Long" "decode"
-                            ["java.lang.String" (~ stringC)]))
-                        (#.Primitive "java.lang.Long" (list))))
-        (test "jvm member invoke virtual"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke virtual"
-                             "java.lang.Object" "equals"
-                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke special"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke special"
-                             "java.lang.Long" "equals"
-                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke interface"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke interface"
-                             "java.util.Collection" "add"
-                             ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke constructor"
-              (success' (` ("jvm member invoke constructor"
-                            "java.util.ArrayList"
-                            ["int" ("jvm object cast" (~ intC))]))
-                        (All [a] (#.Primitive "java.util.ArrayList" (list a)))))
-        )))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/loop.lux b/new-luxc/test/test/luxc/lang/synthesis/loop.lux
deleted file mode 100644
index c6efa7dbf..000000000
--- a/new-luxc/test/test/luxc/lang/synthesis/loop.lux
+++ /dev/null
@@ -1,162 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do])
-       (data [bit "bit/" Eq]
-             [number]
-             (coll [list "list/" Functor Fold]
-                   (set ["set" unordered]))
-             text/format)
-       (macro [code])
-       ["r" math/random "r/" Monad]
-       test)
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              (synthesis [".S" expression]
-                         [".S" loop])
-              [".L" extension]))
-  (// common))
-
-(def: (does-recursion? arity exprS)
-  (-> ls.Arity ls.Synthesis Bit)
-  (loop [exprS exprS]
-    (case exprS
-      (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))])
-      (loop [pathS pathS]
-        (case pathS
-          (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))])
-          (or (recur leftS)
-              (recur rightS))
-
-          (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))])
-          (recur rightS)
-
-          (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
-          (does-recursion? arity bodyS)
-          
-          _
-          #0))
-
-      (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))])
-      (n/= arity (list.size argsS))
-
-      (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))])
-      (recur bodyS)
-
-      (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))])
-      (or (recur thenS)
-          (recur elseS))
-
-      _
-      #0
-      )))
-
-(def: (gen-body arity output)
-  (-> Nat la.Analysis (r.Random la.Analysis))
-  (r.either (r.either (r/wrap output)
-                      (do r.Monad
-                        [inputA (|> r.nat (:: @ map code.nat))
-                         num-cases (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-                         tests (|> (r.set number.Hash num-cases r.nat)
-                                   (:: @ map (|>> set.to-list (list/map code.nat))))
-                         #let [bad-bodies (list.repeat num-cases (' []))]
-                         good-body (gen-body arity output)
-                         where-to-set (|> r.nat (:: @ map (n/% num-cases)))
-                         #let [bodies (list.concat (list (list.take where-to-set bad-bodies)
-                                                         (list good-body)
-                                                         (list.drop (n/inc where-to-set) bad-bodies)))]]
-                        (wrap (` ("lux case" (~ inputA)
-                                  (~ (code.record (list.zip2 tests bodies))))))))
-            (r.either (do r.Monad
-                        [valueS r.bit
-                         output' (gen-body (n/inc arity) output)]
-                        (wrap (` ("lux case" (~ (code.bit valueS))
-                                  {("lux case bind" (~ (code.nat arity))) (~ output')}))))
-                      (do r.Monad
-                        [valueS r.bit
-                         then|else r.bit
-                         output' (gen-body arity output)
-                         #let [thenA (if then|else output' (' []))
-                               elseA (if (not then|else) output' (' []))]]
-                        (wrap (` ("lux case" (~ (code.bit valueS))
-                                  {(~ (code.bit then|else)) (~ thenA)
-                                   (~ (code.bit (not then|else))) (~ elseA)})))))
-            ))
-
-(def: (make-function arity body)
-  (-> ls.Arity la.Analysis la.Analysis)
-  (case arity
-    +0 body
-    _ (` ("lux function" [] (~ (make-function (n/dec arity) body))))))
-
-(def: gen-recursion
-  (r.Random [Bit Nat la.Analysis])
-  (do r.Monad
-    [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-     recur? r.bit
-     outputS (if recur?
-               (wrap (la.apply (list.repeat arity (' [])) (la.var 0)))
-               (do @
-                 [plus-or-minus? r.bit
-                  how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1))))
-                  #let [shift (if plus-or-minus? n/+ n/-)]]
-                 (wrap (la.apply (list.repeat (shift how-much arity) (' [])) (la.var 0)))))
-     bodyS (gen-body arity outputS)]
-    (wrap [recur? arity (make-function arity bodyS)])))
-
-(def: gen-loop
-  (r.Random [Bit Nat la.Analysis])
-  (do r.Monad
-    [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-     recur? r.bit
-     self-ref? r.bit
-     #let [selfA (la.var 0)
-           argA (if self-ref? selfA (' []))]
-     outputS (if recur?
-               (wrap (la.apply (list.repeat arity argA) selfA))
-               (do @
-                 [plus-or-minus? r.bit
-                  how-much (|> r.nat (:: @ map (|>> (n/% arity) (n/max +1))))
-                  #let [shift (if plus-or-minus? n/+ n/-)]]
-                 (wrap (la.apply (list.repeat (shift how-much arity) (' [])) selfA))))
-     bodyS (gen-body arity outputS)]
-    (wrap [(and recur? (not self-ref?))
-           arity
-           (make-function arity bodyS)])))
-
-(context: "Recursion."
-  (<| (times +100)
-      (do @
-        [[prediction arity analysis] gen-recursion]
-        ($_ seq
-            (test "Can accurately identify (and then reify) tail recursion."
-                  (case (expressionS.synthesize extensionL.no-syntheses
-                                                analysis)
-                    (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat _arity)] [_ (#.Tuple _env)] _body))])
-                    (|> _body
-                        (does-recursion? arity)
-                        (bit/= prediction)
-                        (and (n/= arity _arity)))
-
-                    _
-                    #0))))))
-
-(context: "Loop."
-  (<| (times +100)
-      (do @
-        [[prediction arity analysis] gen-recursion]
-        ($_ seq
-            (test "Can reify loops."
-                  (case (expressionS.synthesize extensionL.no-syntheses
-                                                (la.apply (list.repeat arity (' [])) analysis))
-                    (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat in_register)] [_ (#.Tuple _inits)] _body))])
-                    (and (n/= arity (list.size _inits))
-                         (not (loopS.contains-self-reference? _body)))
-
-                    (^ [_ (#.Form (list& [_ (#.Text "lux call")]
-                                         [_ (#.Form (list [_ (#.Text "lux function")] _arity _env _bodyS))]
-                                         argsS))])
-                    (loopS.contains-self-reference? _bodyS)
-
-                    _
-                    #0))))))
diff --git a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux b/new-luxc/test/test/luxc/lang/synthesis/procedure.lux
deleted file mode 100644
index ab6c9de6f..000000000
--- a/new-luxc/test/test/luxc/lang/synthesis/procedure.lux
+++ /dev/null
@@ -1,34 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [text "text/" Eq]
-             [product]
-             (coll [list]))
-       ["r" math/random "r/" Monad]
-       test)
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis]
-              (synthesis [".S" expression])
-              [".L" extension]))
-  (// common))
-
-(context: "Procedures"
-  (<| (times +100)
-      (do @
-        [num-args (|> r.nat (:: @ map (n/% +10)))
-         nameA (r.text +5)
-         argsA (r.list num-args gen-primitive)]
-        ($_ seq
-            (test "Can synthesize procedure calls."
-                  (|> (expressionS.synthesize extensionL.no-syntheses
-                                              (la.procedure nameA argsA))
-                      (case> (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])
-                             (and (text/= nameA procedure)
-                                  (list.every? (product.uncurry corresponds?)
-                                               (list.zip2 argsA argsS)))
-                             
-                             _
-                             #0)))
-            ))))
diff --git a/new-luxc/test/test/luxc/lang/translation/js.lux b/new-luxc/test/test/luxc/lang/translation/js.lux
deleted file mode 100644
index 83108c594..000000000
--- a/new-luxc/test/test/luxc/lang/translation/js.lux
+++ /dev/null
@@ -1,160 +0,0 @@
-(.module:
-  lux
-  (lux [io #+ IO]
-       (control [monad #+ do]
-                pipe)
-       (data ["e" error]
-             text/format
-             [number]
-             (coll [list "list/" Functor]
-                   [set]))
-       [math]
-       ["r" math/random]
-       (macro [code])
-       test)
-  (luxc (lang [synthesis #+ Synthesis]))
-  (test/luxc common))
-
-(def: upper-alpha-ascii
-  (r.Random Nat)
-  (|> r.nat (:: r.Functor map (|>> (n/% +91) (n/max +65)))))
-
-(def: (test-primitive-identity synthesis)
-  (-> Synthesis Bit)
-  (|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
-      (case> (#e.Success valueV)
-             (:coerce Bit valueV)
-
-             _
-             #0)))
-
-(type: Check (-> (e.Error Any) Bit))
-
-(template [  
 <=>]
-  [(def: ( angle)
-     (->  Check)
-     (|>> (case> (#e.Success valueV)
-                 (<=> (
 angle) (:coerce  valueV))
-                 
-                 (#e.Error error)
-                 #0)))]
-
-  [sin-check    Frac math.sin f/=]
-  [length-check Nat  id       n/=]
-  )
-
-(context: "[JS] Primitives."
-  ($_ seq
-      (test "Null is equal to itself."
-            (test-primitive-identity (` ("js null"))))
-      (test "Undefined is equal to itself."
-            (test-primitive-identity (` ("js undefined"))))
-      (test "Object comparison is by reference, not by value."
-            (not (test-primitive-identity (` ("js object")))))
-      (test "Values are equal to themselves."
-            (test-primitive-identity (` ("js global" "Math"))))
-      (<| (times +100)
-          (do @
-            [value r.int
-             #let [frac-value (int-to-frac value)]]
-            (test "Can call primitive functions."
-                  (|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
-                      (sin-check frac-value)))))
-      ))
-
-(context: "[JS] Objects."
-  (<| (times +100)
-      (do @
-        [field (:: @ map code.text (r.text' upper-alpha-ascii +5))
-         value r.int
-         #let [empty-object (` ("js object"))
-               object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
-               frac-value (int-to-frac value)]]
-        ($_ seq
-            (test "Cannot get non-existing fields from objects."
-                  (|> (run-js (` ("js object get" (~ field) (~ empty-object))))
-                      (case> (^multi (#e.Success valueV)
-                                     [(:coerce (Maybe Int) valueV) #.None])
-                             #1
-
-                             _
-                             #0)))
-            (test "Can get fields from objects."
-                  (|> (run-js (` ("js object get" (~ field) (~ object))))
-                      (case> (^multi (#e.Success valueV)
-                                     [(:coerce (Maybe Int) valueV) (#.Some valueV)])
-                             (i/= value (:coerce Int valueV))
-
-                             _
-                             #0)))
-            (test "Can delete fields from objects."
-                  (|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
-                                (` ("js object get" (~ field) (~ post-delete)))))
-                      (case> (^multi (#e.Success valueV)
-                                     [(:coerce (Maybe Int) valueV) #.None])
-                             #1
-
-                             _
-                             #0)))
-            (test "Can instance new objects."
-                  (let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
-                    (|> (run-js (` ("lux frac +" (~ base) 0.0)))
-                        (case> (#e.Success valueV)
-                               (f/= frac-value (:coerce Frac valueV))
-
-                               (#e.Error error)
-                               #0))))
-            (test "Can call methods on objects."
-                  (|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
-                      (sin-check frac-value)))
-            ))))
-
-(context: "[JS] Arrays."
-  (<| (times +100)
-      (do @
-        [length (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-         idx (|> r.nat (:: @ map (n/% length)))
-         overwrite r.nat
-         elems (|> (r.set number.Hash length r.nat)
-                   (:: @ map set.to-list))
-         #let [arrayS (` ("js array literal" (~+ (list/map code.nat elems))))]]
-        ($_ seq
-            (test "Can get the length of an array."
-                  (|> (run-js (` ("js array length" (~ arrayS))))
-                      (length-check length)))
-            (test "Can get an element from an array."
-                  (|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
-                      (case> (^multi (#e.Success elemV)
-                                     [[(list.nth idx elems) (:coerce (Maybe Nat) elemV)]
-                                      [(#.Some reference) (#.Some sample)]])
-                             (n/= reference sample)
-
-                             _
-                             #0)))
-            (test "Can write an element into an array."
-                  (let [idxS (code.nat idx)
-                        overwriteS (code.nat overwrite)]
-                    (|> (run-js (` ("js array read" (~ idxS)
-                                    ("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
-                        (case> (^multi (#e.Success elemV)
-                                       [(:coerce (Maybe Nat) elemV)
-                                        (#.Some sample)])
-                               (n/= overwrite sample)
-
-                               _
-                               #0))))
-            (test "Can delete an element from an array."
-                  (let [idxS (code.nat idx)
-                        deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
-                    (and (|> (run-js (` ("js array length" (~ deleteS))))
-                             (length-check length))
-                         (|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
-                             (case> (^multi (#e.Success elemV)
-                                            [(:coerce (Maybe Nat) elemV)
-                                             #.None])
-                                    #1
-
-                                    _
-                                    #0))
-                         )))
-            ))))
diff --git a/new-luxc/test/test/luxc/lang/translation/jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux
deleted file mode 100644
index 7c97b1e78..000000000
--- a/new-luxc/test/test/luxc/lang/translation/jvm.lux
+++ /dev/null
@@ -1,641 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [maybe]
-             ["e" error]
-             [bit]
-             [bit "bit/" Eq]
-             [number "int/" Number Codec]
-             [text "text/" Eq]
-             text/format
-             (coll [list]))
-       ["r" math/random "r/" Monad]
-       [macro]
-       (macro [code])
-       [host]
-       test)
-  (luxc [lang]
-        (lang [".L" host]
-              ["ls" synthesis]
-              (translation (jvm [".T" expression]
-                                [".T" eval]
-                                [".T" runtime]))))
-  (test/luxc common))
-
-(context: "Conversions [Part 1]"
-  (<| (times +100)
-      (do @
-        [int-sample (|> r.int (:: @ map (i/% 128)))
-         #let [frac-sample (int-to-frac int-sample)]]
-        (with-expansions [<2step> (template [     ]
-                                    [(test (format  " / " )
-                                           (|> (do macro.Monad
-                                                 [sampleI (expressionT.translate (|> (~ ( ))   (`)))]
-                                                 (evalT.eval sampleI))
-                                               (lang.with-current-module "")
-                                               (macro.run (io.run init-jvm))
-                                               (case> (#e.Success valueT)
-                                                      (  (:coerce  valueT))
-
-                                                      (#e.Error error)
-                                                      #0)))]
-
-                                    ["jvm convert double-to-float" "jvm convert float-to-double" code.frac frac-sample Frac f/=]
-                                    ["jvm convert double-to-int"   "jvm convert int-to-double" code.frac frac-sample Frac f/=]
-                                    ["jvm convert double-to-long"  "jvm convert long-to-double" code.frac frac-sample Frac f/=]
-
-                                    ["jvm convert long-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
-                                    ["jvm convert long-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
-                                    ["jvm convert long-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
-                                    ["jvm convert long-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
-                                    )]
-          ($_ seq
-              <2step>
-              )))))
-
-(context: "Conversions [Part 2]"
-  (<| (times +100)
-      (do @
-        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
-         #let [frac-sample (int-to-frac int-sample)]]
-        (`` ($_ seq
-                (~~ (template [      ]
-                      [(test (format  " / "  " / " )
-                             (|> (do macro.Monad
-                                   [sampleI (expressionT.translate (|> (~ ( ))    (`)))]
-                                   (evalT.eval sampleI))
-                                 (lang.with-current-module "")
-                                 (macro.run (io.run init-jvm))
-                                 (case> (#e.Success valueT)
-                                        (  (:coerce  valueT))
-
-                                        (#e.Error error)
-                                        #0)))]
-
-                      ["jvm convert long-to-int"   "jvm convert int-to-char"  "jvm convert char-to-long"  code.int int-sample Int i/=]
-                      ["jvm convert long-to-int"   "jvm convert int-to-byte"  "jvm convert byte-to-long"  code.int int-sample Int i/=]
-                      ["jvm convert long-to-int"   "jvm convert int-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
-                      ["jvm convert long-to-float" "jvm convert float-to-int" "jvm convert int-to-long"   code.int int-sample Int i/=]
-                      ["jvm convert long-to-int"   "jvm convert int-to-float" "jvm convert float-to-long" code.int int-sample Int i/=]
-                      ))
-                )))))
-
-(context: "Conversions [Part 3]"
-  (<| (times +100)
-      (do @
-        [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs)))
-         #let [frac-sample (int-to-frac int-sample)]]
-        (`` ($_ seq
-                (~~ (template [       ]
-                      [(test (format  " / "  " / " )
-                             (|> (do macro.Monad
-                                   [sampleI (expressionT.translate (|> (~ ( ))     (`)))]
-                                   (evalT.eval sampleI))
-                                 (lang.with-current-module "")
-                                 (macro.run (io.run init-jvm))
-                                 (case> (#e.Success valueT)
-                                        (  (:coerce  valueT))
-
-                                        (#e.Error error)
-                                        #0)))]
-
-                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-byte" "jvm convert byte-to-long" code.int int-sample Int i/=]
-                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-short" "jvm convert short-to-long" code.int int-sample Int i/=]
-                      ["jvm convert long-to-int" "jvm convert int-to-char" "jvm convert char-to-int" "jvm convert int-to-long" code.int int-sample Int i/=]
-                      ))
-                )))))
-
-(def: gen-nat
-  (r.Random Nat)
-  (|> r.nat
-      (r/map (n/% +128))
-      (r.filter (|>> (n/= +0) not))))
-
-(def: gen-int
-  (r.Random Int)
-  (|> gen-nat (r/map nat-to-int)))
-
-(def: gen-frac
-  (r.Random Frac)
-  (|> gen-int (r/map int-to-frac)))
-
-(template [      <+> <-> <*>  <%> 
 ]
-  [(context: (format "Arithmetic ["  "]")
-     (<| (times +100)
-         (do @
-           [param 
-            #let [subject ( param)]]
-           (with-expansions [ (template [ ]
-                                       [(test 
-                                              (|> (do macro.Monad
-                                                    [sampleI (expressionT.translate ( ((code.text )
-                                                                                             (
 ( subject))
-                                                                                             (
 ( param)))))]
-                                                    (evalT.eval sampleI))
-                                                  (lang.with-current-module "")
-                                                  (macro.run (io.run init-jvm))
-                                                  (case> (#e.Success valueT)
-                                                         ( ( param subject)
-                                                                 (:coerce  valueT))
-
-                                                         (#e.Error error)
-                                                         #0)))]
-
-                                       [(format "jvm "  " +") <+>]
-                                       [(format "jvm "  " -") <->]
-                                       [(format "jvm "  " *") <*>]
-                                       [(format "jvm "  " /") ]
-                                       [(format "jvm "  " %") <%>]
-                                       )]
-             ($_ seq
-                 
-                 )))))]
-
-  ["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"]
-  ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% id id]
-  ["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"]
-  ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id]
-  )
-
-(template [  ]
-  [(context: (format "Bit-wise ["  "] { Combiners ]")
-     (<| (times +100)
-         (do @
-           [param gen-nat
-            subject gen-nat]
-           (`` ($_ seq
-                   (~~ (template [ ]
-                         [(test 
-                                (|> (do macro.Monad
-                                      [sampleI (expressionT.translate ( ((code.text )
-                                                                               ( (code.nat subject))
-                                                                               ( (code.nat param)))))]
-                                      (evalT.eval sampleI))
-                                    (lang.with-current-module "")
-                                    (macro.run (io.run init-jvm))
-                                    (case> (#e.Success valueT)
-                                           (n/= ( param subject)
-                                                (:coerce Nat valueT))
-
-                                           (#e.Error error)
-                                           #0)))]
-
-                         [(format "jvm "  " and") bit.and]
-                         [(format "jvm "  " or") bit.or]
-                         [(format "jvm "  " xor") bit.xor]
-                         ))
-                   )))))]
-
-  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
-  ["long" id id]
-  )
-
-(template [  ]
-  [(context: (format "Bit-wise ["  "] { Shifters }")
-     (<| (times +100)
-         (do @
-           [param gen-nat
-            subject gen-nat
-            #let [shift (n/% +10 param)]]
-           (`` ($_ seq
-                   (~~ (template [     
]
-                         [(test 
-                                (|> (do macro.Monad
-                                      [sampleI (expressionT.translate ( ((code.text )
-                                                                               ( (
 subject))
-                                                                               ("jvm convert long-to-int" (code.nat shift)))))]
-                                      (evalT.eval sampleI))
-                                    (lang.with-current-module "")
-                                    (macro.run (io.run init-jvm))
-                                    (case> (#e.Success valueT)
-                                           ( ( shift ( subject))
-                                                   (:coerce  valueT))
-
-                                           (#e.Error error)
-                                           #0)))]
-
-                         [(format "jvm "  " shl") bit.left-shift Nat n/= id code.nat]
-                         [(format "jvm "  " shr") bit.arithmetic-right-shift Int i/= nat-to-int (|>> nat-to-int code.int)]
-                         [(format "jvm "  " ushr") bit.logical-right-shift Nat n/= id code.nat]
-                         ))
-                   )))))]
-
-  ["int" "jvm convert int-to-long" "jvm convert long-to-int"]
-  ["long" id id]
-  )
-
-(template [   <=> <<> 
]
-  [(context: (format "Order ["  "]")
-     (<| (times +100)
-         (do @
-           [param 
-            subject ]
-           (with-expansions [ (template [ ]
-                                       [(test 
-                                              (|> (do macro.Monad
-                                                    [sampleI (expressionT.translate ((code.text )
-                                                                                     (
 ( subject))
-                                                                                     (
 ( param))))]
-                                                    (evalT.eval sampleI))
-                                                  (lang.with-current-module "")
-                                                  (macro.run (io.run init-jvm))
-                                                  (case> (#e.Success valueT)
-                                                         (bit/= ( param subject)
-                                                                (:coerce Bit valueT))
-
-                                                         (#e.Error error)
-                                                         #0)))]
-
-                                       [(format "jvm "  " =") <=>]
-                                       [(format "jvm "  " <") <<>]
-                                       )]
-             ($_ seq
-                 
-                 )))))]
-
-  ["int" gen-int code.int i/= i/< "jvm convert long-to-int"]
-  ["long" gen-int code.int i/= i/< id]
-  ["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"]
-  ["double" gen-frac code.frac f/= f/< id]
-  ["char" gen-int code.int i/= i/< "jvm convert long-to-char"]
-  )
-
-(def: (jvm//array//new dimension class size)
-  (-> Nat Text Nat ls.Synthesis)
-  (` ("jvm array new" (~ (code.nat dimension)) (~ (code.text class)) (~ (code.nat size)))))
-
-(def: (jvm//array//write class idx inputS arrayS)
-  (-> Text Nat ls.Synthesis ls.Synthesis ls.Synthesis)
-  (` ("jvm array write" (~ (code.text class)) (~ (code.nat idx)) (~ inputS) (~ arrayS))))
-
-(def: (jvm//array//read class idx arrayS)
-  (-> Text Nat ls.Synthesis ls.Synthesis)
-  (` ("jvm array read" (~ (code.text class)) (~ (code.nat idx)) (~ arrayS))))
-
-(context: "Array [Part 1]"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-         idx (|> r.nat (:: @ map (n/% size)))
-         valueZ r.bit
-         valueB gen-int
-         valueS gen-int
-         valueI gen-int
-         valueL r.int
-         valueF gen-frac
-         valueD r.frac
-         valueC gen-int]
-        (with-expansions [ (template [     ]
-                                    [(test 
-                                           (|> (do macro.Monad
-                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
-                                                                                     (jvm//array//write  idx )
-                                                                                     (jvm//array//read  idx)
-                                                                                     ))]
-                                                 (evalT.eval sampleI))
-                                               (lang.with-current-module "")
-                                               (macro.run (io.run init-jvm))
-                                               (case> (#e.Success outputZ)
-                                                      (  (:coerce  outputZ))
-
-                                                      (#e.Error error)
-                                                      #0)))]
-
-                                    ["boolean" Bit valueZ bit/= (code.bit valueZ)
-                                     id]
-                                    ["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`))
-                                     "jvm convert byte-to-long"]
-                                    ["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`))
-                                     "jvm convert short-to-long"]
-                                    ["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`))
-                                     "jvm convert int-to-long"]
-                                    ["long" Int valueL i/= (code.int valueL)
-                                     id]
-                                    ["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`))
-                                     "jvm convert float-to-double"]
-                                    ["double" Frac valueD f/= (code.frac valueD)
-                                     id]
-                                    )]
-          ($_ seq
-              
-              )))))
-
-(context: "Array [Part 2]"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-         idx (|> r.nat (:: @ map (n/% size)))
-         valueZ r.bit
-         valueB gen-int
-         valueS gen-int
-         valueI gen-int
-         valueL r.int
-         valueF gen-frac
-         valueD r.frac
-         valueC gen-int]
-        (with-expansions [ (template [     ]
-                                    [(test 
-                                           (|> (do macro.Monad
-                                                 [sampleI (expressionT.translate (|> (jvm//array//new +0  size)
-                                                                                     (jvm//array//write  idx )
-                                                                                     (jvm//array//read  idx)
-                                                                                     ))]
-                                                 (evalT.eval sampleI))
-                                               (lang.with-current-module "")
-                                               (macro.run (io.run init-jvm))
-                                               (case> (#e.Success outputT)
-                                                      (  (:coerce  outputT))
-
-                                                      (#e.Error error)
-                                                      #0)))]
-
-                                    ["char" Int valueC i/=
-                                     (|> (code.int valueC) (~) "jvm convert long-to-int" "jvm convert int-to-char" (`))
-                                     "jvm convert char-to-long"]
-                                    ["java.lang.Long" Int valueL i/=
-                                     (code.int valueL)
-                                     id]
-                                    )]
-          ($_ seq
-              
-              (test "java.lang.Double (level 1)"
-                    (|> (do macro.Monad
-                          [#let [inner (|> ("jvm array new" +0 "java.lang.Double" (~ (code.nat size)))
-                                           ("jvm array write" "java.lang.Double" (~ (code.nat idx)) (~ (code.frac valueD)))
-                                           (`))]
-                           sampleI (expressionT.translate (|> ("jvm array new" +1 "java.lang.Double" (~ (code.nat size)))
-                                                              ("jvm array write" "#Array" (~ (code.nat idx)) (~ inner))
-                                                              ("jvm array read" "#Array" (~ (code.nat idx)))
-                                                              ("jvm array read" "java.lang.Double" (~ (code.nat idx)))
-                                                              (`)))]
-                          (evalT.eval sampleI))
-                        (lang.with-current-module "")
-                        (macro.run (io.run init-jvm))
-                        (case> (#e.Success outputT)
-                               (f/= valueD (:coerce Frac outputT))
-
-                               (#e.Error error)
-                               #0)))
-              (test "jvm array length"
-                    (|> (do macro.Monad
-                          [sampleI (expressionT.translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code.nat size))))))]
-                          (evalT.eval sampleI))
-                        (lang.with-current-module "")
-                        (macro.run (io.run init-jvm))
-                        (case> (#e.Success outputT)
-                               (n/= size (:coerce Nat outputT))
-
-                               (#e.Error error)
-                               #0)))
-              )))))
-
-(host.import: java/lang/Class
-  (getName [] String))
-
-(def: classes
-  (List Text)
-  (list "java.lang.Object" "java.lang.Class"
-        "java.lang.String" "java.lang.Number"))
-
-(def: instances
-  (List [Text (r.Random ls.Synthesis)])
-  (let [gen-boolean (|> r.bit (:: r.Functor map code.bit))
-        gen-integer (|> r.int (:: r.Functor map code.int))
-        gen-double (|> r.frac (:: r.Functor map code.frac))
-        gen-string (|> (r.text +5) (:: r.Functor map code.text))]
-    (list ["java.lang.Boolean" gen-boolean]
-          ["java.lang.Long" gen-integer]
-          ["java.lang.Double" gen-double]
-          ["java.lang.String" gen-string]
-          ["java.lang.Object" (r.either (r.either gen-boolean
-                                                  gen-integer)
-                                        (r.either gen-double
-                                                  gen-string))])))
-
-(context: "Object."
-  (<| (times +100)
-      (do @
-        [#let [num-classes (list.size classes)]
-         #let [num-instances (list.size instances)]
-         class-idx (|> r.nat (:: @ map (n/% num-classes)))
-         instance-idx (|> r.nat (:: @ map (n/% num-instances)))
-         exception-message (r.text +5)
-         #let [class (maybe.assume (list.nth class-idx classes))
-               [instance-class instance-gen] (maybe.assume (list.nth instance-idx instances))
-               exception-message$ (` ["java.lang.String" (~ (code.text exception-message))])]
-         sample r.int
-         monitor r.int
-         instance instance-gen]
-        ($_ seq
-            (test "jvm object null"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object null?" ("jvm object null"))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (:coerce Bit outputT)
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm object null?"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object null?" (~ (code.int sample)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (not (:coerce Bit outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm object synchronized"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object synchronized" (~ (code.int monitor)) (~ (code.int sample)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (i/= sample (:coerce Int outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm object throw"
-                  (|> (do macro.Monad
-                        [_ runtimeT.translate
-                         sampleI (expressionT.translate (` ("lux try" ("lux function" +1 []
-                                                                       ("jvm object throw" ("jvm member invoke constructor"
-                                                                                            "java.lang.Throwable"
-                                                                                            (~ exception-message$)))))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (case (:coerce (e.Error Any) outputT)
-                               (#e.Error error)
-                               (text.contains? exception-message error)
-
-                               (#e.Success outputT)
-                               #0)
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm object class"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object class" (~ (code.text class)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (|> outputT (:coerce Class) (Class::getName []) (text/= class))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm object instance?"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object instance?" (~ (code.text instance-class)) (~ instance))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (:coerce Bit outputT)
-
-                             (#e.Error error)
-                             #0)))
-            ))))
-
-(host.import: java/util/GregorianCalendar
-  (#static AD int))
-
-(context: "Member [Field]"
-  (<| (times +100)
-      (do @
-        [sample-short (|> r.int (:: @ map (|>> int/abs (i/% 100))))
-         sample-string (r.text +5)
-         other-sample-string (r.text +5)
-         #let [shortS (` ["short" ("jvm object cast" "java.lang.Short" "short"
-                                   ("jvm convert long-to-short" (~ (code.int sample-short))))])
-               stringS (` ["java.lang.String" (~ (code.text sample-string))])
-               type-codeS (` ["org.omg.CORBA.TypeCode" ("jvm object null")])
-               idl-typeS (` ["org.omg.CORBA.IDLType" ("jvm object null")])
-               value-memberS (` ("jvm member invoke constructor"
-                                 "org.omg.CORBA.ValueMember"
-                                 (~ stringS) (~ stringS) (~ stringS) (~ stringS)
-                                 (~ type-codeS) (~ idl-typeS) (~ shortS)))]]
-        ($_ seq
-            (test "jvm member static get"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (i/= GregorianCalendar::AD (:coerce Int outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member static put"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"
-                                                            ("jvm member static get" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (is? hostL.unit (:coerce Text outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member virtual get"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (text/= sample-string (:coerce Text outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member virtual put"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
-                                                            ("jvm member virtual put" "org.omg.CORBA.ValueMember" "name" "java.lang.String"
-                                                             (~ (code.text other-sample-string)) (~ value-memberS)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (text/= other-sample-string (:coerce Text outputT))
-
-                             (#e.Error error)
-                             #0)))
-            ))))
-
-(host.import: java/lang/Object)
-
-(host.import: (java/util/ArrayList a))
-
-(context: "Member [Method]"
-  (<| (times +100)
-      (do @
-        [sample (|> r.int (:: @ map (|>> int/abs (i/% 100))))
-         #let [object-longS (` ["java.lang.Object" (~ (code.int sample))])
-               intS (` ["int" ("jvm object cast" "java.lang.Integer" "int"
-                               ("jvm convert long-to-int" (~ (code.int sample))))])
-               coded-intS (` ["java.lang.String" (~ (code.text (int/encode sample)))])
-               array-listS (` ("jvm member invoke constructor" "java.util.ArrayList" (~ intS)))]]
-        ($_ seq
-            (test "jvm member invoke static"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long"
-                                                            "decode" "java.lang.Long"
-                                                            (~ coded-intS))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (i/= sample (:coerce Int outputT))
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member invoke virtual"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
-                                                            ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean"
-                                                             (~ (code.int sample)) (~ object-longS)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (:coerce Bit outputT)
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member invoke interface"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean"
-                                                            ("jvm member invoke interface" "java.util.Collection" "add" "boolean"
-                                                             (~ array-listS) (~ object-longS)))))]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (:coerce Bit outputT)
-
-                             (#e.Error error)
-                             #0)))
-            (test "jvm member invoke constructor"
-                  (|> (do macro.Monad
-                        [sampleI (expressionT.translate array-listS)]
-                        (evalT.eval sampleI))
-                      (lang.with-current-module "")
-                      (macro.run (io.run init-jvm))
-                      (case> (#e.Success outputT)
-                             (host.instance? ArrayList (:coerce Object outputT))
-
-                             (#e.Error error)
-                             #0)))
-            ))))
-- 
cgit v1.2.3