From 660c7fe6af927c6e668a86e44fd2f0a9b1fb8b8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Jul 2018 02:10:54 -0400 Subject: - Re-named "Compiler" to "Phase". - Re-structured the compiler infrastructure. --- stdlib/source/lux/compiler/default.lux | 9 + stdlib/source/lux/compiler/default/cache.lux | 35 + stdlib/source/lux/compiler/default/init.lux | 52 + stdlib/source/lux/compiler/default/name.lux | 48 + stdlib/source/lux/compiler/default/phase.lux | 69 ++ .../source/lux/compiler/default/phase/analysis.lux | 285 +++++ .../lux/compiler/default/phase/analysis/case.lux | 296 +++++ .../default/phase/analysis/case/coverage.lux | 325 +++++ .../compiler/default/phase/analysis/expression.lux | 121 ++ .../compiler/default/phase/analysis/function.lux | 102 ++ .../compiler/default/phase/analysis/inference.lux | 259 ++++ .../lux/compiler/default/phase/analysis/module.lux | 255 ++++ .../compiler/default/phase/analysis/primitive.lux | 29 + .../compiler/default/phase/analysis/reference.lux | 79 ++ .../lux/compiler/default/phase/analysis/scope.lux | 197 +++ .../compiler/default/phase/analysis/structure.lux | 360 ++++++ .../lux/compiler/default/phase/analysis/type.lux | 52 + .../lux/compiler/default/phase/extension.lux | 114 ++ .../compiler/default/phase/extension/analysis.lux | 15 + .../default/phase/extension/analysis/common.lux | 370 ++++++ .../default/phase/extension/analysis/host.jvm.lux | 1271 ++++++++++++++++++++ .../compiler/default/phase/extension/bundle.lux | 38 + .../compiler/default/phase/extension/synthesis.lux | 10 + .../default/phase/extension/translation.lux | 10 + .../lux/compiler/default/phase/synthesis.lux | 264 ++++ .../lux/compiler/default/phase/synthesis/case.lux | 181 +++ .../default/phase/synthesis/expression.lux | 94 ++ .../compiler/default/phase/synthesis/function.lux | 134 +++ .../lux/compiler/default/phase/synthesis/loop.lux | 291 +++++ .../lux/compiler/default/phase/translation.lux | 196 +++ .../default/phase/translation/scheme/case.jvm.lux | 177 +++ .../phase/translation/scheme/expression.jvm.lux | 59 + .../phase/translation/scheme/extension.jvm.lux | 15 + .../translation/scheme/extension/common.jvm.lux | 360 ++++++ .../translation/scheme/extension/host.jvm.lux | 11 + .../phase/translation/scheme/function.jvm.lux | 92 ++ .../default/phase/translation/scheme/loop.jvm.lux | 41 + .../phase/translation/scheme/primitive.jvm.lux | 25 + .../phase/translation/scheme/reference.jvm.lux | 60 + .../phase/translation/scheme/runtime.jvm.lux | 374 ++++++ .../phase/translation/scheme/structure.jvm.lux | 33 + stdlib/source/lux/compiler/default/reference.lux | 67 ++ stdlib/source/lux/compiler/default/repl/type.lux | 203 ++++ stdlib/source/lux/compiler/default/syntax.lux | 629 ++++++++++ stdlib/source/lux/compiler/host.lux | 18 + stdlib/source/lux/compiler/host/scheme.lux | 306 +++++ stdlib/source/lux/compiler/meta/archive.lux | 122 ++ stdlib/source/lux/compiler/meta/cache.lux | 167 +++ .../source/lux/compiler/meta/cache/dependency.lux | 53 + stdlib/source/lux/compiler/meta/io.lux | 14 + stdlib/source/lux/compiler/meta/io/archive.lux | 74 ++ stdlib/source/lux/compiler/meta/io/context.lux | 94 ++ stdlib/source/lux/data/text.lux | 4 +- stdlib/source/lux/data/text/buffer.lux | 2 +- stdlib/source/lux/data/text/encoding.lux | 2 +- stdlib/source/lux/language.lux | 9 - stdlib/source/lux/language/compiler.lux | 69 -- stdlib/source/lux/language/compiler/analysis.lux | 285 ----- .../source/lux/language/compiler/analysis/case.lux | 296 ----- .../language/compiler/analysis/case/coverage.lux | 325 ----- .../lux/language/compiler/analysis/expression.lux | 121 -- .../lux/language/compiler/analysis/function.lux | 102 -- .../lux/language/compiler/analysis/inference.lux | 259 ---- .../lux/language/compiler/analysis/module.lux | 255 ---- .../lux/language/compiler/analysis/primitive.lux | 29 - .../lux/language/compiler/analysis/reference.lux | 79 -- .../lux/language/compiler/analysis/scope.lux | 197 --- .../lux/language/compiler/analysis/structure.lux | 360 ------ .../source/lux/language/compiler/analysis/type.lux | 52 - .../source/lux/language/compiler/default/cache.lux | 35 - .../lux/language/compiler/default/repl/type.lux | 203 ---- stdlib/source/lux/language/compiler/extension.lux | 114 -- .../lux/language/compiler/extension/analysis.lux | 15 - .../compiler/extension/analysis/common.lux | 371 ------ .../compiler/extension/analysis/host.jvm.lux | 1271 -------------------- .../lux/language/compiler/extension/bundle.lux | 38 - .../lux/language/compiler/extension/synthesis.lux | 10 - .../language/compiler/extension/translation.lux | 10 - stdlib/source/lux/language/compiler/init.lux | 51 - .../source/lux/language/compiler/meta/archive.lux | 121 -- stdlib/source/lux/language/compiler/meta/cache.lux | 167 --- .../language/compiler/meta/cache/dependency.lux | 53 - stdlib/source/lux/language/compiler/meta/io.lux | 14 - .../lux/language/compiler/meta/io/archive.lux | 73 -- .../lux/language/compiler/meta/io/context.lux | 94 -- stdlib/source/lux/language/compiler/synthesis.lux | 264 ---- .../lux/language/compiler/synthesis/case.lux | 181 --- .../lux/language/compiler/synthesis/expression.lux | 94 -- .../lux/language/compiler/synthesis/function.lux | 134 --- .../lux/language/compiler/synthesis/loop.lux | 291 ----- .../source/lux/language/compiler/translation.lux | 196 --- .../compiler/translation/scheme/case.jvm.lux | 176 --- .../compiler/translation/scheme/expression.jvm.lux | 59 - .../compiler/translation/scheme/extension.jvm.lux | 15 - .../translation/scheme/extension/common.jvm.lux | 360 ------ .../translation/scheme/extension/host.jvm.lux | 11 - .../compiler/translation/scheme/function.jvm.lux | 91 -- .../compiler/translation/scheme/loop.jvm.lux | 41 - .../compiler/translation/scheme/primitive.jvm.lux | 24 - .../compiler/translation/scheme/reference.jvm.lux | 58 - .../compiler/translation/scheme/runtime.jvm.lux | 372 ------ .../compiler/translation/scheme/structure.jvm.lux | 33 - stdlib/source/lux/language/host.lux | 18 - stdlib/source/lux/language/host/scheme.lux | 306 ----- stdlib/source/lux/language/name.lux | 48 - stdlib/source/lux/language/reference.lux | 67 -- stdlib/source/lux/language/syntax.lux | 629 ---------- stdlib/source/lux/world/file.lux | 5 +- .../lux/compiler/default/phase/analysis/case.lux | 198 +++ .../compiler/default/phase/analysis/function.lux | 120 ++ .../compiler/default/phase/analysis/primitive.lux | 93 ++ .../default/phase/analysis/procedure/common.lux | 308 +++++ .../compiler/default/phase/analysis/reference.lux | 109 ++ .../compiler/default/phase/analysis/structure.lux | 299 +++++ .../lux/compiler/default/phase/synthesis/case.lux | 88 ++ .../compiler/default/phase/synthesis/function.lux | 175 +++ .../compiler/default/phase/synthesis/primitive.lux | 97 ++ .../compiler/default/phase/synthesis/structure.lux | 63 + stdlib/test/test/lux/compiler/default/syntax.lux | 248 ++++ .../test/lux/language/compiler/analysis/case.lux | 197 --- .../lux/language/compiler/analysis/function.lux | 119 -- .../lux/language/compiler/analysis/primitive.lux | 92 -- .../compiler/analysis/procedure/common.lux | 307 ----- .../lux/language/compiler/analysis/reference.lux | 108 -- .../lux/language/compiler/analysis/structure.lux | 298 ----- .../test/lux/language/compiler/synthesis/case.lux | 87 -- .../lux/language/compiler/synthesis/function.lux | 174 --- .../lux/language/compiler/synthesis/primitive.lux | 96 -- .../lux/language/compiler/synthesis/structure.lux | 62 - stdlib/test/test/lux/language/syntax.lux | 247 ---- stdlib/test/tests.lux | 80 +- 131 files changed, 10400 insertions(+), 10379 deletions(-) create mode 100644 stdlib/source/lux/compiler/default.lux create mode 100644 stdlib/source/lux/compiler/default/cache.lux create mode 100644 stdlib/source/lux/compiler/default/init.lux create mode 100644 stdlib/source/lux/compiler/default/name.lux create mode 100644 stdlib/source/lux/compiler/default/phase.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/case.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/expression.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/function.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/inference.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/module.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/primitive.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/reference.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/scope.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/structure.lux create mode 100644 stdlib/source/lux/compiler/default/phase/analysis/type.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/analysis.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/bundle.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/synthesis.lux create mode 100644 stdlib/source/lux/compiler/default/phase/extension/translation.lux create mode 100644 stdlib/source/lux/compiler/default/phase/synthesis.lux create mode 100644 stdlib/source/lux/compiler/default/phase/synthesis/case.lux create mode 100644 stdlib/source/lux/compiler/default/phase/synthesis/expression.lux create mode 100644 stdlib/source/lux/compiler/default/phase/synthesis/function.lux create mode 100644 stdlib/source/lux/compiler/default/phase/synthesis/loop.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/expression.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/extension.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/extension/host.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/function.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/loop.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/primitive.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/phase/translation/scheme/structure.jvm.lux create mode 100644 stdlib/source/lux/compiler/default/reference.lux create mode 100644 stdlib/source/lux/compiler/default/repl/type.lux create mode 100644 stdlib/source/lux/compiler/default/syntax.lux create mode 100644 stdlib/source/lux/compiler/host.lux create mode 100644 stdlib/source/lux/compiler/host/scheme.lux create mode 100644 stdlib/source/lux/compiler/meta/archive.lux create mode 100644 stdlib/source/lux/compiler/meta/cache.lux create mode 100644 stdlib/source/lux/compiler/meta/cache/dependency.lux create mode 100644 stdlib/source/lux/compiler/meta/io.lux create mode 100644 stdlib/source/lux/compiler/meta/io/archive.lux create mode 100644 stdlib/source/lux/compiler/meta/io/context.lux delete mode 100644 stdlib/source/lux/language.lux delete mode 100644 stdlib/source/lux/language/compiler.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/case.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/case/coverage.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/expression.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/function.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/inference.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/module.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/primitive.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/reference.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/scope.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/structure.lux delete mode 100644 stdlib/source/lux/language/compiler/analysis/type.lux delete mode 100644 stdlib/source/lux/language/compiler/default/cache.lux delete mode 100644 stdlib/source/lux/language/compiler/default/repl/type.lux delete mode 100644 stdlib/source/lux/language/compiler/extension.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/analysis.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/analysis/common.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/bundle.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/synthesis.lux delete mode 100644 stdlib/source/lux/language/compiler/extension/translation.lux delete mode 100644 stdlib/source/lux/language/compiler/init.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/archive.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/cache.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/cache/dependency.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/io.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/io/archive.lux delete mode 100644 stdlib/source/lux/language/compiler/meta/io/context.lux delete mode 100644 stdlib/source/lux/language/compiler/synthesis.lux delete mode 100644 stdlib/source/lux/language/compiler/synthesis/case.lux delete mode 100644 stdlib/source/lux/language/compiler/synthesis/expression.lux delete mode 100644 stdlib/source/lux/language/compiler/synthesis/function.lux delete mode 100644 stdlib/source/lux/language/compiler/synthesis/loop.lux delete mode 100644 stdlib/source/lux/language/compiler/translation.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/extension/host.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux delete mode 100644 stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux delete mode 100644 stdlib/source/lux/language/host.lux delete mode 100644 stdlib/source/lux/language/host/scheme.lux delete mode 100644 stdlib/source/lux/language/name.lux delete mode 100644 stdlib/source/lux/language/reference.lux delete mode 100644 stdlib/source/lux/language/syntax.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/case.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/function.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux create mode 100644 stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux create mode 100644 stdlib/test/test/lux/compiler/default/syntax.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/case.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/function.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/primitive.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/reference.lux delete mode 100644 stdlib/test/test/lux/language/compiler/analysis/structure.lux delete mode 100644 stdlib/test/test/lux/language/compiler/synthesis/case.lux delete mode 100644 stdlib/test/test/lux/language/compiler/synthesis/function.lux delete mode 100644 stdlib/test/test/lux/language/compiler/synthesis/primitive.lux delete mode 100644 stdlib/test/test/lux/language/compiler/synthesis/structure.lux delete mode 100644 stdlib/test/test/lux/language/syntax.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux new file mode 100644 index 000000000..bc6e2c9ec --- /dev/null +++ b/stdlib/source/lux/compiler/default.lux @@ -0,0 +1,9 @@ +(.module: + lux) + +(type: #export Eval + (-> Type Code (Meta Any))) + +(type: #export Version Text) + +(def: #export version Version "0.6.0") diff --git a/stdlib/source/lux/compiler/default/cache.lux b/stdlib/source/lux/compiler/default/cache.lux new file mode 100644 index 000000000..d8f841e13 --- /dev/null +++ b/stdlib/source/lux/compiler/default/cache.lux @@ -0,0 +1,35 @@ +(.module: + [lux #* + [data + [format + ["_" binary (#+ Format)]]]]) + +(def: definition + (Format Definition) + ($_ _.seq _.type _.code _.any)) + +(def: alias + (Format [Text Text]) + (_.seq _.text _.text)) + +## TODO: Remove #module-hash, #imports & #module-state ASAP. +## TODO: Not just from this parser, but from the lux.Module type. +(def: #export module + (Format Module) + ($_ _.seq + ## #module-hash + (_.ignore +0) + ## #module-aliases + (_.list ..alias) + ## #definitions + (_.list (_.seq _.text ..definition)) + ## #imports + (_.list _.text) + ## #tags + (_.ignore (list)) + ## #types + (_.ignore (list)) + ## #module-annotations + (_.maybe _.code) + ## #module-state + (_.ignore #.Cached))) diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux new file mode 100644 index 000000000..cac69ab89 --- /dev/null +++ b/stdlib/source/lux/compiler/default/init.lux @@ -0,0 +1,52 @@ +(.module: + lux + ["." // + [// + ["." host]]]) + +(def: #export (cursor file) + (-> Text Cursor) + [file +1 +0]) + +(def: #export (source file code) + (-> Text Text Source) + [(cursor file) +0 code]) + +(def: dummy-source + Source + [.dummy-cursor +0 ""]) + +(def: #export type-context + Type-Context + {#.ex-counter +0 + #.var-counter +0 + #.var-bindings (list)}) + +(`` (def: #export info + Info + {#.target (for {(~~ (static host.common-lisp)) host.common-lisp + (~~ (static host.js)) host.js + (~~ (static host.jvm)) host.jvm + (~~ (static host.lua)) host.lua + (~~ (static host.php)) host.php + (~~ (static host.python)) host.python + (~~ (static host.r)) host.r + (~~ (static host.ruby)) host.ruby + (~~ (static host.scheme)) host.scheme}) + #.version //.version + #.mode #.Build})) + +(def: #export (compiler host) + (-> Any Lux) + {#.info ..info + #.source dummy-source + #.cursor .dummy-cursor + #.current-module #.None + #.modules (list) + #.scopes (list) + #.type-context ..type-context + #.expected #.None + #.seed +0 + #.scope-type-vars (list) + #.extensions [] + #.host host}) diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux new file mode 100644 index 000000000..f6489b89c --- /dev/null +++ b/stdlib/source/lux/compiler/default/name.lux @@ -0,0 +1,48 @@ +(.module: + [lux #* + [data + ["." maybe] + ["." text + format]]]) + +(def: (sanitize char) + (-> Nat Text) + (case char + (^ (char "*")) "_ASTER_" + (^ (char "+")) "_PLUS_" + (^ (char "-")) "_DASH_" + (^ (char "/")) "_SLASH_" + (^ (char "\\")) "_BSLASH_" + (^ (char "_")) "_UNDERS_" + (^ (char "%")) "_PERCENT_" + (^ (char "$")) "_DOLLAR_" + (^ (char "'")) "_QUOTE_" + (^ (char "`")) "_BQUOTE_" + (^ (char "@")) "_AT_" + (^ (char "^")) "_CARET_" + (^ (char "&")) "_AMPERS_" + (^ (char "=")) "_EQ_" + (^ (char "!")) "_BANG_" + (^ (char "?")) "_QM_" + (^ (char ":")) "_COLON_" + (^ (char ".")) "_PERIOD_" + (^ (char ",")) "_COMMA_" + (^ (char "<")) "_LT_" + (^ (char ">")) "_GT_" + (^ (char "~")) "_TILDE_" + (^ (char "|")) "_PIPE_" + _ (text.from-code char))) + +(def: #export (normalize name) + (-> Text Text) + (let [name/size (text.size name)] + (loop [idx +0 + output ""] + (if (n/< name/size idx) + (recur (inc idx) + (|> (text.nth idx name) maybe.assume sanitize (format output))) + output)))) + +(def: #export (definition [module name]) + (-> Ident Text) + (format (normalize module) "___" (normalize name))) diff --git a/stdlib/source/lux/compiler/default/phase.lux b/stdlib/source/lux/compiler/default/phase.lux new file mode 100644 index 000000000..24bba1229 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase.lux @@ -0,0 +1,69 @@ +(.module: + [lux #* + [control + ["." state] + ["ex" exception (#+ Exception exception:)] + [monad (#+ do)]] + [data + ["." product] + ["." error (#+ Error)] + ["." text + format]] + [macro + ["s" syntax (#+ syntax:)]]]) + +(type: #export (Operation s o) + (state.State' Error s o)) + +(def: #export Monad + (state.Monad error.Monad)) + +(type: #export (Phase s i o) + (-> i (Operation s o))) + +(def: #export (run' state operation) + (All [s o] + (-> s (Operation s o) (Error [s o]))) + (operation state)) + +(def: #export (run state operation) + (All [s o] + (-> s (Operation s o) (Error o))) + (|> state + operation + (:: error.Monad map product.right))) + +(def: #export fail + (-> Text Operation) + (|>> error.fail (state.lift error.Monad))) + +(def: #export (throw exception parameters) + (All [e] (-> (Exception e) e Operation)) + (state.lift error.Monad + (ex.throw exception parameters))) + +(syntax: #export (assert exception message test) + (wrap (list (` (if (~ test) + (:: ..Monad (~' wrap) []) + (..throw (~ exception) (~ message))))))) + +(def: #export (with-stack exception message action) + (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o))) + (<<| (ex.with-stack exception message) + action)) + +(def: #export identity + (All [s a] (Phase s a a)) + (function (_ input state) + (#error.Success [state input]))) + +(def: #export (compose pre post) + (All [s0 s1 i t o] + (-> (Phase s0 i t) + (Phase s1 t o) + (Phase [s0 s1] i o))) + (function (_ input [pre/state post/state]) + (do error.Monad + [[pre/state' temp] (pre input pre/state) + [post/state' output] (post temp post/state)] + (wrap [[pre/state' post/state'] output])))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux new file mode 100644 index 000000000..182e3c321 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -0,0 +1,285 @@ +(.module: + [lux (#- nat int rev) + [data + ["." product] + ["." error] + [text ("text/." Equivalence)] + [collection + ["." list ("list/." Fold)]]] + ["." function]] + [// + ["." extension (#+ Extension)] + [// + ["." reference (#+ Register Variable Reference)]]]) + +(type: #export #rec Primitive + #Unit + (#Bit Bit) + (#Nat Nat) + (#Int Int) + (#Rev Rev) + (#Frac Frac) + (#Text Text)) + +(type: #export Tag Nat) + +(type: #export (Composite a) + (#Sum (Either a a)) + (#Product [a a])) + +(type: #export #rec Pattern + (#Simple Primitive) + (#Complex (Composite Pattern)) + (#Bind Register)) + +(type: #export (Branch' e) + {#when Pattern + #then e}) + +(type: #export (Match' e) + [(Branch' e) (List (Branch' e))]) + +(type: #export Environment + (List Variable)) + +(type: #export #rec Analysis + (#Primitive Primitive) + (#Structure (Composite Analysis)) + (#Reference Reference) + (#Case Analysis (Match' Analysis)) + (#Function Environment Analysis) + (#Apply Analysis Analysis) + (#Extension (Extension Analysis))) + +(type: #export Operation + (extension.Operation .Lux Code Analysis)) + +(type: #export Phase + (extension.Phase .Lux Code Analysis)) + +(type: #export Handler + (extension.Handler .Lux .Code Analysis)) + +(type: #export Bundle + (extension.Bundle .Lux .Code Analysis)) + +(type: #export Branch + (Branch' Analysis)) + +(type: #export Match + (Match' Analysis)) + +(do-template [ ] + [(template: #export ( content) + ( content))] + + [control/case #Case] + ) + +(do-template [ ] + [(def: #export + (-> Analysis) + (|>> #Primitive))] + + [bit Bit #Bit] + [nat Nat #Nat] + [int Int #Int] + [rev Rev #Rev] + [frac Frac #Frac] + [text Text #Text] + ) + +(type: #export (Variant a) + {#lefts Nat + #right? Bit + #value a}) + +(type: #export (Tuple a) (List a)) + +(type: #export Arity Nat) + +(type: #export (Abstraction c) [Environment Arity c]) + +(type: #export (Application c) [c (List c)]) + +(def: (last? size tag) + (-> Nat Tag Bit) + (n/= (dec size) tag)) + +(template: #export (no-op value) + (|> +1 #reference.Local #reference.Variable #..Reference + (#..Function (list)) + (#..Apply value))) + +(do-template [ ] + [(def: #export ( size tag value) + (-> Nat Tag ) + (let [left (function.constant (|>> #.Left #Sum )) + right (|>> #.Right #Sum )] + (if (last? size tag) + (if (n/= +1 tag) + (right value) + (list/fold left + (right value) + (list.n/range +0 (n/- +2 tag)))) + (list/fold left + (case value + ( (#Sum _)) + ( value) + + _ + value) + (list.n/range +0 tag)))))] + + [sum-analysis Analysis #Structure no-op] + [sum-pattern Pattern #Complex id] + ) + +(do-template [ ] + [(def: #export ( members) + (-> (Tuple ) ) + (case (list.reverse members) + #.Nil + ( #Unit) + + (#.Cons singleton #.Nil) + singleton + + (#.Cons last prevs) + (list/fold (function (_ left right) ( (#Product left right))) + last prevs)))] + + [product-analysis Analysis #Primitive #Structure] + [product-pattern Pattern #Simple #Complex] + ) + +(def: #export (apply [func args]) + (-> (Application Analysis) Analysis) + (list/fold (function (_ arg func) (#Apply arg func)) func args)) + +(do-template [ ] + [(def: #export ( value) + (-> (Tuple )) + (case value + ( (#Product left right)) + (#.Cons left ( right)) + + _ + (list value)))] + + [tuple Analysis #Structure] + [tuple-pattern Pattern #Complex] + ) + +(do-template [ ] + [(def: #export ( value) + (-> (Maybe (Variant ))) + (loop [lefts +0 + variantA value] + (case variantA + ( (#Sum (#.Left valueA))) + (case valueA + ( (#Sum _)) + (recur (inc lefts) valueA) + + _ + (#.Some {#lefts lefts + #right? #0 + #value valueA})) + + ( (#Sum (#.Right valueA))) + (#.Some {#lefts lefts + #right? #1 + #value valueA}) + + _ + #.None)))] + + [variant Analysis #Structure] + [variant-pattern Pattern #Complex] + ) + +(def: #export (application analysis) + (-> Analysis (Application Analysis)) + (case analysis + (#Apply head func) + (let [[func' tail] (application func)] + [func' (#.Cons head tail)]) + + _ + [analysis (list)])) + +(template: #export (pattern/unit) + (#..Simple #..Unit)) + +(do-template [ ] + [(template: #export ( content) + (#..Simple ( content)))] + + [pattern/bit #..Bit] + [pattern/nat #..Nat] + [pattern/int #..Int] + [pattern/rev #..Rev] + [pattern/frac #..Frac] + [pattern/text #..Text] + ) + +(def: #export (with-source-code source action) + (All [a] (-> Source (Operation a) (Operation a))) + (function (_ [bundle state]) + (let [old-source (get@ #.source state)] + (case (action [bundle (set@ #.source source state)]) + (#error.Error error) + (#error.Error error) + + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ #.source old-source state')] + output]))))) + +(def: fresh-bindings + (All [k v] (Bindings k v)) + {#.counter +0 + #.mappings (list)}) + +(def: fresh-scope + Scope + {#.name (list) + #.inner +0 + #.locals fresh-bindings + #.captured fresh-bindings}) + +(def: #export (with-scope action) + (All [a] (-> (Operation a) (Operation [Scope a]))) + (function (_ [bundle state]) + (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)]) + (#error.Success [[bundle' state'] output]) + (case (get@ #.scopes state') + #.Nil + (#error.Error "Impossible error: Drained scopes!") + + (#.Cons head tail) + (#error.Success [[bundle' (set@ #.scopes tail state')] + [head output]])) + + (#error.Error error) + (#error.Error error)))) + +(def: #export (with-current-module name) + (All [a] (-> Text (Operation a) (Operation a))) + (extension.localized (get@ #.current-module) + (set@ #.current-module) + (function.constant (#.Some name)))) + +(def: #export (with-cursor cursor action) + (All [a] (-> Cursor (Operation a) (Operation a))) + (if (text/= "" (product.left cursor)) + action + (function (_ [bundle state]) + (let [old-cursor (get@ #.cursor state)] + (case (action [bundle (set@ #.cursor cursor state)]) + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ #.cursor old-cursor state')] + output]) + + (#error.Error error) + (#error.Error error)))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/lux/compiler/default/phase/analysis/case.lux new file mode 100644 index 000000000..e523d86a9 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/case.lux @@ -0,0 +1,296 @@ +(.module: + [lux (#- case) + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." product] + ["." error] + ["." maybe] + [text + format] + [collection + ["." list ("list/." Fold Monoid Functor)]]] + ["." type + ["." check]] + ["." macro + ["." code]]] + ["." // (#+ Pattern Analysis Operation Phase) + ["." scope] + ["//." type] + ["." structure] + ["/." // + ["." extension]]] + [/ + ["." coverage]]) + +(exception: #export (cannot-match-with-pattern {type Type} {pattern Code}) + (ex.report ["Type" (%type type)] + ["Pattern" (%code pattern)])) + +(exception: #export (sum-has-no-case {case Nat} {type Type}) + (ex.report ["Case" (%n case)] + ["Type" (%type type)])) + +(exception: #export (unrecognized-pattern-syntax {pattern Code}) + (%code pattern)) + +(exception: #export (cannot-simplify-for-pattern-matching {type Type}) + (%type type)) + +(do-template [] + [(exception: #export ( {message Text}) + message)] + + [cannot-have-empty-branches] + [non-exhaustive-pattern-matching] + ) + +(def: (re-quantify envs baseT) + (-> (List (List Type)) Type Type) + (.case envs + #.Nil + baseT + + (#.Cons head tail) + (re-quantify tail (#.UnivQ head baseT)))) + +## Type-checking on the input value is done during the analysis of a +## "case" expression, to ensure that the patterns being used make +## sense for the type of the input value. +## Sometimes, that input value is complex, by depending on +## type-variables or quantifications. +## This function makes it easier for "case" analysis to properly +## type-check the input with respect to the patterns. +(def: (simplify-case caseT) + (-> Type (Operation Type)) + (loop [envs (: (List (List Type)) + (list)) + caseT caseT] + (.case caseT + (#.Var id) + (do ///.Monad + [?caseT' (//type.with-env + (check.read id))] + (.case ?caseT' + (#.Some caseT') + (recur envs caseT') + + _ + (///.throw cannot-simplify-for-pattern-matching caseT))) + + (#.Named name unnamedT) + (recur envs unnamedT) + + (#.UnivQ env unquantifiedT) + (recur (#.Cons env envs) unquantifiedT) + + (#.ExQ _) + (do ///.Monad + [[ex-id exT] (//type.with-env + check.existential)] + (recur envs (maybe.assume (type.apply (list exT) caseT)))) + + (#.Apply inputT funcT) + (.case funcT + (#.Var funcT-id) + (do ///.Monad + [funcT' (//type.with-env + (do check.Monad + [?funct' (check.read funcT-id)] + (.case ?funct' + (#.Some funct') + (wrap funct') + + _ + (check.throw cannot-simplify-for-pattern-matching caseT))))] + (recur envs (#.Apply inputT funcT'))) + + _ + (.case (type.apply (list inputT) funcT) + (#.Some outputT) + (recur envs outputT) + + #.None + (///.throw cannot-simplify-for-pattern-matching caseT))) + + (#.Product _) + (|> caseT + type.flatten-tuple + (list/map (re-quantify envs)) + type.tuple + (:: ///.Monad wrap)) + + _ + (:: ///.Monad wrap (re-quantify envs caseT))))) + +(def: (analyse-primitive type inputT cursor output next) + (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a]))) + (//.with-cursor cursor + (do ///.Monad + [_ (//type.with-env + (check.check inputT type)) + outputA next] + (wrap [output outputA])))) + +## This function handles several concerns at once, but it must be that +## way because those concerns are interleaved when doing +## pattern-matching and they cannot be separated. +## The pattern is analysed in order to get a general feel for what is +## expected of the input value. This, in turn, informs the +## type-checking of the input. +## A kind of "continuation" value is passed around which signifies +## what needs to be done _after_ analysing a pattern. +## In general, this is done to analyse the "body" expression +## associated to a particular pattern _in the context of_ said +## pattern. +## The reason why *context* is important is because patterns may bind +## values to local variables, which may in turn be referenced in the +## body expressions. +## That is why the body must be analysed in the context of the +## pattern, and not separately. +(def: (analyse-pattern num-tags inputT pattern next) + (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + (.case pattern + [cursor (#.Symbol ["" name])] + (//.with-cursor cursor + (do ///.Monad + [outputA (scope.with-local [name inputT] + next) + idx scope.next-local] + (wrap [(#//.Bind idx) outputA]))) + + (^template [ ] + [cursor ] + (analyse-primitive inputT cursor (#//.Simple ) next)) + ([Bit (#.Bit pattern-value) (#//.Bit pattern-value)] + [Nat (#.Nat pattern-value) (#//.Nat pattern-value)] + [Int (#.Int pattern-value) (#//.Int pattern-value)] + [Rev (#.Rev pattern-value) (#//.Rev pattern-value)] + [Frac (#.Frac pattern-value) (#//.Frac pattern-value)] + [Text (#.Text pattern-value) (#//.Text pattern-value)] + [Any (#.Tuple #.Nil) #//.Unit]) + + (^ [cursor (#.Tuple (list singleton))]) + (analyse-pattern #.None inputT singleton next) + + [cursor (#.Tuple sub-patterns)] + (//.with-cursor cursor + (do ///.Monad + [inputT' (simplify-case inputT)] + (.case inputT' + (#.Product _) + (let [subs (type.flatten-tuple inputT') + num-subs (maybe.default (list.size subs) + num-tags) + num-sub-patterns (list.size sub-patterns) + matches (cond (n/< num-subs num-sub-patterns) + (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)] + (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns)) + + (n/> num-subs num-sub-patterns) + (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)] + (list.zip2 subs (list/compose prefix (list (code.tuple suffix))))) + + ## (n/= num-subs num-sub-patterns) + (list.zip2 subs sub-patterns))] + (do @ + [[memberP+ thenA] (list/fold (: (All [a] + (-> [Type Code] (Operation [(List Pattern) a]) + (Operation [(List Pattern) a]))) + (function (_ [memberT memberC] then) + (do @ + [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) + analyse-pattern) + #.None memberT memberC then)] + (wrap [(list& memberP memberP+) thenA])))) + (do @ + [nextA next] + (wrap [(list) nextA])) + (list.reverse matches))] + (wrap [(//.product-pattern memberP+) + thenA]))) + + _ + (///.throw cannot-match-with-pattern [inputT pattern]) + ))) + + [cursor (#.Record record)] + (do ///.Monad + [record (structure.normalize record) + [members recordT] (structure.order record) + _ (//type.with-env + (check.check inputT recordT))] + (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next)) + + [cursor (#.Tag tag)] + (//.with-cursor cursor + (analyse-pattern #.None inputT (` ((~ pattern))) next)) + + (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))]) + (//.with-cursor cursor + (do ///.Monad + [inputT' (simplify-case inputT)] + (.case inputT' + (#.Sum _) + (let [flat-sum (type.flatten-variant inputT') + size-sum (list.size flat-sum) + num-cases (maybe.default size-sum num-tags)] + (.case (list.nth idx flat-sum) + (^multi (#.Some caseT) + (n/< num-cases idx)) + (do ///.Monad + [[testP nextA] (if (and (n/> num-cases size-sum) + (n/= (dec num-cases) idx)) + (analyse-pattern #.None + (type.variant (list.drop (dec num-cases) flat-sum)) + (` [(~+ values)]) + next) + (analyse-pattern #.None caseT (` [(~+ values)]) next))] + (wrap [(//.sum-pattern num-cases idx testP) + nextA])) + + _ + (///.throw sum-has-no-case [idx inputT]))) + + _ + (///.throw cannot-match-with-pattern [inputT pattern])))) + + (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) + (//.with-cursor cursor + (do ///.Monad + [tag (extension.lift (macro.normalize tag)) + [idx group variantT] (extension.lift (macro.resolve-tag tag)) + _ (//type.with-env + (check.check inputT variantT))] + (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next))) + + _ + (///.throw unrecognized-pattern-syntax pattern) + )) + +(def: #export (case analyse inputC branches) + (-> Phase Code (List [Code Code]) (Operation Analysis)) + (.case branches + #.Nil + (///.throw cannot-have-empty-branches "") + + (#.Cons [patternH bodyH] branchesT) + (do ///.Monad + [[inputT inputA] (//type.with-inference + (analyse inputC)) + outputH (analyse-pattern #.None inputT patternH (analyse bodyH)) + outputT (monad.map @ + (function (_ [patternT bodyT]) + (analyse-pattern #.None inputT patternT (analyse bodyT))) + branchesT) + outputHC (|> outputH product.left coverage.determine) + outputTC (monad.map @ (|>> product.left coverage.determine) outputT) + _ (.case (monad.fold error.Monad coverage.merge outputHC outputTC) + (#error.Success coverage) + (///.assert non-exhaustive-pattern-matching "" + (coverage.exhaustive? coverage)) + + (#error.Error error) + (///.fail error))] + (wrap (#//.Case inputA [outputH outputT]))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux new file mode 100644 index 000000000..24ded5476 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux @@ -0,0 +1,325 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)] + equivalence] + [data + [bit ("bit/." Equivalence)] + ["." number] + ["e" error ("error/." Monad)] + ["." maybe] + [text + format] + [collection + ["." list ("list/." Fold)] + ["dict" dictionary (#+ Dictionary)]]]] + ["." //// ("operation/." Monad)] + ["." /// (#+ Pattern Variant Operation)]) + +(def: cases + (-> (Maybe Nat) Nat) + (|>> (maybe.default +0))) + +(def: (variant sum-side) + (-> (Either Pattern Pattern) (Variant Pattern)) + (loop [lefts +0 + variantP sum-side] + (case variantP + (#.Left valueP) + (case valueP + (#///.Complex (#///.Sum value-side)) + (recur (inc lefts) value-side) + + _ + {#///.lefts lefts + #///.right? #0 + #///.value valueP}) + + (#.Right valueP) + {#///.lefts lefts + #///.right? #1 + #///.value valueP}))) + +## The coverage of a pattern-matching expression summarizes how well +## all the possible values of an input are being covered by the +## different patterns involved. +## Ideally, the pattern-matching has "exhaustive" coverage, which just +## means that every possible value can be matched by at least 1 +## pattern. +## Every other coverage is considered partial, and it would be valued +## as insuficient (since it could lead to runtime errors due to values +## not being handled by any pattern). +## The #Partial tag covers arbitrary partial coverages in a general +## way, while the other tags cover more specific cases for bits +## and variants. +(type: #export #rec Coverage + #Partial + (#Bit Bit) + (#Variant (Maybe Nat) (Dictionary Nat Coverage)) + (#Seq Coverage Coverage) + (#Alt Coverage Coverage) + #Exhaustive) + +(def: #export (exhaustive? coverage) + (-> Coverage Bit) + (case coverage + (#Exhaustive _) + #1 + + _ + #0)) + +(def: #export (determine pattern) + (-> Pattern (Operation Coverage)) + (case pattern + (^or (#///.Simple #///.Unit) + (#///.Bind _)) + (operation/wrap #Exhaustive) + + ## Primitive patterns always have partial coverage because there + ## are too many possibilities as far as values go. + (^template [] + (#///.Simple ( _)) + (operation/wrap #Partial)) + ([#///.Nat] + [#///.Int] + [#///.Rev] + [#///.Frac] + [#///.Text]) + + ## Bits are the exception, since there is only "#1" and + ## "#0", which means it is possible for bit + ## pattern-matching to become exhaustive if complementary parts meet. + (#///.Simple (#///.Bit value)) + (operation/wrap (#Bit value)) + + ## Tuple patterns can be exhaustive if there is exhaustiveness for all of + ## their sub-patterns. + (#///.Complex (#///.Product [left right])) + (do ////.Monad + [left (determine left) + right (determine right)] + (case right + (#Exhaustive _) + (wrap left) + + _ + (wrap (#Seq left right)))) + + (#///.Complex (#///.Sum sum-side)) + (let [[variant-lefts variant-right? variant-value] (variant sum-side)] + ## Variant patterns can be shown to be exhaustive if all the possible + ## cases are handled exhaustively. + (do ////.Monad + [value-coverage (determine variant-value) + #let [variant-idx (if variant-right? + (inc variant-lefts) + variant-lefts)]] + (wrap (#Variant (if variant-right? + (#.Some variant-idx) + #.None) + (|> (dict.new number.Hash) + (dict.put variant-idx value-coverage)))))))) + +(def: (xor left right) + (-> Bit Bit Bit) + (or (and left (not right)) + (and (not left) right))) + +## The coverage checker not only verifies that pattern-matching is +## exhaustive, but also that there are no redundant patterns. +## Redundant patterns will never be executed, since there will +## always be a pattern prior to them that would match the input. +## Because of that, the presence of redundant patterns is assumed to +## be a bug, likely due to programmer carelessness. +(def: redundant-pattern + (e.Error Coverage) + (e.fail "Redundant pattern.")) + +(def: (flatten-alt coverage) + (-> Coverage (List Coverage)) + (case coverage + (#Alt left right) + (list& left (flatten-alt right)) + + _ + (list coverage))) + +(structure: _ (Equivalence Coverage) + (def: (= reference sample) + (case [reference sample] + [#Exhaustive #Exhaustive] + #1 + + [(#Bit sideR) (#Bit sideS)] + (bit/= sideR sideS) + + [(#Variant allR casesR) (#Variant allS casesS)] + (and (n/= (cases allR) + (cases allS)) + (:: (dict.Equivalence =) = casesR casesS)) + + [(#Seq leftR rightR) (#Seq leftS rightS)] + (and (= leftR leftS) + (= rightR rightS)) + + [(#Alt _) (#Alt _)] + (let [flatR (flatten-alt reference) + flatS (flatten-alt sample)] + (and (n/= (list.size flatR) (list.size flatS)) + (list.every? (function (_ [coverageR coverageS]) + (= coverageR coverageS)) + (list.zip2 flatR flatS)))) + + _ + #0))) + +(open: "coverage/." Equivalence) + +## After determining the coverage of each individual pattern, it is +## necessary to merge them all to figure out if the entire +## pattern-matching expression is exhaustive and whether it contains +## redundant patterns. +(def: #export (merge addition so-far) + (-> Coverage Coverage (e.Error Coverage)) + (case [addition so-far] + ## The addition cannot possibly improve the coverage. + [_ #Exhaustive] + redundant-pattern + + ## The addition completes the coverage. + [#Exhaustive _] + (error/wrap #Exhaustive) + + [#Partial #Partial] + (error/wrap #Partial) + + ## 2 bit coverages are exhaustive if they complement one another. + (^multi [(#Bit sideA) (#Bit sideSF)] + (xor sideA sideSF)) + (error/wrap #Exhaustive) + + [(#Variant allA casesA) (#Variant allSF casesSF)] + (cond (not (n/= (cases allSF) (cases allA))) + (e.fail "Variants do not match.") + + (:: (dict.Equivalence Equivalence) = casesSF casesA) + redundant-pattern + + ## else + (do e.Monad + [casesM (monad.fold @ + (function (_ [tagA coverageA] casesSF') + (case (dict.get tagA casesSF') + (#.Some coverageSF) + (do @ + [coverageM (merge coverageA coverageSF)] + (wrap (dict.put tagA coverageM casesSF'))) + + #.None + (wrap (dict.put tagA coverageA casesSF')))) + casesSF (dict.entries casesA))] + (wrap (if (let [case-coverages (dict.values casesM)] + (and (n/= (cases allSF) (list.size case-coverages)) + (list.every? exhaustive? case-coverages))) + #Exhaustive + (#Variant allSF casesM))))) + + [(#Seq leftA rightA) (#Seq leftSF rightSF)] + (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)] + ## There is nothing the addition adds to the coverage. + [#1 #1] + redundant-pattern + + ## The 2 sequences cannot possibly be merged. + [#0 #0] + (error/wrap (#Alt so-far addition)) + + ## Same prefix + [#1 #0] + (do e.Monad + [rightM (merge rightA rightSF)] + (if (exhaustive? rightM) + ## If all that follows is exhaustive, then it can be safely dropped + ## (since only the "left" part would influence whether the + ## merged coverage is exhaustive or not). + (wrap leftSF) + (wrap (#Seq leftSF rightM)))) + + ## Same suffix + [#0 #1] + (do e.Monad + [leftM (merge leftA leftSF)] + (wrap (#Seq leftM rightA)))) + + ## The left part will always match, so the addition is redundant. + (^multi [(#Seq left right) single] + (coverage/= left single)) + redundant-pattern + + ## The right part is not necessary, since it can always match the left. + (^multi [single (#Seq left right)] + (coverage/= left single)) + (error/wrap single) + + ## When merging a new coverage against one based on Alt, it may be + ## that one of the many coverages in the Alt is complementary to + ## the new one, so effort must be made to fuse carefully, to match + ## the right coverages together. + ## If one of the Alt sub-coverages matches the new one, the cycle + ## must be repeated, in case the resulting coverage can now match + ## other ones in the original Alt. + ## This process must be repeated until no further productive + ## merges can be done. + [_ (#Alt leftS rightS)] + (do e.Monad + [#let [fuse-once (: (-> Coverage (List Coverage) + (e.Error [(Maybe Coverage) + (List Coverage)])) + (function (_ coverage possibilities) + (loop [alts possibilities] + (case alts + #.Nil + (wrap [#.None (list coverage)]) + + (#.Cons alt alts') + (case (merge coverage alt) + (#e.Success altM) + (case altM + (#Alt _) + (do @ + [[success alts+] (recur alts')] + (wrap [success (#.Cons alt alts+)])) + + _ + (wrap [(#.Some altM) alts'])) + + (#e.Error error) + (e.fail error)) + ))))] + [success possibilities] (fuse-once addition (flatten-alt so-far))] + (loop [success success + possibilities possibilities] + (case success + (#.Some coverage') + (do @ + [[success' possibilities'] (fuse-once coverage' possibilities)] + (recur success' possibilities')) + + #.None + (case (list.reverse possibilities) + (#.Cons last prevs) + (wrap (list/fold (function (_ left right) (#Alt left right)) + last + prevs)) + + #.Nil + (undefined))))) + + _ + (if (coverage/= so-far addition) + ## The addition cannot possibly improve the coverage. + redundant-pattern + ## There are now 2 alternative paths. + (error/wrap (#Alt so-far addition))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/expression.lux b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux new file mode 100644 index 000000000..dd27c87e6 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/expression.lux @@ -0,0 +1,121 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["e" error] + [text + format]] + ["." macro]] + ["." // (#+ Analysis Operation Phase) + ["." type] + ["." primitive] + ["." structure] + ["." reference] + ["/." // + ["." extension] + ["//." // (#+ Eval) + ## [".L" macro] + ]]]) + +(exception: #export (macro-expansion-failed {message Text}) + message) + +(do-template [] + [(exception: #export ( {code Code}) + (%code code))] + + [macro-call-must-have-single-expansion] + [unrecognized-syntax] + ) + +(def: #export (analyser eval) + (-> Eval Phase) + (function (compile code) + (do ///.Monad + [expectedT (extension.lift macro.expected-type)] + (let [[cursor code'] code] + ## The cursor must be set in the state for the sake + ## of having useful error messages. + (//.with-cursor cursor + (case code' + (^template [ ] + ( value) + ( value)) + ([#.Bit primitive.bit] + [#.Nat primitive.nat] + [#.Int primitive.int] + [#.Rev primitive.rev] + [#.Frac primitive.frac] + [#.Text primitive.text]) + + (^template [ ] + (^ (#.Form (list& [_ ( tag)] + values))) + (case values + (#.Cons value #.Nil) + ( compile tag value) + + _ + ( compile tag (` [(~+ values)])))) + ([#.Nat structure.sum] + [#.Tag structure.tagged-sum]) + + (#.Tag tag) + (structure.tagged-sum compile tag (' [])) + + (^ (#.Tuple (list))) + primitive.unit + + (^ (#.Tuple (list singleton))) + (compile singleton) + + (^ (#.Tuple elems)) + (structure.product compile elems) + + (^ (#.Record pairs)) + (structure.record compile pairs) + + (#.Symbol reference) + (reference.reference reference) + + (^ (#.Form (list& [_ (#.Text extension-name)] extension-args))) + (extension.apply compile [extension-name extension-args]) + + ## (^ (#.Form (list& func args))) + ## (do ///.Monad + ## [[funcT funcA] (type.with-inference + ## (compile func))] + ## (case funcA + ## [_ (#.Symbol def-name)] + ## (do @ + ## [?macro (///.with-error-tracking + ## (extension.lift (macro.find-macro def-name)))] + ## (case ?macro + ## (#.Some macro) + ## (do @ + ## [expansion (: (Operation (List Code)) + ## (function (_ state) + ## (case (macroL.expand macro args state) + ## (#e.Error error) + ## ((///.throw macro-expansion-failed error) state) + + ## output + ## output)))] + ## (case expansion + ## (^ (list single)) + ## (compile single) + + ## _ + ## (///.throw macro-call-must-have-single-expansion code))) + + ## _ + ## (functionA.apply compile funcT funcA args))) + + ## _ + ## (functionA.apply compile funcT funcA args))) + + _ + (///.throw unrecognized-syntax code) + )))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/function.lux b/stdlib/source/lux/compiler/default/phase/analysis/function.lux new file mode 100644 index 000000000..13a377df3 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/function.lux @@ -0,0 +1,102 @@ +(.module: + [lux (#- function) + [control + monad + ["ex" exception (#+ exception:)]] + [data + ["." maybe] + ["." text + format] + [collection + ["." list ("list/." Fold Monoid Monad)]]] + ["." type + ["." check]] + ["." macro]] + ["." // (#+ Analysis Operation Phase) + ["." scope] + ["//." type] + ["." inference] + ["/." // + ["." extension]]]) + +(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code}) + (ex.report ["Type" (%type expected)] + ["Function" function] + ["Argument" argument] + ["Body" (%code body)])) + +(exception: #export (cannot-apply {function Type} {arguments (List Code)}) + (ex.report [" Function" (%type function)] + ["Arguments" (|> arguments + list.enumerate + (list/map (.function (_ [idx argC]) + (format "\n " (%n idx) " " (%code argC)))) + (text.join-with ""))])) + +(def: #export (function analyse function-name arg-name body) + (-> Phase Text Text Code (Operation Analysis)) + (do ///.Monad + [functionT (extension.lift macro.expected-type)] + (loop [expectedT functionT] + (///.with-stack cannot-analyse [expectedT function-name arg-name body] + (case expectedT + (#.Named name unnamedT) + (recur unnamedT) + + (#.Apply argT funT) + (case (type.apply (list argT) funT) + (#.Some value) + (recur value) + + #.None + (///.fail (ex.construct cannot-analyse [expectedT function-name arg-name body]))) + + (^template [ ] + ( _) + (do @ + [[_ instanceT] (//type.with-env )] + (recur (maybe.assume (type.apply (list instanceT) expectedT))))) + ([#.UnivQ check.existential] + [#.ExQ check.var]) + + (#.Var id) + (do @ + [?expectedT' (//type.with-env + (check.read id))] + (case ?expectedT' + (#.Some expectedT') + (recur expectedT') + + ## Inference + _ + (do @ + [[input-id inputT] (//type.with-env check.var) + [output-id outputT] (//type.with-env check.var) + #let [functionT (#.Function inputT outputT)] + functionA (recur functionT) + _ (//type.with-env + (check.check expectedT functionT))] + (wrap functionA)) + )) + + (#.Function inputT outputT) + (<| (:: @ map (.function (_ [scope bodyA]) + (#//.Function (scope.environment scope) bodyA))) + //.with-scope + ## Functions have access not only to their argument, but + ## also to themselves, through a local variable. + (scope.with-local [function-name expectedT]) + (scope.with-local [arg-name inputT]) + (//type.with-type outputT) + (analyse body)) + + _ + (///.fail "") + ))))) + +(def: #export (apply analyse functionT functionA argsC+) + (-> Phase Type Analysis (List Code) (Operation Analysis)) + (<| (///.with-stack cannot-apply [functionT argsC+]) + (do ///.Monad + [[applyT argsA+] (inference.general analyse functionT argsC+)]) + (wrap (//.apply [functionA argsA+])))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/inference.lux b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux new file mode 100644 index 000000000..91e28a4ca --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/inference.lux @@ -0,0 +1,259 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." maybe] + ["." text + format] + [collection + ["." list ("list/." Functor)]]] + ["." type + ["." check]] + ["." macro]] + ["." /// ("operation/." Monad) + ["." extension]] + [// (#+ Tag Analysis Operation Phase)] + ["." //type]) + +(exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type}) + (ex.report ["Tag" (%n tag)] + ["Variant size" (%i (.int size))] + ["Variant type" (%type type)])) + +(exception: #export (cannot-infer {type Type} {args (List Code)}) + (ex.report ["Type" (%type type)] + ["Arguments" (|> args + list.enumerate + (list/map (function (_ [idx argC]) + (format "\n " (%n idx) " " (%code argC)))) + (text.join-with ""))])) + +(exception: #export (cannot-infer-argument {inferred Type} {argument Code}) + (ex.report ["Inferred Type" (%type inferred)] + ["Argument" (%code argument)])) + +(exception: #export (smaller-variant-than-expected {expected Nat} {actual Nat}) + (ex.report ["Expected" (%i (.int expected))] + ["Actual" (%i (.int actual))])) + +(do-template [] + [(exception: #export ( {type Type}) + (%type type))] + + [not-a-variant-type] + [not-a-record-type] + [invalid-type-application] + ) + +(def: (replace parameter-idx replacement type) + (-> Nat Type Type Type) + (case type + (#.Primitive name params) + (#.Primitive name (list/map (replace parameter-idx replacement) params)) + + (^template [] + ( left right) + ( (replace parameter-idx replacement left) + (replace parameter-idx replacement right))) + ([#.Sum] + [#.Product] + [#.Function] + [#.Apply]) + + (#.Parameter idx) + (if (n/= parameter-idx idx) + replacement + type) + + (^template [] + ( env quantified) + ( (list/map (replace parameter-idx replacement) env) + (replace (n/+ +2 parameter-idx) replacement quantified))) + ([#.UnivQ] + [#.ExQ]) + + _ + type)) + +(def: (named-type cursor id) + (-> Cursor Nat Type) + (let [name (format "{New Type @ " (.cursor-description cursor) " " (%n id) "}")] + (#.Primitive name (list)))) + +(def: new-named-type + (Operation Type) + (do ///.Monad + [cursor (extension.lift macro.cursor) + [ex-id _] (//type.with-env check.existential)] + (wrap (named-type cursor ex-id)))) + +## Type-inference works by applying some (potentially quantified) type +## to a sequence of values. +## Function types are used for this, although inference is not always +## done for function application (alternative uses may be records and +## tagged variants). +## But, so long as the type being used for the inference can be treated +## as a function type, this method of inference should work. +(def: #export (general analyse inferT args) + (-> Phase Type (List Code) (Operation [Type (List Analysis)])) + (case args + #.Nil + (do ///.Monad + [_ (//type.infer inferT)] + (wrap [inferT (list)])) + + (#.Cons argC args') + (case inferT + (#.Named name unnamedT) + (general analyse unnamedT args) + + (#.UnivQ _) + (do ///.Monad + [[var-id varT] (//type.with-env check.var)] + (general analyse (maybe.assume (type.apply (list varT) inferT)) args)) + + (#.ExQ _) + (do ///.Monad + [[var-id varT] (//type.with-env check.var) + output (general analyse + (maybe.assume (type.apply (list varT) inferT)) + args) + bound? (//type.with-env + (check.bound? var-id)) + _ (if bound? + (wrap []) + (do @ + [newT new-named-type] + (//type.with-env + (check.check varT newT))))] + (wrap output)) + + (#.Apply inputT transT) + (case (type.apply (list inputT) transT) + (#.Some outputT) + (general analyse outputT args) + + #.None + (///.throw invalid-type-application inferT)) + + ## Arguments are inferred back-to-front because, by convention, + ## Lux functions take the most important arguments *last*, which + ## means that the most information for doing proper inference is + ## located in the last arguments to a function call. + ## By inferring back-to-front, a lot of type-annotations can be + ## avoided in Lux code, since the inference algorithm can piece + ## things together more easily. + (#.Function inputT outputT) + (do ///.Monad + [[outputT' args'A] (general analyse outputT args') + argA (<| (///.with-stack cannot-infer-argument [inputT argC]) + (//type.with-type inputT) + (analyse argC))] + (wrap [outputT' (list& argA args'A)])) + + (#.Var infer-id) + (do ///.Monad + [?inferT' (//type.with-env (check.read infer-id))] + (case ?inferT' + (#.Some inferT') + (general analyse inferT' args) + + _ + (///.throw cannot-infer [inferT args]))) + + _ + (///.throw cannot-infer [inferT args])) + )) + +## Turns a record type into the kind of function type suitable for inference. +(def: #export (record inferT) + (-> Type (Operation Type)) + (case inferT + (#.Named name unnamedT) + (record unnamedT) + + (^template [] + ( env bodyT) + (do ///.Monad + [bodyT+ (record bodyT)] + (wrap ( env bodyT+)))) + ([#.UnivQ] + [#.ExQ]) + + (#.Apply inputT funcT) + (case (type.apply (list inputT) funcT) + (#.Some outputT) + (record outputT) + + #.None + (///.throw invalid-type-application inferT)) + + (#.Product _) + (operation/wrap (type.function (type.flatten-tuple inferT) inferT)) + + _ + (///.throw not-a-record-type inferT))) + +## Turns a variant type into the kind of function type suitable for inference. +(def: #export (variant tag expected-size inferT) + (-> Nat Nat Type (Operation Type)) + (loop [depth +0 + currentT inferT] + (case currentT + (#.Named name unnamedT) + (do ///.Monad + [unnamedT+ (recur depth unnamedT)] + (wrap unnamedT+)) + + (^template [] + ( env bodyT) + (do ///.Monad + [bodyT+ (recur (inc depth) bodyT)] + (wrap ( env bodyT+)))) + ([#.UnivQ] + [#.ExQ]) + + (#.Sum _) + (let [cases (type.flatten-variant currentT) + actual-size (list.size cases) + boundary (dec expected-size)] + (cond (or (n/= expected-size actual-size) + (and (n/> expected-size actual-size) + (n/< boundary tag))) + (case (list.nth tag cases) + (#.Some caseT) + (operation/wrap (if (n/= +0 depth) + (type.function (list caseT) currentT) + (let [replace' (replace (|> depth dec (n/* +2)) inferT)] + (type.function (list (replace' caseT)) + (replace' currentT))))) + + #.None + (///.throw variant-tag-out-of-bounds [expected-size tag inferT])) + + (n/< expected-size actual-size) + (///.throw smaller-variant-than-expected [expected-size actual-size]) + + (n/= boundary tag) + (let [caseT (type.variant (list.drop boundary cases))] + (operation/wrap (if (n/= +0 depth) + (type.function (list caseT) currentT) + (let [replace' (replace (|> depth dec (n/* +2)) inferT)] + (type.function (list (replace' caseT)) + (replace' currentT)))))) + + ## else + (///.throw variant-tag-out-of-bounds [expected-size tag inferT]))) + + (#.Apply inputT funcT) + (case (type.apply (list inputT) funcT) + (#.Some outputT) + (variant tag expected-size outputT) + + #.None + (///.throw invalid-type-application inferT)) + + _ + (///.throw not-a-variant-type inferT)))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/module.lux b/stdlib/source/lux/compiler/default/phase/analysis/module.lux new file mode 100644 index 000000000..adc442c1f --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/module.lux @@ -0,0 +1,255 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)] + pipe] + [data + ["." text ("text/." Equivalence) + format] + ["." error] + [collection + ["." list ("list/." Fold Functor)] + [dictionary + ["." plist]]]] + ["." macro]] + ["." // (#+ Operation) + ["/." // + ["." extension]]]) + +(type: #export Tag Text) + +(exception: #export (unknown-module {module Text}) + module) + +(exception: #export (cannot-declare-tag-twice {module Text} {tag Text}) + (ex.report ["Module" module] + ["Tag" tag])) + +(do-template [] + [(exception: #export ( {tags (List Text)} {owner Type}) + (ex.report ["Tags" (text.join-with " " tags)] + ["Type" (%type owner)]))] + + [cannot-declare-tags-for-unnamed-type] + [cannot-declare-tags-for-foreign-type] + ) + +(exception: #export (cannot-define-more-than-once {name Ident}) + (%ident name)) + +(exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State}) + (ex.report ["Module" module] + ["Desired state" (case state + #.Active "Active" + #.Compiled "Compiled" + #.Cached "Cached")])) + +(exception: #export (cannot-set-module-annotations-more-than-once {module Text} {old Code} {new Code}) + (ex.report ["Module" module] + ["Old annotations" (%code old)] + ["New annotations" (%code new)])) + +(def: (new hash) + (-> Nat Module) + {#.module-hash hash + #.module-aliases (list) + #.definitions (list) + #.imports (list) + #.tags (list) + #.types (list) + #.module-annotations #.None + #.module-state #.Active}) + +(def: #export (set-annotations annotations) + (-> Code (Operation Any)) + (do ///.Monad + [self-name (extension.lift macro.current-module-name) + self (extension.lift macro.current-module)] + (case (get@ #.module-annotations self) + #.None + (extension.lift + (function (_ state) + (#error.Success [(update@ #.modules + (plist.put self-name (set@ #.module-annotations (#.Some annotations) self)) + state) + []]))) + + (#.Some old) + (///.throw cannot-set-module-annotations-more-than-once [self-name old annotations])))) + +(def: #export (import module) + (-> Text (Operation Any)) + (do ///.Monad + [self-name (extension.lift macro.current-module-name)] + (extension.lift + (function (_ state) + (#error.Success [(update@ #.modules + (plist.update self-name (update@ #.imports (|>> (#.Cons module)))) + state) + []]))))) + +(def: #export (alias alias module) + (-> Text Text (Operation Any)) + (do ///.Monad + [self-name (extension.lift macro.current-module-name)] + (extension.lift + (function (_ state) + (#error.Success [(update@ #.modules + (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) + (|>> (#.Cons [alias module]))))) + state) + []]))))) + +(def: #export (exists? module) + (-> Text (Operation Bit)) + (extension.lift + (function (_ state) + (|> state + (get@ #.modules) + (plist.get module) + (case> (#.Some _) #1 #.None #0) + [state] #error.Success)))) + +(def: #export (define name definition) + (-> Text Definition (Operation [])) + (do ///.Monad + [self-name (extension.lift macro.current-module-name) + self (extension.lift macro.current-module)] + (extension.lift + (function (_ state) + (case (plist.get name (get@ #.definitions self)) + #.None + (#error.Success [(update@ #.modules + (plist.put self-name + (update@ #.definitions + (: (-> (List [Text Definition]) (List [Text Definition])) + (|>> (#.Cons [name definition]))) + self)) + state) + []]) + + (#.Some already-existing) + ((///.throw cannot-define-more-than-once [self-name name]) state)))))) + +(def: #export (create hash name) + (-> Nat Text (Operation [])) + (extension.lift + (function (_ state) + (let [module (new hash)] + (#error.Success [(update@ #.modules + (plist.put name module) + state) + []]))))) + +(def: #export (with-module hash name action) + (All [a] (-> Nat Text (Operation a) (Operation [Module a]))) + (do ///.Monad + [_ (create hash name) + output (//.with-current-module name + action) + module (extension.lift (macro.find-module name))] + (wrap [module output]))) + +(do-template [ ] + [(def: #export ( module-name) + (-> Text (Operation Any)) + (extension.lift + (function (_ state) + (case (|> state (get@ #.modules) (plist.get module-name)) + (#.Some module) + (let [active? (case (get@ #.module-state module) + #.Active #1 + _ #0)] + (if active? + (#error.Success [(update@ #.modules + (plist.put module-name (set@ #.module-state module)) + state) + []]) + ((///.throw can-only-change-state-of-active-module [module-name ]) + state))) + + #.None + ((///.throw unknown-module module-name) state))))) + + (def: #export ( module-name) + (-> Text (Operation Bit)) + (extension.lift + (function (_ state) + (case (|> state (get@ #.modules) (plist.get module-name)) + (#.Some module) + (#error.Success [state + (case (get@ #.module-state module) + #1 + _ #0)]) + + #.None + ((///.throw unknown-module module-name) state)))))] + + [set-active active? #.Active] + [set-compiled compiled? #.Compiled] + [set-cached cached? #.Cached] + ) + +(do-template [ ] + [(def: ( module-name) + (-> Text (Operation )) + (extension.lift + (function (_ state) + (case (|> state (get@ #.modules) (plist.get module-name)) + (#.Some module) + (#error.Success [state (get@ module)]) + + #.None + ((///.throw unknown-module module-name) state)))))] + + [tags #.tags (List [Text [Nat (List Ident) Bit Type]])] + [types #.types (List [Text [(List Ident) Bit Type]])] + [hash #.module-hash Nat] + ) + +(def: (ensure-undeclared-tags module-name tags) + (-> Text (List Tag) (Operation Any)) + (do ///.Monad + [bindings (..tags module-name) + _ (monad.map @ + (function (_ tag) + (case (plist.get tag bindings) + #.None + (wrap []) + + (#.Some _) + (///.throw cannot-declare-tag-twice [module-name tag]))) + tags)] + (wrap []))) + +(def: #export (declare-tags tags exported? type) + (-> (List Tag) Bit Type (Operation Any)) + (do ///.Monad + [self-name (extension.lift macro.current-module-name) + [type-module type-name] (case type + (#.Named type-ident _) + (wrap type-ident) + + _ + (///.throw cannot-declare-tags-for-unnamed-type [tags type])) + _ (ensure-undeclared-tags self-name tags) + _ (///.assert cannot-declare-tags-for-foreign-type [tags type] + (text/= self-name type-module))] + (extension.lift + (function (_ state) + (case (|> state (get@ #.modules) (plist.get self-name)) + (#.Some module) + (let [namespaced-tags (list/map (|>> [self-name]) tags)] + (#error.Success [(update@ #.modules + (plist.update self-name + (|>> (update@ #.tags (function (_ tag-bindings) + (list/fold (function (_ [idx tag] table) + (plist.put tag [idx namespaced-tags exported? type] table)) + tag-bindings + (list.enumerate tags)))) + (update@ #.types (plist.put type-name [namespaced-tags exported? type])))) + state) + []])) + #.None + ((///.throw unknown-module self-name) state)))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/source/lux/compiler/default/phase/analysis/primitive.lux new file mode 100644 index 000000000..bd42825d3 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/primitive.lux @@ -0,0 +1,29 @@ +(.module: + [lux (#- nat int rev) + [control + monad]] + ["." // (#+ Analysis Operation) + [".A" type] + ["/." //]]) + +## [Analysers] +(do-template [ ] + [(def: #export ( value) + (-> (Operation Analysis)) + (do ///.Monad + [_ (typeA.infer )] + (wrap (#//.Primitive ( value)))))] + + [bit Bit #//.Bit] + [nat Nat #//.Nat] + [int Int #//.Int] + [rev Rev #//.Rev] + [frac Frac #//.Frac] + [text Text #//.Text] + ) + +(def: #export unit + (Operation Analysis) + (do ///.Monad + [_ (typeA.infer Any)] + (wrap (#//.Primitive #//.Unit)))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/reference.lux b/stdlib/source/lux/compiler/default/phase/analysis/reference.lux new file mode 100644 index 000000000..bb78a32fb --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/reference.lux @@ -0,0 +1,79 @@ +(.module: + [lux #* + [control + monad + ["ex" exception (#+ exception:)]] + ["." macro] + [data + [text ("text/." Equivalence) + format]]] + ["." // (#+ Analysis Operation) + ["." scope] + ["." type] + ["/." // + ["." extension] + [// + ["." reference]]]]) + +(exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text}) + (ex.report ["Current" current] + ["Foreign" foreign])) + +(exception: #export (definition-has-not-been-expored {definition Ident}) + (ex.report ["Definition" (%ident definition)])) + +## [Analysers] +(def: (definition def-name) + (-> Ident (Operation Analysis)) + (with-expansions [ (wrap (|> def-name reference.constant #//.Reference))] + (do ///.Monad + [[actualT def-anns _] (extension.lift (macro.find-def def-name))] + (case (macro.get-symbol-ann (ident-for #.alias) def-anns) + (#.Some real-def-name) + (definition real-def-name) + + _ + (do @ + [_ (type.infer actualT) + (^@ def-name [::module ::name]) (extension.lift (macro.normalize def-name)) + current (extension.lift macro.current-module-name)] + (if (text/= current ::module) + + (if (macro.export? def-anns) + (do @ + [imported! (extension.lift (macro.imported-by? ::module current))] + (if imported! + + (///.throw foreign-module-has-not-been-imported [current ::module]))) + (///.throw definition-has-not-been-expored def-name)))))))) + +(def: (variable var-name) + (-> Text (Operation (Maybe Analysis))) + (do ///.Monad + [?var (scope.find var-name)] + (case ?var + (#.Some [actualT ref]) + (do @ + [_ (type.infer actualT)] + (wrap (#.Some (|> ref reference.variable #//.Reference)))) + + #.None + (wrap #.None)))) + +(def: #export (reference reference) + (-> Ident (Operation Analysis)) + (case reference + ["" simple-name] + (do ///.Monad + [?var (variable simple-name)] + (case ?var + (#.Some varA) + (wrap varA) + + #.None + (do @ + [this-module (extension.lift macro.current-module-name)] + (definition [this-module simple-name])))) + + _ + (definition reference))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux new file mode 100644 index 000000000..a3f7e926c --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux @@ -0,0 +1,197 @@ +(.module: + [lux #* + [control + monad] + [data + [text ("text/." Equivalence) + format] + ["." maybe ("maybe/." Monad)] + ["." product] + ["e" error] + [collection + ["." list ("list/." Functor Fold Monoid)] + [dictionary + ["." plist]]]]] + [// (#+ Operation Phase) + ["/." // + ["." extension] + [// + ["." reference (#+ Register Variable)]]]]) + +(type: Local (Bindings Text [Type Register])) +(type: Foreign (Bindings Text [Type Variable])) + +(def: (local? name scope) + (-> Text Scope Bit) + (|> scope + (get@ [#.locals #.mappings]) + (plist.contains? name))) + +(def: (local name scope) + (-> Text Scope (Maybe [Type Variable])) + (|> scope + (get@ [#.locals #.mappings]) + (plist.get name) + (maybe/map (function (_ [type value]) + [type (#reference.Local value)])))) + +(def: (captured? name scope) + (-> Text Scope Bit) + (|> scope + (get@ [#.captured #.mappings]) + (plist.contains? name))) + +(def: (captured name scope) + (-> Text Scope (Maybe [Type Variable])) + (loop [idx +0 + mappings (get@ [#.captured #.mappings] scope)] + (case mappings + #.Nil + #.None + + (#.Cons [_name [_source-type _source-ref]] mappings') + (if (text/= name _name) + (#.Some [_source-type (#reference.Foreign idx)]) + (recur (inc idx) mappings'))))) + +(def: (reference? name scope) + (-> Text Scope Bit) + (or (local? name scope) + (captured? name scope))) + +(def: (reference name scope) + (-> Text Scope (Maybe [Type Variable])) + (case (..local name scope) + (#.Some type) + (#.Some type) + + _ + (..captured name scope))) + +(def: #export (find name) + (-> Text (Operation (Maybe [Type Variable]))) + (extension.lift + (function (_ state) + (let [[inner outer] (|> state + (get@ #.scopes) + (list.split-with (|>> (reference? name) not)))] + (case outer + #.Nil + (#.Right [state #.None]) + + (#.Cons top-outer _) + (let [[ref-type init-ref] (maybe.default (undefined) + (..reference name top-outer)) + [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + (function (_ scope ref+inner) + [(#reference.Foreign (get@ [#.captured #.counter] scope)) + (#.Cons (update@ #.captured + (: (-> Foreign Foreign) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)])))) + scope) + (product.right ref+inner))])) + [init-ref #.Nil] + (list.reverse inner)) + scopes (list/compose inner' outer)] + (#.Right [(set@ #.scopes scopes state) + (#.Some [ref-type ref])])) + ))))) + +(def: #export (with-local [name type] action) + (All [a] (-> [Text Type] (Operation a) (Operation a))) + (function (_ [bundle state]) + (case (get@ #.scopes state) + (#.Cons head tail) + (let [old-mappings (get@ [#.locals #.mappings] head) + new-var-id (get@ [#.locals #.counter] head) + new-head (update@ #.locals + (: (-> Local Local) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.put name [type new-var-id])))) + head)] + (case (///.run' [bundle (set@ #.scopes (#.Cons new-head tail) state)] + action) + (#e.Success [[bundle' state'] output]) + (case (get@ #.scopes state') + (#.Cons head' tail') + (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head') + tail')] + (#e.Success [[bundle' (set@ #.scopes scopes' state')] + output])) + + _ + (error! "Invalid scope alteration.")) + + (#e.Error error) + (#e.Error error))) + + _ + (#e.Error "Cannot create local binding without a scope.")) + )) + +(do-template [ ] + [(def: + (Bindings Text [Type ]) + {#.counter +0 + #.mappings (list)})] + + [init-locals Nat] + [init-captured Variable] + ) + +(def: (scope parent-name child-name) + (-> (List Text) Text Scope) + {#.name (list& child-name parent-name) + #.inner +0 + #.locals init-locals + #.captured init-captured}) + +(def: #export (with-scope name action) + (All [a] (-> Text (Operation a) (Operation a))) + (function (_ [bundle state]) + (let [parent-name (case (get@ #.scopes state) + #.Nil + (list) + + (#.Cons top _) + (get@ #.name top))] + (case (action [bundle (update@ #.scopes + (|>> (#.Cons (scope parent-name name))) + state)]) + (#e.Error error) + (#e.Error error) + + (#e.Success [[bundle' state'] output]) + (#e.Success [[bundle' (update@ #.scopes + (|>> list.tail (maybe.default (list))) + state')] + output]) + )) + )) + +(def: #export next-local + (Operation Register) + (extension.lift + (function (_ state) + (case (get@ #.scopes state) + #.Nil + (#e.Error "Cannot get next reference when there is no scope.") + + (#.Cons top _) + (#e.Success [state (get@ [#.locals #.counter] top)]))))) + +(def: (ref-to-variable ref) + (-> Ref Variable) + (case ref + (#.Local register) + (#reference.Local register) + + (#.Captured register) + (#reference.Foreign register))) + +(def: #export (environment scope) + (-> Scope (List Variable)) + (|> scope + (get@ [#.captured #.mappings]) + (list/map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux new file mode 100644 index 000000000..c50383eb8 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux @@ -0,0 +1,360 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." ident] + ["." number] + ["." product] + ["." maybe] + [text + format] + [collection + ["." list ("list/." Functor)] + ["dict" dictionary (#+ Dictionary)]]] + ["." type + ["." check]] + ["." macro + ["." code]]] + ["." // (#+ Tag Analysis Operation Phase) + ["//." type] + ["." primitive] + ["." inference] + ["/." // + ["." extension] + ["//." //]]]) + +(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code}) + (ex.report ["Type" (%type type)] + ["Tag" (%n tag)] + ["Expression" (%code code)])) + +(do-template [] + [(exception: #export ( {type Type} {members (List Code)}) + (ex.report ["Type" (%type type)] + ["Expression" (%code (` [(~+ members)]))]))] + + [invalid-tuple-type] + [cannot-analyse-tuple] + ) + +(exception: #export (not-a-quantified-type {type Type}) + (%type type)) + +(do-template [] + [(exception: #export ( {type Type} {tag Tag} {code Code}) + (ex.report ["Type" (%type type)] + ["Tag" (%n tag)] + ["Expression" (%code code)]))] + + [cannot-analyse-variant] + [cannot-infer-numeric-tag] + ) + +(exception: #export (record-keys-must-be-tags {key Code} {record (List [Code Code])}) + (ex.report ["Key" (%code key)] + ["Record" (%code (code.record record))])) + +(do-template [] + [(exception: #export ( {key Ident} {record (List [Ident Code])}) + (ex.report ["Tag" (%code (code.tag key))] + ["Record" (%code (code.record (list/map (function (_ [keyI valC]) + [(code.tag keyI) valC]) + record)))]))] + + [cannot-repeat-tag] + ) + +(exception: #export (tag-does-not-belong-to-record {key Ident} {type Type}) + (ex.report ["Tag" (%code (code.tag key))] + ["Type" (%type type)])) + +(exception: #export (record-size-mismatch {expected Nat} {actual Nat} {type Type} {record (List [Ident Code])}) + (ex.report ["Expected" (|> expected .int %i)] + ["Actual" (|> actual .int %i)] + ["Type" (%type type)] + ["Expression" (%code (|> record + (list/map (function (_ [keyI valueC]) + [(code.tag keyI) valueC])) + code.record))])) + +(def: #export (sum analyse tag valueC) + (-> Phase Nat Code (Operation Analysis)) + (do ///.Monad + [expectedT (extension.lift macro.expected-type)] + (///.with-stack cannot-analyse-variant [expectedT tag valueC] + (case expectedT + (#.Sum _) + (let [flat (type.flatten-variant expectedT) + type-size (list.size flat)] + (case (list.nth tag flat) + (#.Some variant-type) + (do @ + [valueA (//type.with-type variant-type + (analyse valueC))] + (wrap (//.sum-analysis type-size tag valueA))) + + #.None + (///.throw inference.variant-tag-out-of-bounds [type-size tag expectedT]))) + + (#.Named name unnamedT) + (//type.with-type unnamedT + (sum analyse tag valueC)) + + (#.Var id) + (do @ + [?expectedT' (//type.with-env + (check.read id))] + (case ?expectedT' + (#.Some expectedT') + (//type.with-type expectedT' + (sum analyse tag valueC)) + + _ + ## Cannot do inference when the tag is numeric. + ## This is because there is no way of knowing how many + ## cases the inferred sum type would have. + (///.throw cannot-infer-numeric-tag [expectedT tag valueC]) + )) + + (^template [ ] + ( _) + (do @ + [[instance-id instanceT] (//type.with-env )] + (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + (sum analyse tag valueC)))) + ([#.UnivQ check.existential] + [#.ExQ check.var]) + + (#.Apply inputT funT) + (case funT + (#.Var funT-id) + (do @ + [?funT' (//type.with-env (check.read funT-id))] + (case ?funT' + (#.Some funT') + (//type.with-type (#.Apply inputT funT') + (sum analyse tag valueC)) + + _ + (///.throw invalid-variant-type [expectedT tag valueC]))) + + _ + (case (type.apply (list inputT) funT) + #.None + (///.throw not-a-quantified-type funT) + + (#.Some outputT) + (//type.with-type outputT + (sum analyse tag valueC)))) + + _ + (///.throw invalid-variant-type [expectedT tag valueC]))))) + +(def: (typed-product analyse membersC+) + (-> Phase (List Code) (Operation Analysis)) + (do ///.Monad + [expectedT (extension.lift macro.expected-type)] + (loop [expectedT expectedT + membersC+ membersC+] + (case [expectedT membersC+] + ## If the tuple runs out, whatever expression is the last gets + ## matched to the remaining type. + [tailT (#.Cons tailC #.Nil)] + (//type.with-type tailT + (analyse tailC)) + + ## If the type and the code are still ongoing, match each + ## sub-expression to its corresponding type. + [(#.Product leftT rightT) (#.Cons leftC rightC)] + (do @ + [leftA (//type.with-type leftT + (analyse leftC)) + rightA (recur rightT rightC)] + (wrap (#//.Structure (#//.Product leftA rightA)))) + + ## If, however, the type runs out but there is still enough + ## tail, the remaining elements get packaged into another + ## tuple. + ## The reason for this is that it is assumed that the type of + ## the tuple represents the expectations of the user. + ## If the type is for a 3-tuple, but a 5-tuple is provided, it + ## is assumed that the user intended the following layout: + ## [0, 1, [2, 3, 4]] + ## but that, for whatever reason, it was written in a flat + ## way. + [tailT tailC] + (|> tailC + code.tuple + analyse + (//type.with-type tailT) + (:: @ map (|>> //.no-op))))))) + +(def: #export (product analyse membersC) + (-> Phase (List Code) (Operation Analysis)) + (do ///.Monad + [expectedT (extension.lift macro.expected-type)] + (///.with-stack cannot-analyse-tuple [expectedT membersC] + (case expectedT + (#.Product _) + (..typed-product analyse membersC) + + (#.Named name unnamedT) + (//type.with-type unnamedT + (product analyse membersC)) + + (#.Var id) + (do @ + [?expectedT' (//type.with-env + (check.read id))] + (case ?expectedT' + (#.Some expectedT') + (//type.with-type expectedT' + (product analyse membersC)) + + _ + ## Must do inference... + (do @ + [membersTA (monad.map @ (|>> analyse //type.with-inference) + membersC) + _ (//type.with-env + (check.check expectedT + (type.tuple (list/map product.left membersTA))))] + (wrap (//.product-analysis (list/map product.right membersTA)))))) + + (^template [ ] + ( _) + (do @ + [[instance-id instanceT] (//type.with-env )] + (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT)) + (product analyse membersC)))) + ([#.UnivQ check.existential] + [#.ExQ check.var]) + + (#.Apply inputT funT) + (case funT + (#.Var funT-id) + (do @ + [?funT' (//type.with-env (check.read funT-id))] + (case ?funT' + (#.Some funT') + (//type.with-type (#.Apply inputT funT') + (product analyse membersC)) + + _ + (///.throw invalid-tuple-type [expectedT membersC]))) + + _ + (case (type.apply (list inputT) funT) + #.None + (///.throw not-a-quantified-type funT) + + (#.Some outputT) + (//type.with-type outputT + (product analyse membersC)))) + + _ + (///.throw invalid-tuple-type [expectedT membersC]) + )))) + +(def: #export (tagged-sum analyse tag valueC) + (-> Phase Ident Code (Operation Analysis)) + (do ///.Monad + [tag (extension.lift (macro.normalize tag)) + [idx group variantT] (extension.lift (macro.resolve-tag tag)) + expectedT (extension.lift macro.expected-type)] + (case expectedT + (#.Var _) + (do @ + [#let [case-size (list.size group)] + inferenceT (inference.variant idx case-size variantT) + [inferredT valueA+] (inference.general analyse inferenceT (list valueC))] + (wrap (//.sum-analysis case-size idx (|> valueA+ list.head maybe.assume)))) + + _ + (..sum analyse idx valueC)))) + +## There cannot be any ambiguity or improper syntax when analysing +## records, so they must be normalized for further analysis. +## Normalization just means that all the tags get resolved to their +## canonical form (with their corresponding module identified). +(def: #export (normalize record) + (-> (List [Code Code]) (Operation (List [Ident Code]))) + (monad.map ///.Monad + (function (_ [key val]) + (case key + [_ (#.Tag key)] + (do ///.Monad + [key (extension.lift (macro.normalize key))] + (wrap [key val])) + + _ + (///.throw record-keys-must-be-tags [key record]))) + record)) + +## Lux already possesses the means to analyse tuples, so +## re-implementing the same functionality for records makes no sense. +## Records, thus, get transformed into tuples by ordering the elements. +(def: #export (order record) + (-> (List [Ident Code]) (Operation [(List Code) Type])) + (case record + ## empty-record = empty-tuple = unit = [] + #.Nil + (:: ///.Monad wrap [(list) Any]) + + (#.Cons [head-k head-v] _) + (do ///.Monad + [head-k (extension.lift (macro.normalize head-k)) + [_ tag-set recordT] (extension.lift (macro.resolve-tag head-k)) + #let [size-record (list.size record) + size-ts (list.size tag-set)] + _ (if (n/= size-ts size-record) + (wrap []) + (///.throw record-size-mismatch [size-ts size-record recordT record])) + #let [tuple-range (list.n/range +0 (dec size-ts)) + tag->idx (dict.from-list ident.Hash (list.zip2 tag-set tuple-range))] + idx->val (monad.fold @ + (function (_ [key val] idx->val) + (do @ + [key (extension.lift (macro.normalize key))] + (case (dict.get key tag->idx) + #.None + (///.throw tag-does-not-belong-to-record [key recordT]) + + (#.Some idx) + (if (dict.contains? idx idx->val) + (///.throw cannot-repeat-tag [key record]) + (wrap (dict.put idx val idx->val)))))) + (: (Dictionary Nat Code) + (dict.new number.Hash)) + record) + #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val))) + tuple-range)]] + (wrap [ordered-tuple recordT])) + )) + +(def: #export (record analyse members) + (-> Phase (List [Code Code]) (Operation Analysis)) + (do ///.Monad + [members (normalize members) + [membersC recordT] (order members)] + (case membersC + (^ (list)) + primitive.unit + + (^ (list singletonC)) + (analyse singletonC) + + _ + (do @ + [expectedT (extension.lift macro.expected-type)] + (case expectedT + (#.Var _) + (do @ + [inferenceT (inference.record recordT) + [inferredT membersA] (inference.general analyse inferenceT membersC)] + (wrap (//.product-analysis membersA))) + + _ + (..product analyse membersC)))))) diff --git a/stdlib/source/lux/compiler/default/phase/analysis/type.lux b/stdlib/source/lux/compiler/default/phase/analysis/type.lux new file mode 100644 index 000000000..3eb574986 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/analysis/type.lux @@ -0,0 +1,52 @@ +(.module: + [lux #* + [control + [monad (#+ do)]] + [data + ["." error]] + ["." function] + [type + ["tc" check]] + ["." macro]] + [// (#+ Operation) + ["/." // + ["." extension]]]) + +(def: #export (with-type expected) + (All [a] (-> Type (Operation a) (Operation a))) + (extension.localized (get@ #.expected) (set@ #.expected) + (function.constant (#.Some expected)))) + +(def: #export (with-env action) + (All [a] (-> (tc.Check a) (Operation a))) + (function (_ (^@ stateE [bundle state])) + (case (action (get@ #.type-context state)) + (#error.Error error) + ((///.fail error) stateE) + + (#error.Success [context' output]) + (#error.Success [[bundle (set@ #.type-context context' state)] + output])))) + +(def: #export with-fresh-env + (All [a] (-> (Operation a) (Operation a))) + (extension.localized (get@ #.type-context) (set@ #.type-context) + (function.constant tc.fresh-context))) + +(def: #export (infer actualT) + (-> Type (Operation Any)) + (do ///.Monad + [expectedT (extension.lift macro.expected-type)] + (with-env + (tc.check expectedT actualT)))) + +(def: #export (with-inference action) + (All [a] (-> (Operation a) (Operation [Type a]))) + (do ///.Monad + [[_ varT] (..with-env + tc.var) + output (with-type varT + action) + knownT (..with-env + (tc.clean varT))] + (wrap [knownT output]))) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux new file mode 100644 index 000000000..a24d72b0c --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -0,0 +1,114 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." error (#+ Error)] + ["." text] + [collection + ["dict" dictionary (#+ Dictionary)]]] + ["." function]] + ["." //]) + +(type: #export (Extension i) + [Text (List i)]) + +(with-expansions [ (as-is (Dictionary Text (Handler s i o)))] + (type: #export (Handler s i o) + (-> Text + (//.Phase [ s] i o) + (//.Phase [ s] (List i) o))) + + (type: #export (Bundle s i o) + )) + +(type: #export (Operation s i o v) + (//.Operation [(Bundle s i o) s] v)) + +(type: #export (Phase s i o) + (//.Phase [(Bundle s i o) s] i o)) + +(do-template [] + [(exception: #export ( {name Text}) + (ex.report ["Name" name]))] + + [unknown] + [cannot-overwrite] + ) + +(def: #export (install name handler) + (All [s i o] + (-> Text (Handler s i o) (Operation s i o Any))) + (function (_ [bundle state]) + (if (dict.contains? name bundle) + (ex.throw cannot-overwrite name) + (#error.Success [[(dict.put name handler bundle) state] + []])))) + +(def: #export (apply phase [name parameters]) + (All [s i o] + (-> (Phase s i o) (Extension i) (Operation s i o o))) + (function (_ (^@ stateE [bundle state])) + (case (dict.get name bundle) + #.None + (ex.throw unknown name) + + (#.Some handler) + ((handler name phase) parameters stateE)))) + +(def: #export (localized get set transform) + (All [s s' i o v] + (-> (-> s s') (-> s' s s) (-> s' s') + (-> (Operation s i o v) (Operation s i o v)))) + (function (_ operation) + (function (_ [bundle state]) + (let [old (get state)] + (case (operation [bundle (set (transform old) state)]) + (#error.Error error) + (#error.Error error) + + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set old state')] output])))))) + +(def: #export (temporary transform) + (All [s i o v] + (-> (-> s s) + (-> (Operation s i o v) (Operation s i o v)))) + (function (_ operation) + (function (_ [bundle state]) + (case (operation [bundle (transform state)]) + (#error.Error error) + (#error.Error error) + + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' state] output]))))) + +(def: #export (with-state state) + (All [s i o v] + (-> s (-> (Operation s i o v) (Operation s i o v)))) + (..temporary (function.constant state))) + +(def: #export (read get) + (All [s i o v] + (-> (-> s v) (Operation s i o v))) + (function (_ [bundle state]) + (#error.Success [[bundle state] (get state)]))) + +(def: #export (update transform) + (All [s i o] + (-> (-> s s) (Operation s i o Any))) + (function (_ [bundle state]) + (#error.Success [[bundle (transform state)] []]))) + +(def: #export (lift action) + (All [s i o v] + (-> (//.Operation s v) + (//.Operation [(Bundle s i o) s] v))) + (function (_ [bundle state]) + (case (action state) + (#error.Error error) + (#error.Error error) + + (#error.Success [state' output]) + (#error.Success [[bundle state] output])))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis.lux new file mode 100644 index 000000000..4d78ceb43 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [/// + [analysis (#+ Bundle)]] + [/ + ["." common] + ["." host]]) + +(def: #export bundle + Bundle + (dictionary.merge host.bundle + common.bundle)) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux new file mode 100644 index 000000000..2817fd55d --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux @@ -0,0 +1,370 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)] + [thread (#+ Box)]] + [concurrency + [atom (#+ Atom)]] + [data + ["." text + format] + [collection + ["." list ("list/." Functor)] + ["." array] + ["dict" dictionary (#+ Dictionary)]]] + [type + ["." check]] + [io (#+ IO)]] + ["." //// + ["." analysis (#+ Analysis Handler Bundle) + [".A" type] + [".A" case] + [".A" function]]] + ["." /// + ["." bundle]]) + +## [Utils] +(def: (simple inputsT+ outputT) + (-> (List Type) Type Handler) + (let [num-expected (list.size inputsT+)] + (function (_ extension-name analyse args) + (let [num-actual (list.size args)] + (if (n/= num-expected num-actual) + (do ////.Monad + [_ (typeA.infer outputT) + argsA (monad.map @ + (function (_ [argT argC]) + (typeA.with-type argT + (analyse argC))) + (list.zip2 inputsT+ args))] + (wrap (#analysis.Extension extension-name argsA))) + (////.throw bundle.incorrect-arity [extension-name num-expected num-actual])))))) + +(def: #export (nullary valueT) + (-> Type Handler) + (simple (list) valueT)) + +(def: #export (unary inputT outputT) + (-> Type Type Handler) + (simple (list inputT) outputT)) + +(def: #export (binary subjectT paramT outputT) + (-> Type Type Type Handler) + (simple (list subjectT paramT) outputT)) + +(def: #export (trinary subjectT param0T param1T outputT) + (-> Type Type Type Type Handler) + (simple (list subjectT param0T param1T) outputT)) + +## [Analysers] +## "lux is" represents reference/pointer equality. +(def: lux::is + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((binary varT varT Bit extension-name) + analyse args)))) + +## "lux try" provides a simple way to interact with the host platform's +## error-handling facilities. +(def: lux::try + Handler + (function (_ extension-name analyse args) + (case args + (^ (list opC)) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var) + _ (typeA.infer (type (Either Text varT))) + opA (typeA.with-type (type (IO varT)) + (analyse opC))] + (wrap (#analysis.Extension extension-name (list opA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: lux::in-module + Handler + (function (_ extension-name analyse argsC+) + (case argsC+ + (^ (list [_ (#.Text module-name)] exprC)) + (analysis.with-current-module module-name + (analyse exprC)) + + _ + (////.throw bundle.invalid-syntax [extension-name])))) + +## (do-template [ ] +## [(def: +## Handler +## (function (_ extension-name analyse args) +## (case args +## (^ (list typeC valueC)) +## (do ////.Monad +## [actualT (eval Type typeC) +## _ (typeA.infer (:coerce Type actualT))] +## (typeA.with-type +## (analyse valueC))) + +## _ +## (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))] + +## [lux::check (:coerce Type actualT)] +## [lux::coerce Any] +## ) + +(def: lux::check::type + Handler + (function (_ extension-name analyse args) + (case args + (^ (list valueC)) + (do ////.Monad + [_ (typeA.infer Type) + valueA (typeA.with-type Type + (analyse valueC))] + (wrap valueA)) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: bundle::lux + Bundle + (|> bundle.empty + (bundle.install "is" lux::is) + (bundle.install "try" lux::try) + ## (bundle.install "check" lux::check) + ## (bundle.install "coerce" lux::coerce) + (bundle.install "check type" lux::check::type) + (bundle.install "in-module" lux::in-module))) + +(def: bundle::io + Bundle + (<| (bundle.prefix "io") + (|> bundle.empty + (bundle.install "log" (unary Text Any)) + (bundle.install "error" (unary Text Nothing)) + (bundle.install "exit" (unary Int Nothing)) + (bundle.install "current-time" (nullary Int))))) + +(def: bundle::bit + Bundle + (<| (bundle.prefix "bit") + (|> bundle.empty + (bundle.install "and" (binary Nat Nat Nat)) + (bundle.install "or" (binary Nat Nat Nat)) + (bundle.install "xor" (binary Nat Nat Nat)) + (bundle.install "left-shift" (binary Nat Nat Nat)) + (bundle.install "logical-right-shift" (binary Nat Nat Nat)) + (bundle.install "arithmetic-right-shift" (binary Int Nat Int)) + ))) + +(def: bundle::int + Bundle + (<| (bundle.prefix "int") + (|> bundle.empty + (bundle.install "+" (binary Int Int Int)) + (bundle.install "-" (binary Int Int Int)) + (bundle.install "*" (binary Int Int Int)) + (bundle.install "/" (binary Int Int Int)) + (bundle.install "%" (binary Int Int Int)) + (bundle.install "=" (binary Int Int Bit)) + (bundle.install "<" (binary Int Int Bit)) + (bundle.install "to-frac" (unary Int Frac)) + (bundle.install "char" (unary Int Text))))) + +(def: bundle::frac + Bundle + (<| (bundle.prefix "frac") + (|> bundle.empty + (bundle.install "+" (binary Frac Frac Frac)) + (bundle.install "-" (binary Frac Frac Frac)) + (bundle.install "*" (binary Frac Frac Frac)) + (bundle.install "/" (binary Frac Frac Frac)) + (bundle.install "%" (binary Frac Frac Frac)) + (bundle.install "=" (binary Frac Frac Bit)) + (bundle.install "<" (binary Frac Frac Bit)) + (bundle.install "smallest" (nullary Frac)) + (bundle.install "min" (nullary Frac)) + (bundle.install "max" (nullary Frac)) + (bundle.install "to-rev" (unary Frac Rev)) + (bundle.install "to-int" (unary Frac Int)) + (bundle.install "encode" (unary Frac Text)) + (bundle.install "decode" (unary Text (type (Maybe Frac))))))) + +(def: bundle::text + Bundle + (<| (bundle.prefix "text") + (|> bundle.empty + (bundle.install "=" (binary Text Text Bit)) + (bundle.install "<" (binary Text Text Bit)) + (bundle.install "concat" (binary Text Text Text)) + (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat)))) + (bundle.install "size" (unary Text Nat)) + (bundle.install "char" (binary Text Nat (type (Maybe Nat)))) + (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) + ))) + +(def: array::get + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((binary (type (Array varT)) Nat (type (Maybe varT)) extension-name) + analyse args)))) + +(def: array::put + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension-name) + analyse args)))) + +(def: array::remove + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((binary (type (Array varT)) Nat (type (Array varT)) extension-name) + analyse args)))) + +(def: bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" (unary Nat Array)) + (bundle.install "get" array::get) + (bundle.install "put" array::put) + (bundle.install "remove" array::remove) + (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat)) + ))) + +(def: bundle::math + Bundle + (<| (bundle.prefix "math") + (|> bundle.empty + (bundle.install "cos" (unary Frac Frac)) + (bundle.install "sin" (unary Frac Frac)) + (bundle.install "tan" (unary Frac Frac)) + (bundle.install "acos" (unary Frac Frac)) + (bundle.install "asin" (unary Frac Frac)) + (bundle.install "atan" (unary Frac Frac)) + (bundle.install "cosh" (unary Frac Frac)) + (bundle.install "sinh" (unary Frac Frac)) + (bundle.install "tanh" (unary Frac Frac)) + (bundle.install "exp" (unary Frac Frac)) + (bundle.install "log" (unary Frac Frac)) + (bundle.install "ceil" (unary Frac Frac)) + (bundle.install "floor" (unary Frac Frac)) + (bundle.install "round" (unary Frac Frac)) + (bundle.install "atan2" (binary Frac Frac Frac)) + (bundle.install "pow" (binary Frac Frac Frac)) + ))) + +(def: atom::new + Handler + (function (_ extension-name analyse args) + (case args + (^ (list initC)) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var) + _ (typeA.infer (type (Atom varT))) + initA (typeA.with-type varT + (analyse initC))] + (wrap (#analysis.Extension extension-name (list initA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: atom::read + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((unary (type (Atom varT)) varT extension-name) + analyse args)))) + +(def: atom::compare-and-swap + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var)] + ((trinary (type (Atom varT)) varT varT Bit extension-name) + analyse args)))) + +(def: bundle::atom + Bundle + (<| (bundle.prefix "atom") + (|> bundle.empty + (bundle.install "new" atom::new) + (bundle.install "read" atom::read) + (bundle.install "compare-and-swap" atom::compare-and-swap) + ))) + +(def: box::new + Handler + (function (_ extension-name analyse args) + (case args + (^ (list initC)) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var) + _ (typeA.infer (type (All [!] (Box ! varT)))) + initA (typeA.with-type varT + (analyse initC))] + (wrap (#analysis.Extension extension-name (list initA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: box::read + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[thread-id threadT] (typeA.with-env check.var) + [var-id varT] (typeA.with-env check.var)] + ((unary (type (Box threadT varT)) varT extension-name) + analyse args)))) + +(def: box::write + Handler + (function (_ extension-name analyse args) + (do ////.Monad + [[thread-id threadT] (typeA.with-env check.var) + [var-id varT] (typeA.with-env check.var)] + ((binary varT (type (Box threadT varT)) Any extension-name) + analyse args)))) + +(def: bundle::box + Bundle + (<| (bundle.prefix "box") + (|> bundle.empty + (bundle.install "new" box::new) + (bundle.install "read" box::read) + (bundle.install "write" box::write) + ))) + +(def: bundle::process + Bundle + (<| (bundle.prefix "process") + (|> bundle.empty + (bundle.install "parallelism" (nullary Nat)) + (bundle.install "schedule" (binary Nat (type (IO Any)) Any)) + ))) + +(def: #export bundle + Bundle + (<| (bundle.prefix "lux") + (|> bundle.empty + (dict.merge bundle::lux) + (dict.merge bundle::bit) + (dict.merge bundle::int) + (dict.merge bundle::frac) + (dict.merge bundle::text) + (dict.merge bundle::array) + (dict.merge bundle::math) + (dict.merge bundle::atom) + (dict.merge bundle::box) + (dict.merge bundle::process) + (dict.merge bundle::io)) + )) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux new file mode 100644 index 000000000..0edd20d2b --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -0,0 +1,1271 @@ +(.module: + [lux (#- char int) + [control + ["." monad (#+ do)] + ["p" parser] + ["ex" exception (#+ exception:)] + pipe] + [data + ["e" error] + ["." maybe] + ["." product] + ["." text ("text/." Equivalence) + format] + [collection + ["." list ("list/." Fold Functor Monoid)] + ["." array] + ["." dictionary (#+ Dictionary)]]] + ["." type + ["." check]] + ["." macro + ["s" syntax]] + ["." host]] + [// + ["." common] + ["/." // + ["." bundle] + ["//." // ("operation/." Monad) + ["." analysis (#+ Analysis Operation Handler Bundle) + [".A" type] + [".A" inference]]]]] + ) + +(type: Method-Signature + {#method Type + #exceptions (List Type)}) + +(host.import: #long java/lang/reflect/Type + (getTypeName [] String)) + +(do-template [] + [(exception: #export ( {jvm-type java/lang/reflect/Type}) + (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName [] jvm-type)]))] + + [jvm-type-is-not-a-class] + [cannot-convert-to-a-class] + [cannot-convert-to-a-parameter] + [cannot-convert-to-a-lux-type] + ) + +(do-template [] + [(exception: #export ( {type Type}) + (%type type))] + + [non-object] + [non-array] + [non-jvm-type] + ) + +(do-template [] + [(exception: #export ( {name Text}) + name)] + + [non-interface] + [non-throwable] + ) + +(do-template [] + [(exception: #export ( {message Text}) + message)] + + [unknown-class] + [primitives-cannot-have-type-parameters] + [primitives-are-not-objects] + [invalid-type-for-array-element] + + [unknown-field] + [mistaken-field-owner] + [not-a-virtual-field] + [not-a-static-field] + [cannot-set-a-final-field] + + [cannot-cast] + + [cannot-possibly-be-an-instance] + + [unknown-type-var] + [type-parameter-mismatch] + [cannot-correspond-type-with-a-class] + ) + +(do-template [] + [(exception: #export ( {class Text} + {method Text} + {hints (List Method-Signature)}) + (ex.report ["Class" class] + ["Method" method] + ["Hints" (|> hints + (list/map (|>> product.left %type (format "\n\t"))) + (text.join-with ""))]))] + + [no-candidates] + [too-many-candidates] + ) + +(do-template [ ] + [(def: #export Type (#.Primitive (list)))] + + ## Boxes + [Boolean "java.lang.Boolean"] + [Byte "java.lang.Byte"] + [Short "java.lang.Short"] + [Integer "java.lang.Integer"] + [Long "java.lang.Long"] + [Float "java.lang.Float"] + [Double "java.lang.Double"] + [Character "java.lang.Character"] + [String "java.lang.String"] + + ## Primitives + [boolean "boolean"] + [byte "byte"] + [short "short"] + [int "int"] + [long "long"] + [float "float"] + [double "double"] + [char "char"] + ) + +(def: bundle::conversion + Bundle + (<| (bundle.prefix "convert") + (|> bundle.empty + (bundle.install "double-to-float" (common.unary Double Float)) + (bundle.install "double-to-int" (common.unary Double Integer)) + (bundle.install "double-to-long" (common.unary Double Long)) + (bundle.install "float-to-double" (common.unary Float Double)) + (bundle.install "float-to-int" (common.unary Float Integer)) + (bundle.install "float-to-long" (common.unary Float Long)) + (bundle.install "int-to-byte" (common.unary Integer Byte)) + (bundle.install "int-to-char" (common.unary Integer Character)) + (bundle.install "int-to-double" (common.unary Integer Double)) + (bundle.install "int-to-float" (common.unary Integer Float)) + (bundle.install "int-to-long" (common.unary Integer Long)) + (bundle.install "int-to-short" (common.unary Integer Short)) + (bundle.install "long-to-double" (common.unary Long Double)) + (bundle.install "long-to-float" (common.unary Long Float)) + (bundle.install "long-to-int" (common.unary Long Integer)) + (bundle.install "long-to-short" (common.unary Long Short)) + (bundle.install "long-to-byte" (common.unary Long Byte)) + (bundle.install "char-to-byte" (common.unary Character Byte)) + (bundle.install "char-to-short" (common.unary Character Short)) + (bundle.install "char-to-int" (common.unary Character Integer)) + (bundle.install "char-to-long" (common.unary Character Long)) + (bundle.install "byte-to-long" (common.unary Byte Long)) + (bundle.install "short-to-long" (common.unary Short Long)) + ))) + +(do-template [ ] + [(def: + Bundle + (<| (bundle.prefix ) + (|> bundle.empty + (bundle.install "+" (common.binary )) + (bundle.install "-" (common.binary )) + (bundle.install "*" (common.binary )) + (bundle.install "/" (common.binary )) + (bundle.install "%" (common.binary )) + (bundle.install "=" (common.binary Bit)) + (bundle.install "<" (common.binary Bit)) + (bundle.install "and" (common.binary )) + (bundle.install "or" (common.binary )) + (bundle.install "xor" (common.binary )) + (bundle.install "shl" (common.binary Integer )) + (bundle.install "shr" (common.binary Integer )) + (bundle.install "ushr" (common.binary Integer )) + )))] + + [bundle::int "int" Integer] + [bundle::long "long" Long] + ) + +(do-template [ ] + [(def: + Bundle + (<| (bundle.prefix ) + (|> bundle.empty + (bundle.install "+" (common.binary )) + (bundle.install "-" (common.binary )) + (bundle.install "*" (common.binary )) + (bundle.install "/" (common.binary )) + (bundle.install "%" (common.binary )) + (bundle.install "=" (common.binary Bit)) + (bundle.install "<" (common.binary Bit)) + )))] + + [bundle::float "float" Float] + [bundle::double "double" Double] + ) + +(def: bundle::char + Bundle + (<| (bundle.prefix "char") + (|> bundle.empty + (bundle.install "=" (common.binary Character Character Bit)) + (bundle.install "<" (common.binary Character Character Bit)) + ))) + +(def: #export boxes + (Dictionary Text Text) + (|> (list ["boolean" "java.lang.Boolean"] + ["byte" "java.lang.Byte"] + ["short" "java.lang.Short"] + ["int" "java.lang.Integer"] + ["long" "java.lang.Long"] + ["float" "java.lang.Float"] + ["double" "java.lang.Double"] + ["char" "java.lang.Character"]) + (dictionary.from-list text.Hash))) + +(def: array::length + Handler + (function (_ extension-name analyse args) + (case args + (^ (list arrayC)) + (do ////.Monad + [_ (typeA.infer Nat) + [var-id varT] (typeA.with-env check.var) + arrayA (typeA.with-type (type (Array varT)) + (analyse arrayC))] + (wrap (#analysis.Extension extension-name (list arrayA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: array::new + Handler + (function (_ extension-name analyse args) + (case args + (^ (list lengthC)) + (do ////.Monad + [lengthA (typeA.with-type Nat + (analyse lengthC)) + expectedT (///.lift macro.expected-type) + [level elem-class] (: (Operation [Nat Text]) + (loop [analysisT expectedT + level +0] + (case analysisT + (#.Apply inputT funcT) + (case (type.apply (list inputT) funcT) + (#.Some outputT) + (recur outputT level) + + #.None + (////.throw non-array expectedT)) + + (^ (#.Primitive "#Array" (list elemT))) + (recur elemT (inc level)) + + (#.Primitive class _) + (wrap [level class]) + + _ + (////.throw non-array expectedT)))) + _ (if (n/> +0 level) + (wrap []) + (////.throw non-array expectedT))] + (wrap (#analysis.Extension extension-name (list (analysis.nat (dec level)) + (analysis.text elem-class) + lengthA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: (check-jvm objectT) + (-> Type (Operation Text)) + (case objectT + (#.Primitive name _) + (operation/wrap name) + + (#.Named name unnamed) + (check-jvm unnamed) + + (#.Var id) + (operation/wrap "java.lang.Object") + + (^template [] + ( env unquantified) + (check-jvm unquantified)) + ([#.UnivQ] + [#.ExQ]) + + (#.Apply inputT funcT) + (case (type.apply (list inputT) funcT) + (#.Some outputT) + (check-jvm outputT) + + #.None + (////.throw non-object objectT)) + + _ + (////.throw non-object objectT))) + +(def: (check-object objectT) + (-> Type (Operation Text)) + (do ////.Monad + [name (check-jvm objectT)] + (if (dictionary.contains? name boxes) + (////.throw primitives-are-not-objects name) + (operation/wrap name)))) + +(def: (box-array-element-type elemT) + (-> Type (Operation [Type Text])) + (case elemT + (#.Primitive name #.Nil) + (let [boxed-name (|> (dictionary.get name boxes) + (maybe.default name))] + (operation/wrap [(#.Primitive boxed-name #.Nil) + boxed-name])) + + (#.Primitive name _) + (if (dictionary.contains? name boxes) + (////.throw primitives-cannot-have-type-parameters name) + (operation/wrap [elemT name])) + + _ + (////.throw invalid-type-for-array-element (%type elemT)))) + +(def: array::read + Handler + (function (_ extension-name analyse args) + (case args + (^ (list arrayC idxC)) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var) + _ (typeA.infer varT) + arrayA (typeA.with-type (type (Array varT)) + (analyse arrayC)) + ?elemT (typeA.with-env + (check.read var-id)) + [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT)) + idxA (typeA.with-type Nat + (analyse idxC))] + (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA arrayA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)])))) + +(def: array::write + Handler + (function (_ extension-name analyse args) + (case args + (^ (list arrayC idxC valueC)) + (do ////.Monad + [[var-id varT] (typeA.with-env check.var) + _ (typeA.infer (type (Array varT))) + arrayA (typeA.with-type (type (Array varT)) + (analyse arrayC)) + ?elemT (typeA.with-env + (check.read var-id)) + [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT)) + idxA (typeA.with-type Nat + (analyse idxC)) + valueA (typeA.with-type valueT + (analyse valueC))] + (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA valueA arrayA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)])))) + +(def: bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "length" array::length) + (bundle.install "new" array::new) + (bundle.install "read" array::read) + (bundle.install "write" array::write) + ))) + +(def: object::null + Handler + (function (_ extension-name analyse args) + (case args + (^ (list)) + (do ////.Monad + [expectedT (///.lift macro.expected-type) + _ (check-object expectedT)] + (wrap (#analysis.Extension extension-name (list)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +0 (list.size args)])))) + +(def: object::null? + Handler + (function (_ extension-name analyse args) + (case args + (^ (list objectC)) + (do ////.Monad + [_ (typeA.infer Bit) + [objectT objectA] (typeA.with-inference + (analyse objectC)) + _ (check-object objectT)] + (wrap (#analysis.Extension extension-name (list objectA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: object::synchronized + Handler + (function (_ extension-name analyse args) + (case args + (^ (list monitorC exprC)) + (do ////.Monad + [[monitorT monitorA] (typeA.with-inference + (analyse monitorC)) + _ (check-object monitorT) + exprA (analyse exprC)] + (wrap (#analysis.Extension extension-name (list monitorA exprA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)])))) + +(host.import: java/lang/Object + (equals [Object] boolean)) + +(host.import: java/lang/ClassLoader) + +(host.import: java/lang/reflect/GenericArrayType + (getGenericComponentType [] java/lang/reflect/Type)) + +(host.import: java/lang/reflect/ParameterizedType + (getRawType [] java/lang/reflect/Type) + (getActualTypeArguments [] (Array java/lang/reflect/Type))) + +(host.import: (java/lang/reflect/TypeVariable d) + (getName [] String) + (getBounds [] (Array java/lang/reflect/Type))) + +(host.import: (java/lang/reflect/WildcardType d) + (getLowerBounds [] (Array java/lang/reflect/Type)) + (getUpperBounds [] (Array java/lang/reflect/Type))) + +(host.import: java/lang/reflect/Modifier + (#static isStatic [int] boolean) + (#static isFinal [int] boolean) + (#static isInterface [int] boolean) + (#static isAbstract [int] boolean)) + +(host.import: java/lang/reflect/Field + (getDeclaringClass [] (java/lang/Class Object)) + (getModifiers [] int) + (getGenericType [] java/lang/reflect/Type)) + +(host.import: java/lang/reflect/Method + (getName [] String) + (getModifiers [] int) + (getDeclaringClass [] (Class Object)) + (getTypeParameters [] (Array (TypeVariable Method))) + (getGenericParameterTypes [] (Array java/lang/reflect/Type)) + (getGenericReturnType [] java/lang/reflect/Type) + (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + +(host.import: (java/lang/reflect/Constructor c) + (getModifiers [] int) + (getDeclaringClass [] (Class c)) + (getTypeParameters [] (Array (TypeVariable (Constructor c)))) + (getGenericParameterTypes [] (Array java/lang/reflect/Type)) + (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) + +(host.import: (java/lang/Class c) + (getName [] String) + (getModifiers [] int) + (#static forName [String] #try (Class Object)) + (isAssignableFrom [(Class Object)] boolean) + (getTypeParameters [] (Array (TypeVariable (Class c)))) + (getGenericInterfaces [] (Array java/lang/reflect/Type)) + (getGenericSuperclass [] java/lang/reflect/Type) + (getDeclaredField [String] #try Field) + (getConstructors [] (Array (Constructor Object))) + (getDeclaredMethods [] (Array Method))) + +(def: (load-class name) + (-> Text (Operation (Class Object))) + (do ////.Monad + [] + (case (Class::forName [name]) + (#e.Success [class]) + (wrap class) + + (#e.Error error) + (////.throw unknown-class name)))) + +(def: (sub-class? super sub) + (-> Text Text (Operation Bit)) + (do ////.Monad + [super (load-class super) + sub (load-class sub)] + (wrap (Class::isAssignableFrom [sub] super)))) + +(def: object::throw + Handler + (function (_ extension-name analyse args) + (case args + (^ (list exceptionC)) + (do ////.Monad + [_ (typeA.infer Nothing) + [exceptionT exceptionA] (typeA.with-inference + (analyse exceptionC)) + exception-class (check-object exceptionT) + ? (sub-class? "java.lang.Throwable" exception-class) + _ (: (Operation Any) + (if ? + (wrap []) + (////.throw non-throwable exception-class)))] + (wrap (#analysis.Extension extension-name (list exceptionA)))) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: object::class + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC)) + (case classC + [_ (#.Text class)] + (do ////.Monad + [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) + _ (load-class class)] + (wrap (#analysis.Extension extension-name (list (analysis.text class))))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)])))) + +(def: object::instance? + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC objectC)) + (case classC + [_ (#.Text class)] + (do ////.Monad + [_ (typeA.infer Bit) + [objectT objectA] (typeA.with-inference + (analyse objectC)) + object-class (check-object objectT) + ? (sub-class? class object-class)] + (if ? + (wrap (#analysis.Extension extension-name (list (analysis.text class)))) + (////.throw cannot-possibly-be-an-instance (format object-class " !<= " class)))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)])))) + +(def: (java-type-to-class jvm-type) + (-> java/lang/reflect/Type (Operation Text)) + (cond (host.instance? Class jvm-type) + (operation/wrap (Class::getName [] (:coerce Class jvm-type))) + + (host.instance? ParameterizedType jvm-type) + (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType jvm-type))) + + ## else + (////.throw cannot-convert-to-a-class jvm-type))) + +(type: Mappings + (Dictionary Text Type)) + +(def: fresh-mappings Mappings (dictionary.new text.Hash)) + +(def: (java-type-to-lux-type mappings java-type) + (-> Mappings java/lang/reflect/Type (Operation Type)) + (cond (host.instance? TypeVariable java-type) + (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))] + (case (dictionary.get var-name mappings) + (#.Some var-type) + (operation/wrap var-type) + + #.None + (////.throw unknown-type-var var-name))) + + (host.instance? WildcardType java-type) + (let [java-type (:coerce WildcardType java-type)] + (case [(array.read +0 (WildcardType::getUpperBounds [] java-type)) + (array.read +0 (WildcardType::getLowerBounds [] java-type))] + (^or [(#.Some bound) _] [_ (#.Some bound)]) + (java-type-to-lux-type mappings bound) + + _ + (operation/wrap Any))) + + (host.instance? Class java-type) + (let [java-type (:coerce (Class Object) java-type) + class-name (Class::getName [] java-type)] + (operation/wrap (case (array.size (Class::getTypeParameters [] java-type)) + +0 + (#.Primitive class-name (list)) + + arity + (|> (list.n/range +0 (dec arity)) + list.reverse + (list/map (|>> (n/* +2) inc #.Parameter)) + (#.Primitive class-name) + (type.univ-q arity))))) + + (host.instance? ParameterizedType java-type) + (let [java-type (:coerce ParameterizedType java-type) + raw (ParameterizedType::getRawType [] java-type)] + (if (host.instance? Class raw) + (do ////.Monad + [paramsT (|> java-type + (ParameterizedType::getActualTypeArguments []) + array.to-list + (monad.map @ (java-type-to-lux-type mappings)))] + (operation/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw)) + paramsT))) + (////.throw jvm-type-is-not-a-class raw))) + + (host.instance? GenericArrayType java-type) + (do ////.Monad + [innerT (|> (:coerce GenericArrayType java-type) + (GenericArrayType::getGenericComponentType []) + (java-type-to-lux-type mappings))] + (wrap (#.Primitive "#Array" (list innerT)))) + + ## else + (////.throw cannot-convert-to-a-lux-type java-type))) + +(def: (correspond-type-params class type) + (-> (Class Object) Type (Operation Mappings)) + (case type + (#.Primitive name params) + (let [class-name (Class::getName [] class) + class-params (array.to-list (Class::getTypeParameters [] class)) + num-class-params (list.size class-params) + num-type-params (list.size params)] + (cond (not (text/= class-name name)) + (////.throw cannot-correspond-type-with-a-class + (format "Class = " class-name "\n" + "Type = " (%type type))) + + (not (n/= num-class-params num-type-params)) + (////.throw type-parameter-mismatch + (format "Expected: " (%i (.int num-class-params)) "\n" + " Actual: " (%i (.int num-type-params)) "\n" + " Class: " class-name "\n" + " Type: " (%type type))) + + ## else + (operation/wrap (|> params + (list.zip2 (list/map (TypeVariable::getName []) class-params)) + (dictionary.from-list text.Hash))) + )) + + _ + (////.throw non-jvm-type type))) + +(def: object::cast + Handler + (function (_ extension-name analyse args) + (case args + (^ (list valueC)) + (do ////.Monad + [toT (///.lift macro.expected-type) + to-name (check-jvm toT) + [valueT valueA] (typeA.with-inference + (analyse valueC)) + from-name (check-jvm valueT) + can-cast? (: (Operation Bit) + (case [from-name to-name] + (^template [ ] + (^or [ ] + [ ]) + (do @ + [_ (typeA.infer (#.Primitive to-name (list)))] + (wrap #1))) + (["boolean" "java.lang.Boolean"] + ["byte" "java.lang.Byte"] + ["short" "java.lang.Short"] + ["int" "java.lang.Integer"] + ["long" "java.lang.Long"] + ["float" "java.lang.Float"] + ["double" "java.lang.Double"] + ["char" "java.lang.Character"]) + + _ + (do @ + [_ (////.assert primitives-are-not-objects from-name + (not (dictionary.contains? from-name boxes))) + _ (////.assert primitives-are-not-objects to-name + (not (dictionary.contains? to-name boxes))) + to-class (load-class to-name)] + (loop [[current-name currentT] [from-name valueT]] + (if (text/= to-name current-name) + (do @ + [_ (typeA.infer toT)] + (wrap #1)) + (do @ + [current-class (load-class current-name) + _ (////.assert cannot-cast (format "From class/primitive: " current-name "\n" + " To class/primitive: " to-name "\n" + " For value: " (%code valueC) "\n") + (Class::isAssignableFrom [current-class] to-class)) + candiate-parents (monad.map @ + (function (_ java-type) + (do @ + [class-name (java-type-to-class java-type) + class (load-class class-name)] + (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)]))) + (list& (Class::getGenericSuperclass [] current-class) + (array.to-list (Class::getGenericInterfaces [] current-class))))] + (case (|> candiate-parents + (list.filter product.right) + (list/map product.left)) + (#.Cons [next-name nextJT] _) + (do @ + [mapping (correspond-type-params current-class currentT) + nextT (java-type-to-lux-type mapping nextJT)] + (recur [next-name nextT])) + + #.Nil + (////.throw cannot-cast (format "From class/primitive: " from-name "\n" + " To class/primitive: " to-name "\n" + " For value: " (%code valueC) "\n"))) + ))))))] + (if can-cast? + (wrap (#analysis.Extension extension-name (list (analysis.text from-name) + (analysis.text to-name) + valueA))) + (////.throw cannot-cast (format "From class/primitive: " from-name "\n" + " To class/primitive: " to-name "\n" + " For value: " (%code valueC) "\n")))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: bundle::object + Bundle + (<| (bundle.prefix "object") + (|> bundle.empty + (bundle.install "null" object::null) + (bundle.install "null?" object::null?) + (bundle.install "synchronized" object::synchronized) + (bundle.install "throw" object::throw) + (bundle.install "class" object::class) + (bundle.install "instance?" object::instance?) + (bundle.install "cast" object::cast) + ))) + +(def: (find-field class-name field-name) + (-> Text Text (Operation [(Class Object) Field])) + (do ////.Monad + [class (load-class class-name)] + (case (Class::getDeclaredField [field-name] class) + (#e.Success field) + (let [owner (Field::getDeclaringClass [] field)] + (if (is? owner class) + (wrap [class field]) + (////.throw mistaken-field-owner + (format " Field: " field-name "\n" + " Owner Class: " (Class::getName [] owner) "\n" + "Target Class: " class-name "\n")))) + + (#e.Error _) + (////.throw unknown-field (format class-name "#" field-name))))) + +(def: (static-field class-name field-name) + (-> Text Text (Operation [Type Bit])) + (do ////.Monad + [[class fieldJ] (find-field class-name field-name) + #let [modifiers (Field::getModifiers [] fieldJ)]] + (if (Modifier::isStatic [modifiers]) + (let [fieldJT (Field::getGenericType [] fieldJ)] + (do @ + [fieldT (java-type-to-lux-type fresh-mappings fieldJT)] + (wrap [fieldT (Modifier::isFinal [modifiers])]))) + (////.throw not-a-static-field (format class-name "#" field-name))))) + +(def: (virtual-field class-name field-name objectT) + (-> Text Text Type (Operation [Type Bit])) + (do ////.Monad + [[class fieldJ] (find-field class-name field-name) + #let [modifiers (Field::getModifiers [] fieldJ)]] + (if (not (Modifier::isStatic [modifiers])) + (do @ + [#let [fieldJT (Field::getGenericType [] fieldJ) + var-names (|> class + (Class::getTypeParameters []) + array.to-list + (list/map (TypeVariable::getName [])))] + mappings (: (Operation Mappings) + (case objectT + (#.Primitive _class-name _class-params) + (do @ + [#let [num-params (list.size _class-params) + num-vars (list.size var-names)] + _ (////.assert type-parameter-mismatch + (format "Expected: " (%i (.int num-params)) "\n" + " Actual: " (%i (.int num-vars)) "\n" + " Class: " _class-name "\n" + " Type: " (%type objectT)) + (n/= num-params num-vars))] + (wrap (|> (list.zip2 var-names _class-params) + (dictionary.from-list text.Hash)))) + + _ + (////.throw non-object objectT))) + fieldT (java-type-to-lux-type mappings fieldJT)] + (wrap [fieldT (Modifier::isFinal [modifiers])])) + (////.throw not-a-virtual-field (format class-name "#" field-name))))) + +(def: static::get + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC fieldC)) + (case [classC fieldC] + [[_ (#.Text class)] [_ (#.Text field)]] + (do ////.Monad + [[fieldT final?] (static-field class field)] + (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field))))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)])))) + +(def: static::put + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC fieldC valueC)) + (case [classC fieldC] + [[_ (#.Text class)] [_ (#.Text field)]] + (do ////.Monad + [_ (typeA.infer Any) + [fieldT final?] (static-field class field) + _ (////.assert cannot-set-a-final-field (format class "#" field) + (not final?)) + valueA (typeA.with-type fieldT + (analyse valueC))] + (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA)))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)])))) + +(def: virtual::get + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC fieldC objectC)) + (case [classC fieldC] + [[_ (#.Text class)] [_ (#.Text field)]] + (do ////.Monad + [[objectT objectA] (typeA.with-inference + (analyse objectC)) + [fieldT final?] (virtual-field class field objectT)] + (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) objectA)))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)])))) + +(def: virtual::put + Handler + (function (_ extension-name analyse args) + (case args + (^ (list classC fieldC valueC objectC)) + (case [classC fieldC] + [[_ (#.Text class)] [_ (#.Text field)]] + (do ////.Monad + [[objectT objectA] (typeA.with-inference + (analyse objectC)) + _ (typeA.infer objectT) + [fieldT final?] (virtual-field class field objectT) + _ (////.assert cannot-set-a-final-field (format class "#" field) + (not final?)) + valueA (typeA.with-type fieldT + (analyse valueC))] + (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA objectA)))) + + _ + (////.throw bundle.invalid-syntax extension-name)) + + _ + (////.throw bundle.incorrect-arity [extension-name +4 (list.size args)])))) + +(def: (java-type-to-parameter type) + (-> java/lang/reflect/Type (Operation Text)) + (cond (host.instance? Class type) + (operation/wrap (Class::getName [] (:coerce Class type))) + + (host.instance? ParameterizedType type) + (java-type-to-parameter (ParameterizedType::getRawType [] (:coerce ParameterizedType type))) + + (or (host.instance? TypeVariable type) + (host.instance? WildcardType type)) + (operation/wrap "java.lang.Object") + + (host.instance? GenericArrayType type) + (do ////.Monad + [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))] + (wrap (format componentP "[]"))) + + ## else + (////.throw cannot-convert-to-a-parameter type))) + +(type: Method-Style + #Static + #Abstract + #Virtual + #Special + #Interface) + +(def: (check-method class method-name method-style arg-classes method) + (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit)) + (do ////.Monad + [parameters (|> (Method::getGenericParameterTypes [] method) + array.to-list + (monad.map @ java-type-to-parameter)) + #let [modifiers (Method::getModifiers [] method)]] + (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method)) + (text/= method-name (Method::getName [] method)) + (case #Static + #Special + (Modifier::isStatic [modifiers]) + + _ + #1) + (case method-style + #Special + (not (or (Modifier::isInterface [(Class::getModifiers [] class)]) + (Modifier::isAbstract [modifiers]))) + + _ + #1) + (n/= (list.size arg-classes) (list.size parameters)) + (list/fold (function (_ [expectedJC actualJC] prev) + (and prev + (text/= expectedJC actualJC))) + #1 + (list.zip2 arg-classes parameters)))))) + +(def: (check-constructor class arg-classes constructor) + (-> (Class Object) (List Text) (Constructor Object) (Operation Bit)) + (do ////.Monad + [parameters (|> (Constructor::getGenericParameterTypes [] constructor) + array.to-list + (monad.map @ java-type-to-parameter))] + (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor)) + (n/= (list.size arg-classes) (list.size parameters)) + (list/fold (function (_ [expectedJC actualJC] prev) + (and prev + (text/= expectedJC actualJC))) + #1 + (list.zip2 arg-classes parameters)))))) + +(def: idx-to-parameter + (-> Nat Type) + (|>> (n/* +2) inc #.Parameter)) + +(def: (type-vars amount offset) + (-> Nat Nat (List Type)) + (if (n/= +0 amount) + (list) + (|> (list.n/range offset (|> amount dec (n/+ offset))) + (list/map idx-to-parameter)))) + +(def: (method-signature method-style method) + (-> Method-Style Method (Operation Method-Signature)) + (let [owner (Method::getDeclaringClass [] method) + owner-name (Class::getName [] owner) + owner-tvars (case method-style + #Static + (list) + + _ + (|> (Class::getTypeParameters [] owner) + array.to-list + (list/map (TypeVariable::getName [])))) + method-tvars (|> (Method::getTypeParameters [] method) + array.to-list + (list/map (TypeVariable::getName []))) + num-owner-tvars (list.size owner-tvars) + num-method-tvars (list.size method-tvars) + all-tvars (list/compose owner-tvars method-tvars) + num-all-tvars (list.size all-tvars) + owner-tvarsT (type-vars num-owner-tvars +0) + method-tvarsT (type-vars num-method-tvars num-owner-tvars) + mappings (: Mappings + (if (list.empty? all-tvars) + fresh-mappings + (|> (list/compose owner-tvarsT method-tvarsT) + list.reverse + (list.zip2 all-tvars) + (dictionary.from-list text.Hash))))] + (do ////.Monad + [inputsT (|> (Method::getGenericParameterTypes [] method) + array.to-list + (monad.map @ (java-type-to-lux-type mappings))) + outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method)) + exceptionsT (|> (Method::getGenericExceptionTypes [] method) + array.to-list + (monad.map @ (java-type-to-lux-type mappings))) + #let [methodT (<| (type.univ-q num-all-tvars) + (type.function (case method-style + #Static + inputsT + + _ + (list& (#.Primitive owner-name (list.reverse owner-tvarsT)) + inputsT))) + outputT)]] + (wrap [methodT exceptionsT])))) + +(type: Evaluation + (#Pass Method-Signature) + (#Hint Method-Signature) + #Fail) + +(do-template [ ] + [(def: + (-> Evaluation (Maybe Method-Signature)) + (|>> (case> ( output) + (#.Some output) + + _ + #.None)))] + + [pass! #Pass] + [hint! #Hint] + ) + +(def: (method-candidate class-name method-name method-style arg-classes) + (-> Text Text Method-Style (List Text) (Operation Method-Signature)) + (do ////.Monad + [class (load-class class-name) + candidates (|> class + (Class::getDeclaredMethods []) + array.to-list + (monad.map @ (: (-> Method (Operation Evaluation)) + (function (_ method) + (do @ + [passes? (check-method class method-name method-style arg-classes method)] + (cond passes? + (:: @ map (|>> #Pass) (method-signature method-style method)) + + (text/= method-name (Method::getName [] method)) + (:: @ map (|>> #Hint) (method-signature method-style method)) + + ## else + (wrap #Fail)))))))] + (case (list.search-all pass! candidates) + #.Nil + (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)]) + + (#.Cons method #.Nil) + (wrap method) + + candidates + (////.throw too-many-candidates [class-name method-name candidates])))) + +(def: (constructor-signature constructor) + (-> (Constructor Object) (Operation Method-Signature)) + (let [owner (Constructor::getDeclaringClass [] constructor) + owner-name (Class::getName [] owner) + owner-tvars (|> (Class::getTypeParameters [] owner) + array.to-list + (list/map (TypeVariable::getName []))) + constructor-tvars (|> (Constructor::getTypeParameters [] constructor) + array.to-list + (list/map (TypeVariable::getName []))) + num-owner-tvars (list.size owner-tvars) + all-tvars (list/compose owner-tvars constructor-tvars) + num-all-tvars (list.size all-tvars) + owner-tvarsT (type-vars num-owner-tvars +0) + constructor-tvarsT (type-vars num-all-tvars num-owner-tvars) + mappings (: Mappings + (if (list.empty? all-tvars) + fresh-mappings + (|> (list/compose owner-tvarsT constructor-tvarsT) + list.reverse + (list.zip2 all-tvars) + (dictionary.from-list text.Hash))))] + (do ////.Monad + [inputsT (|> (Constructor::getGenericParameterTypes [] constructor) + array.to-list + (monad.map @ (java-type-to-lux-type mappings))) + exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor) + array.to-list + (monad.map @ (java-type-to-lux-type mappings))) + #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT)) + constructorT (<| (type.univ-q num-all-tvars) + (type.function inputsT) + objectT)]] + (wrap [constructorT exceptionsT])))) + +(def: constructor-method "") + +(def: (constructor-candidate class-name arg-classes) + (-> Text (List Text) (Operation Method-Signature)) + (do ////.Monad + [class (load-class class-name) + candidates (|> class + (Class::getConstructors []) + array.to-list + (monad.map @ (function (_ constructor) + (do @ + [passes? (check-constructor class arg-classes constructor)] + (:: @ map + (if passes? (|>> #Pass) (|>> #Hint)) + (constructor-signature constructor))))))] + (case (list.search-all pass! candidates) + #.Nil + (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)]) + + (#.Cons constructor #.Nil) + (wrap constructor) + + candidates + (////.throw too-many-candidates [class-name ..constructor-method candidates])))) + +(def: (decorate-inputs typesT inputsA) + (-> (List Text) (List Analysis) (List Analysis)) + (|> inputsA + (list.zip2 (list/map analysis.text typesT)) + (list/map (function (_ [type value]) + (analysis.product-analysis (list type value)))))) + +(def: invoke::static + Handler + (function (_ extension-name analyse args) + (case (: (e.Error [Text Text (List [Text Code])]) + (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any)))))) + (#e.Success [class method argsTC]) + (do ////.Monad + [#let [argsT (list/map product.left argsTC)] + [methodT exceptionsT] (method-candidate class method #Static argsT) + [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC)) + outputJC (check-jvm outputT)] + (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method) + (analysis.text outputJC) (decorate-inputs argsT argsA))))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: invoke::virtual + Handler + (function (_ extension-name analyse args) + (case (: (e.Error [Text Text Code (List [Text Code])]) + (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) + (#e.Success [class method objectC argsTC]) + (do ////.Monad + [#let [argsT (list/map product.left argsTC)] + [methodT exceptionsT] (method-candidate class method #Virtual argsT) + [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + #let [[objectA argsA] (case allA + (#.Cons objectA argsA) + [objectA argsA] + + _ + (undefined))] + outputJC (check-jvm outputT)] + (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method) + (analysis.text outputJC) objectA (decorate-inputs argsT argsA))))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: invoke::special + Handler + (function (_ extension-name analyse args) + (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Any]]) + (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!))) + (#e.Success [_ [class method objectC argsTC _]]) + (do ////.Monad + [#let [argsT (list/map product.left argsTC)] + [methodT exceptionsT] (method-candidate class method #Special argsT) + [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + outputJC (check-jvm outputT)] + (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method) + (analysis.text outputJC) (decorate-inputs argsT argsA))))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: invoke::interface + Handler + (function (_ extension-name analyse args) + (case (: (e.Error [Text Text Code (List [Text Code])]) + (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any)))))) + (#e.Success [class-name method objectC argsTC]) + (do ////.Monad + [#let [argsT (list/map product.left argsTC)] + class (load-class class-name) + _ (////.assert non-interface class-name + (Modifier::isInterface [(Class::getModifiers [] class)])) + [methodT exceptionsT] (method-candidate class-name method #Interface argsT) + [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) + outputJC (check-jvm outputT)] + (wrap (#analysis.Extension extension-name + (list& (analysis.text class-name) (analysis.text method) (analysis.text outputJC) + (decorate-inputs argsT argsA))))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: invoke::constructor + Handler + (function (_ extension-name analyse args) + (case (: (e.Error [Text (List [Text Code])]) + (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any)))))) + (#e.Success [class argsTC]) + (do ////.Monad + [#let [argsT (list/map product.left argsTC)] + [methodT exceptionsT] (constructor-candidate class argsT) + [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))] + (wrap (#analysis.Extension extension-name (list& (analysis.text class) (decorate-inputs argsT argsA))))) + + _ + (////.throw bundle.invalid-syntax extension-name)))) + +(def: bundle::member + Bundle + (<| (bundle.prefix "member") + (|> bundle.empty + (dictionary.merge (<| (bundle.prefix "static") + (|> bundle.empty + (bundle.install "get" static::get) + (bundle.install "put" static::put)))) + (dictionary.merge (<| (bundle.prefix "virtual") + (|> bundle.empty + (bundle.install "get" virtual::get) + (bundle.install "put" virtual::put)))) + (dictionary.merge (<| (bundle.prefix "invoke") + (|> 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: #export bundle + Bundle + (<| (bundle.prefix "jvm") + (|> bundle.empty + (dictionary.merge bundle::conversion) + (dictionary.merge bundle::int) + (dictionary.merge bundle::long) + (dictionary.merge bundle::float) + (dictionary.merge bundle::double) + (dictionary.merge bundle::char) + (dictionary.merge bundle::array) + (dictionary.merge bundle::object) + (dictionary.merge bundle::member) + ))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/bundle.lux b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux new file mode 100644 index 000000000..e2d36fa73 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/bundle.lux @@ -0,0 +1,38 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." text + format] + [collection + [list ("list/." Functor)] + ["dict" dictionary (#+ Dictionary)]]]] + [// (#+ Handler Bundle)]) + +(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat}) + (ex.report ["Extension" (%t name)] + ["Expected arity" (|> arity .int %i)] + ["Actual arity" (|> args .int %i)])) + +(exception: #export (invalid-syntax {name Text}) + (ex.report ["Extension" name])) + +## [Utils] +(def: #export empty + Bundle + (dict.new text.Hash)) + +(def: #export (install name anonymous) + (All [s i o] + (-> Text (Handler s i o) + (-> (Bundle s i o) (Bundle s i o)))) + (dict.put name anonymous)) + +(def: #export (prefix prefix) + (All [s i o] + (-> Text (-> (Bundle s i o) (Bundle s i o)))) + (|>> dict.entries + (list/map (function (_ [key val]) [(format prefix " " key) val])) + (dict.from-list text.Hash))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux new file mode 100644 index 000000000..d907808a8 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/synthesis.lux @@ -0,0 +1,10 @@ +(.module: + [lux #* + [data + [text] + [collection ["dict" dictionary (#+ Dictionary)]]]] + [//]) + +(def: #export defaults + (Dictionary Text //.Synthesis) + (dict.new text.Hash)) diff --git a/stdlib/source/lux/compiler/default/phase/extension/translation.lux b/stdlib/source/lux/compiler/default/phase/extension/translation.lux new file mode 100644 index 000000000..3a43e0dcb --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/extension/translation.lux @@ -0,0 +1,10 @@ +(.module: + [lux #* + [data + [text] + [collection ["dict" dictionary (#+ Dictionary)]]]] + [//]) + +(def: #export defaults + (Dictionary Text //.Translation) + (dict.new text.Hash)) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux new file mode 100644 index 000000000..8deb48ba8 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux @@ -0,0 +1,264 @@ +(.module: + [lux (#- i64 Scope) + [control [monad (#+ do)]] + [data + [error (#+ Error)] + [collection + ["dict" dictionary (#+ Dictionary)]]]] + ["." // + ["." analysis (#+ Environment Arity Analysis)] + ["." extension (#+ Extension)] + [// + ["." reference (#+ Register Variable Reference)]]]) + +(type: #export Resolver (Dictionary Variable Variable)) + +(type: #export State + {#scope-arity Arity + #resolver Resolver + #direct? Bit + #locals Nat}) + +(def: #export fresh-resolver + Resolver + (dict.new reference.Hash)) + +(def: #export init + State + {#scope-arity +0 + #resolver fresh-resolver + #direct? #0 + #locals +0}) + +(type: #export Primitive + (#Bit Bit) + (#I64 I64) + (#F64 Frac) + (#Text Text)) + +(type: #export (Structure a) + (#Variant (analysis.Variant a)) + (#Tuple (analysis.Tuple a))) + +(type: #export Side + (Either Nat Nat)) + +(type: #export Member + (Either Nat Nat)) + +(type: #export Access + (#Side Side) + (#Member Member)) + +(type: #export (Path' s) + #Pop + (#Test Primitive) + (#Access Access) + (#Bind Register) + (#Alt (Path' s) (Path' s)) + (#Seq (Path' s) (Path' s)) + (#Then s)) + +(type: #export (Abstraction' s) + {#environment Environment + #arity Arity + #body s}) + +(type: #export (Apply' s) + {#function s + #arguments (List s)}) + +(type: #export (Branch s) + (#Let s Register s) + (#If s s s) + (#Case s (Path' s))) + +(type: #export (Scope s) + {#start Register + #inits (List s) + #iteration s}) + +(type: #export (Loop s) + (#Scope (Scope s)) + (#Recur (List s))) + +(type: #export (Function s) + (#Abstraction (Abstraction' s)) + (#Apply s (List s))) + +(type: #export (Control s) + (#Branch (Branch s)) + (#Loop (Loop s)) + (#Function (Function s))) + +(type: #export #rec Synthesis + (#Primitive Primitive) + (#Structure (Structure Synthesis)) + (#Reference Reference) + (#Control (Control Synthesis)) + (#Extension (Extension Synthesis))) + +(type: #export Operation + (extension.Operation ..State Analysis Synthesis)) + +(type: #export Phase + (extension.Phase ..State Analysis Synthesis)) + +(type: #export Path + (Path' Synthesis)) + +(def: #export path/pop + Path + #Pop) + +(do-template [ ] + [(template: #export ( content) + (#..Test ( content)))] + + [path/bit #..Bit] + [path/i64 #..I64] + [path/f64 #..F64] + [path/text #..Text] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Access + + content))] + + [path/side #..Side] + [path/member #..Member] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Access + + + content))] + + [side/left #..Side #.Left] + [side/right #..Side #.Right] + [member/left #..Member #.Left] + [member/right #..Member #.Right] + ) + +(do-template [ ] + [(template: #export ( content) + ( content))] + + [path/alt #..Alt] + [path/seq #..Seq] + [path/then #..Then] + ) + +(type: #export Abstraction + (Abstraction' Synthesis)) + +(type: #export Apply + (Apply' Synthesis)) + +(def: #export unit Text "") + +(do-template [ ] + [(def: #export + (All [a] (-> (Operation a) (Operation a))) + (extension.temporary (set@ #direct? )))] + + [indirectly #0] + [directly #1] + ) + +(do-template [ ] + [(def: #export ( value) + (-> (All [a] (-> (Operation a) (Operation a)))) + (extension.temporary (set@ value)))] + + [with-scope-arity Arity #scope-arity] + [with-resolver Resolver #resolver] + [with-locals Nat #locals] + ) + +(def: #export (with-abstraction arity resolver) + (-> Arity Resolver + (All [a] (-> (Operation a) (Operation a)))) + (extension.with-state {#scope-arity arity + #resolver resolver + #direct? #1 + #locals arity})) + +(do-template [ ] + [(def: #export + (Operation ) + (extension.read (get@ )))] + + [scope-arity #scope-arity Arity] + [resolver #resolver Resolver] + [direct? #direct? Bit] + [locals #locals Nat] + ) + +(def: #export with-new-local + (All [a] (-> (Operation a) (Operation a))) + (<<| (do //.Monad + [locals ..locals]) + (..with-locals (inc locals)))) + +(do-template [ ] + [(template: #export ( content) + (#..Primitive ( content)))] + + [bit #..Bit] + [i64 #..I64] + [f64 #..F64] + [text #..Text] + ) + +(do-template [ ] + [(template: #export ( content) + (<| #..Structure + + content))] + + [variant #..Variant] + [tuple #..Tuple] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Reference + + content))] + + [variable/local reference.local] + [variable/foreign reference.foreign] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Reference + + content))] + + [variable reference.variable] + [constant reference.constant] + ) + +(do-template [ ] + [(template: #export ( content) + (.<| #..Control + + + content))] + + [branch/case #..Branch #..Case] + [branch/let #..Branch #..Let] + [branch/if #..Branch #..If] + + [loop/recur #..Loop #..Recur] + [loop/scope #..Loop #..Scope] + + [function/abstraction #..Function #..Abstraction] + [function/apply #..Function #..Apply] + ) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux new file mode 100644 index 000000000..eaa7621f6 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux @@ -0,0 +1,181 @@ +(.module: + [lux #* + [control + [equivalence (#+ Equivalence)] + pipe + ["." monad (#+ do)]] + [data + ["." product] + [bit ("bit/." Equivalence)] + [text ("text/." Equivalence) + format] + [number ("frac/." Equivalence)] + [collection + ["." list ("list/." Fold Monoid)]]]] + ["." // (#+ Path Synthesis Operation Phase) + ["." function] + ["/." // ("operation/." Monad) + ["." analysis (#+ Pattern Match Analysis)] + [// + ["." reference]]]]) + +(def: (path' pattern bodyC) + (-> Pattern (Operation Path) (Operation Path)) + (case pattern + (#analysis.Simple simple) + (case simple + #analysis.Unit + bodyC + + (^template [ ] + ( value) + (operation/map (|>> (#//.Seq (#//.Test (|> value )))) + bodyC)) + ([#analysis.Bit #//.Bit] + [#analysis.Nat (<| #//.I64 .i64)] + [#analysis.Int (<| #//.I64 .i64)] + [#analysis.Rev (<| #//.I64 .i64)] + [#analysis.Frac #//.F64] + [#analysis.Text #//.Text])) + + (#analysis.Bind register) + (<| (do ///.Monad + [arity //.scope-arity]) + (:: @ map (|>> (#//.Seq (#//.Bind (if (function.nested? arity) + (n/+ (dec arity) register) + register))))) + //.with-new-local + bodyC) + + (#analysis.Complex _) + (case (analysis.variant-pattern pattern) + (#.Some [lefts right? value-pattern]) + (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right? + (#.Right lefts) + (#.Left lefts)))))) + (path' value-pattern bodyC)) + + #.None + (let [tuple (analysis.tuple-pattern pattern) + tuple/last (dec (list.size tuple))] + (list/fold (function (_ [tuple/idx tuple/member] thenC) + (case tuple/member + (#analysis.Simple #analysis.Unit) + thenC + + _ + (let [last? (n/= tuple/last tuple/idx)] + (|> (if (or last? + (is? bodyC thenC)) + thenC + (operation/map (|>> (#//.Seq #//.Pop)) thenC)) + (path' tuple/member) + (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if last? + (#.Right (dec tuple/idx)) + (#.Left tuple/idx))))))))))) + bodyC + (list.reverse (list.enumerate tuple))))))) + +(def: #export (path synthesize pattern bodyA) + (-> Phase Pattern Analysis (Operation Path)) + (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA)))) + +(def: #export (weave leftP rightP) + (-> Path Path Path) + (with-expansions [ (as-is (#//.Alt leftP rightP))] + (case [leftP rightP] + [(#//.Seq preL postL) + (#//.Seq preR postR)] + (case (weave preL preR) + (#//.Alt _) + + + weavedP + (#//.Seq weavedP (weave postL postR))) + + [#//.Pop #//.Pop] + rightP + + (^template [ ] + [(#//.Test ( leftV)) + (#//.Test ( rightV))] + (if ( leftV rightV) + rightP + )) + ([#//.Bit bit/=] + [#//.I64 (:coerce (Equivalence I64) i/=)] + [#//.F64 frac/=] + [#//.Text text/=]) + + (^template [ ] + [(#//.Access ( ( leftL))) + (#//.Access ( ( rightL)))] + (if (n/= leftL rightL) + rightP + )) + ([#//.Side #.Left] + [#//.Side #.Right] + [#//.Member #.Left] + [#//.Member #.Right]) + + [(#//.Bind leftR) (#//.Bind rightR)] + (if (n/= leftR rightR) + rightP + ) + + _ + ))) + +(def: #export (synthesize synthesize^ inputA [headB tailB+]) + (-> Phase Analysis Match (Operation Synthesis)) + (do ///.Monad + [inputS (synthesize^ inputA)] + (with-expansions [ + (as-is (^multi (^ (#analysis.Reference (reference.local outputR))) + (n/= inputR outputR)) + (wrap inputS)) + + + (as-is [[(#analysis.Bind inputR) headB/bodyA] + #.Nil] + (case headB/bodyA + + + _ + (do @ + [arity //.scope-arity + headB/bodyS (//.with-new-local + (synthesize^ headB/bodyA))] + (wrap (//.branch/let [inputS + (if (function.nested? arity) + (n/+ (dec arity) inputR) + inputR) + headB/bodyS]))))) + + + (as-is (^or (^ [[(analysis.pattern/bit #1) thenA] + (list [(analysis.pattern/bit #0) elseA])]) + (^ [[(analysis.pattern/bit #0) elseA] + (list [(analysis.pattern/bit #1) thenA])])) + (do @ + [thenS (synthesize^ thenA) + elseS (synthesize^ elseA)] + (wrap (//.branch/if [inputS thenS elseS])))) + + + (as-is _ + (let [[[lastP lastA] prevsPA] (|> (#.Cons headB tailB+) + list.reverse + (case> (#.Cons [lastP lastA] prevsPA) + [[lastP lastA] prevsPA] + + _ + (undefined)))] + (do @ + [lastSP (path synthesize^ lastP lastA) + prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)] + (wrap (//.branch/case [inputS (list/fold weave lastSP prevsSP+)])))))] + (case [headB tailB+] + + + )))) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux new file mode 100644 index 000000000..edb2cc034 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux @@ -0,0 +1,94 @@ +(.module: + [lux (#- primitive) + [control + ["." monad (#+ do)]] + [data + ["." maybe] + [collection + ["." list ("list/." Functor)] + ["dict" dictionary (#+ Dictionary)]]]] + ["." // (#+ Synthesis Phase) + ["." function] + ["." case] + ["/." // ("operation/." Monad) + ["." analysis (#+ Analysis)] + ["." extension] + [// + ["." reference]]]]) + +(def: (primitive analysis) + (-> analysis.Primitive //.Primitive) + (case analysis + #analysis.Unit + (#//.Text //.unit) + + (^template [ ] + ( value) + ( value)) + ([#analysis.Bit #//.Bit] + [#analysis.Frac #//.F64] + [#analysis.Text #//.Text]) + + (^template [ ] + ( value) + ( (.i64 value))) + ([#analysis.Nat #//.I64] + [#analysis.Int #//.I64] + [#analysis.Rev #//.I64]))) + +(def: #export (synthesize analysis) + Phase + (case analysis + (#analysis.Primitive analysis') + (operation/wrap (#//.Primitive (..primitive analysis'))) + + (#analysis.Structure composite) + (case (analysis.variant analysis) + (#.Some variant) + (do ///.Monad + [valueS (synthesize (get@ #analysis.value variant))] + (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant))))) + + _ + (do ///.Monad + [tupleS (monad.map @ synthesize (analysis.tuple analysis))] + (wrap (#//.Structure (#//.Tuple tupleS))))) + + (#analysis.Reference reference) + (case reference + (#reference.Constant constant) + (operation/wrap (#//.Reference reference)) + + (#reference.Variable var) + (do ///.Monad + [resolver //.resolver] + (case var + (#reference.Local register) + (do @ + [arity //.scope-arity] + (wrap (if (function.nested? arity) + (if (n/= +0 register) + (|> (dec arity) + (list.n/range +1) + (list/map (|>> //.variable/local)) + [(//.variable/local +0)] + //.function/apply) + (#//.Reference (#reference.Variable (function.adjust arity #0 var)))) + (#//.Reference (#reference.Variable var))))) + + (#reference.Foreign register) + (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference))))) + + (#analysis.Case inputA branchesAB+) + (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+) + + (#analysis.Apply _) + (function.apply (|>> synthesize //.indirectly) analysis) + + (#analysis.Function environmentA bodyA) + (function.function synthesize environmentA bodyA) + + (#analysis.Extension name args) + (extension.apply (|>> synthesize //.indirectly) + [name args]) + )) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux new file mode 100644 index 000000000..397ca2449 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux @@ -0,0 +1,134 @@ +(.module: + [lux (#- function) + [control + ["." monad (#+ do)] + ["." state] + pipe + ["ex" exception (#+ exception:)]] + [data + ["." maybe ("maybe/." Monad)] + ["." error] + [collection + ["." list ("list/." Functor Monoid Fold)] + ["dict" dictionary (#+ Dictionary)]]]] + ["." // (#+ Synthesis Operation Phase) + ["." loop (#+ Transform)] + ["/." // + ["." analysis (#+ Environment Arity Analysis)] + [// + ["." reference (#+ Variable)]]]]) + +(def: #export nested? + (-> Arity Bit) + (n/> +1)) + +(def: #export (adjust up-arity after? var) + (-> Arity Bit Variable Variable) + (case var + (#reference.Local register) + (if (and after? (n/>= up-arity register)) + (#reference.Local (n/+ (dec up-arity) register)) + var) + + _ + var)) + +(def: (unfold apply) + (-> Analysis [Analysis (List Analysis)]) + (loop [apply apply + args (list)] + (case apply + (#analysis.Apply arg func) + (recur func (#.Cons arg args)) + + _ + [apply args]))) + +(def: #export (apply synthesize) + (-> Phase Phase) + (.function (_ exprA) + (let [[funcA argsA] (unfold exprA)] + (do (state.Monad error.Monad) + [funcS (synthesize funcA) + argsS (monad.map @ synthesize argsA) + locals //.locals] + (case funcS + (^ (//.function/abstraction functionS)) + (wrap (|> functionS + (loop.loop (get@ #//.environment functionS) locals argsS) + (maybe.default (//.function/apply [funcS argsS])))) + + (^ (//.function/apply [funcS' argsS'])) + (wrap (//.function/apply [funcS' (list/compose argsS' argsS)])) + + _ + (wrap (//.function/apply [funcS argsS]))))))) + +(def: (prepare up down) + (-> Arity Arity (Transform Synthesis)) + (.function (_ body) + (if (nested? up) + (#.Some body) + (loop.recursion down body)))) + +(exception: #export (cannot-prepare-function-body {_ []}) + "") + +(def: return + (All [a] (-> (Maybe a) (Operation a))) + (|>> (case> (#.Some output) + (:: ///.Monad wrap output) + + #.None + (///.throw cannot-prepare-function-body [])))) + +(def: #export (function synthesize environment body) + (-> Phase Environment Analysis (Operation Synthesis)) + (do ///.Monad + [direct? //.direct? + arity //.scope-arity + resolver //.resolver + #let [function-arity (if direct? + (inc arity) + +1) + up-environment (if (nested? arity) + (list/map (.function (_ closure) + (case (dict.get closure resolver) + (#.Some resolved) + (adjust arity #1 resolved) + + #.None + (adjust arity #0 closure))) + environment) + environment) + down-environment (: (List Variable) + (case environment + #.Nil + (list) + + _ + (|> (list.size environment) dec (list.n/range +0) + (list/map (|>> #reference.Foreign))))) + resolver' (if (and (nested? function-arity) + direct?) + (list/fold (.function (_ [from to] resolver') + (dict.put from to resolver')) + //.fresh-resolver + (list.zip2 down-environment up-environment)) + (list/fold (.function (_ var resolver') + (dict.put var var resolver')) + //.fresh-resolver + down-environment))] + bodyS (//.with-abstraction function-arity resolver' + (synthesize body))] + (case bodyS + (^ (//.function/abstraction [env' down-arity' bodyS'])) + (let [arity' (inc down-arity')] + (|> (prepare function-arity arity' bodyS') + (maybe/map (|>> [up-environment arity'] //.function/abstraction)) + ..return)) + + _ + (|> (prepare function-arity +1 bodyS) + (maybe/map (|>> [up-environment +1] //.function/abstraction)) + ..return)))) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux b/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux new file mode 100644 index 000000000..bfa69c7c6 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/synthesis/loop.lux @@ -0,0 +1,291 @@ +(.module: + [lux (#- loop) + [control + ["." monad (#+ do)] + ["p" parser]] + [data + ["." maybe ("maybe/." Monad)] + [collection + ["." list ("list/." Functor)]]] + [macro + ["." code] + ["." syntax]]] + ["." // (#+ Path Abstraction Synthesis) + [// + ["." analysis (#+ Environment)] + ["." extension] + [// + ["." reference (#+ Register Variable)]]]]) + +(type: #export (Transform a) + (-> a (Maybe a))) + +(def: (some? maybe) + (All [a] (-> (Maybe a) Bit)) + (case maybe + (#.Some _) #1 + #.None #0)) + +(template: #export (self) + (#//.Reference (reference.local +0))) + +(template: (recursive-apply args) + (#//.Apply (self) args)) + +(def: improper #0) +(def: proper #1) + +(def: (proper? exprS) + (-> Synthesis Bit) + (case exprS + (^ (self)) + improper + + (#//.Structure structure) + (case structure + (#//.Variant variantS) + (proper? (get@ #analysis.value variantS)) + + (#//.Tuple membersS+) + (list.every? proper? membersS+)) + + (#//.Control controlS) + (case controlS + (#//.Branch branchS) + (case branchS + (#//.Case inputS pathS) + (and (proper? inputS) + (.loop [pathS pathS] + (case pathS + (^or (#//.Alt leftS rightS) (#//.Seq leftS rightS)) + (and (recur leftS) (recur rightS)) + + (#//.Then bodyS) + (proper? bodyS) + + _ + proper))) + + (#//.Let inputS register bodyS) + (and (proper? inputS) + (proper? bodyS)) + + (#//.If inputS thenS elseS) + (and (proper? inputS) + (proper? thenS) + (proper? elseS))) + + (#//.Loop loopS) + (case loopS + (#//.Scope scopeS) + (and (list.every? proper? (get@ #//.inits scopeS)) + (proper? (get@ #//.iteration scopeS))) + + (#//.Recur argsS) + (list.every? proper? argsS)) + + (#//.Function functionS) + (case functionS + (#//.Abstraction environment arity bodyS) + (list.every? reference.self? environment) + + (#//.Apply funcS argsS) + (and (proper? funcS) + (list.every? proper? argsS)))) + + (#//.Extension [name argsS]) + (list.every? proper? argsS) + + _ + proper)) + +(def: (path-recursion synthesis-recursion) + (-> (Transform Synthesis) (Transform Path)) + (function (recur pathS) + (case pathS + (#//.Alt leftS rightS) + (let [leftS' (recur leftS) + rightS' (recur rightS)] + (if (or (some? leftS') + (some? rightS')) + (#.Some (#//.Alt (maybe.default leftS leftS') + (maybe.default rightS rightS'))) + #.None)) + + (#//.Seq leftS rightS) + (maybe/map (|>> (#//.Seq leftS)) (recur rightS)) + + (#//.Then bodyS) + (maybe/map (|>> #//.Then) (synthesis-recursion bodyS)) + + _ + #.None))) + +(def: #export (recursion arity) + (-> Nat (Transform Synthesis)) + (function (recur exprS) + (case exprS + (#//.Control controlS) + (case controlS + (#//.Branch branchS) + (case branchS + (#//.Case inputS pathS) + (|> pathS + (path-recursion recur) + (maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control))) + + (#//.Let inputS register bodyS) + (maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control) + (recur bodyS)) + + (#//.If inputS thenS elseS) + (let [thenS' (recur thenS) + elseS' (recur elseS)] + (if (or (some? thenS') + (some? elseS')) + (#.Some (|> (#//.If inputS + (maybe.default thenS thenS') + (maybe.default elseS elseS')) + #//.Branch #//.Control)) + #.None))) + + (^ (#//.Function (recursive-apply argsS))) + (if (n/= arity (list.size argsS)) + (#.Some (|> argsS #//.Recur #//.Loop #//.Control)) + #.None) + + _ + #.None) + + _ + #.None))) + +(def: (resolve environment) + (-> Environment (Transform Variable)) + (function (_ variable) + (case variable + (#reference.Foreign register) + (list.nth register environment) + + _ + (#.Some variable)))) + +(def: (adjust-path adjust-synthesis offset) + (-> (Transform Synthesis) Register (Transform Path)) + (function (recur pathS) + (case pathS + (#//.Bind register) + (#.Some (#//.Bind (n/+ offset register))) + + (^template [] + ( leftS rightS) + (do maybe.Monad + [leftS' (recur leftS) + rightS' (recur rightS)] + (wrap ( leftS' rightS')))) + ([#//.Alt] [#//.Seq]) + + (#//.Then bodyS) + (|> bodyS adjust-synthesis (maybe/map (|>> #//.Then))) + + _ + (#.Some pathS)))) + +(def: (adjust scope-environment offset) + (-> Environment Register (Transform Synthesis)) + (function (recur exprS) + (case exprS + (#//.Structure structureS) + (case structureS + (#//.Variant variantS) + (do maybe.Monad + [valueS' (|> variantS (get@ #analysis.value) recur)] + (wrap (|> variantS + (set@ #analysis.value valueS') + #//.Variant + #//.Structure))) + + (#//.Tuple membersS+) + (|> membersS+ + (monad.map maybe.Monad recur) + (maybe/map (|>> #//.Tuple #//.Structure)))) + + (#//.Reference reference) + (case reference + (^ (reference.constant constant)) + (#.Some exprS) + + (^ (reference.local register)) + (#.Some (#//.Reference (reference.local (n/+ offset register)))) + + (^ (reference.foreign register)) + (|> scope-environment + (list.nth register) + (maybe/map (|>> #reference.Variable #//.Reference)))) + + (^ (//.branch/case [inputS pathS])) + (do maybe.Monad + [inputS' (recur inputS) + pathS' (adjust-path recur offset pathS)] + (wrap (|> pathS' [inputS'] //.branch/case))) + + (^ (//.branch/let [inputS register bodyS])) + (do maybe.Monad + [inputS' (recur inputS) + bodyS' (recur bodyS)] + (wrap (//.branch/let [inputS' register bodyS']))) + + (^ (//.branch/if [inputS thenS elseS])) + (do maybe.Monad + [inputS' (recur inputS) + thenS' (recur thenS) + elseS' (recur elseS)] + (wrap (//.branch/if [inputS' thenS' elseS']))) + + (^ (//.loop/scope scopeS)) + (do maybe.Monad + [inits' (|> scopeS + (get@ #//.inits) + (monad.map maybe.Monad recur)) + iteration' (recur (get@ #//.iteration scopeS))] + (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset)) + #//.inits inits' + #//.iteration iteration'}))) + + (^ (//.loop/recur argsS)) + (|> argsS + (monad.map maybe.Monad recur) + (maybe/map (|>> //.loop/recur))) + + + (^ (//.function/abstraction [environment arity bodyS])) + (do maybe.Monad + [environment' (monad.map maybe.Monad + (resolve scope-environment) + environment)] + (wrap (//.function/abstraction [environment' arity bodyS]))) + + (^ (//.function/apply [function arguments])) + (do maybe.Monad + [function' (recur function) + arguments' (monad.map maybe.Monad recur arguments)] + (wrap (//.function/apply [function' arguments']))) + + (#//.Extension [name argsS]) + (|> argsS + (monad.map maybe.Monad recur) + (maybe/map (|>> [name] #//.Extension))) + + _ + (#.Some exprS)))) + +(def: #export (loop environment num-locals inits functionS) + (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis)) + (let [bodyS (get@ #//.body functionS)] + (if (and (n/= (list.size inits) + (get@ #//.arity functionS)) + (proper? bodyS)) + (|> bodyS + (adjust environment num-locals) + (maybe/map (|>> [(inc num-locals) inits] //.loop/scope))) + #.None))) diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux new file mode 100644 index 000000000..82e31320a --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -0,0 +1,196 @@ +(.module: + [lux #* + [control + ["ex" exception (#+ exception:)] + [monad (#+ do)]] + [data + ["." product] + ["." error (#+ Error)] + [ident ("ident/." Equivalence Codec)] + ["." text + format] + [collection + ["." row (#+ Row)] + ["dict" dictionary (#+ Dictionary)]]] + [world + [file (#+ File)]]] + ["." // + ["." extension]] + [//synthesis (#+ Synthesis)]) + +(do-template [] + [(exception: #export () + "")] + + [no-active-buffer] + [no-anchor] + ) + +(exception: #export (cannot-interpret {message Text}) + message) + +(do-template [] + [(exception: #export ( {name Ident}) + (ex.report ["Artifact" (ident/encode name)]))] + + [cannot-overwrite-artifact] + [no-buffer-for-saving-code] + ) + +(type: #export Context + {#scope-name Text + #inner-functions Nat}) + +(signature: #export (Host expression statement) + (: (-> expression (Error Any)) + evaluate!) + (: (-> statement (Error Any)) + execute!)) + +(type: #export (Buffer statement) (Row [Ident statement])) + +(type: #export (Artifacts statement) (Dictionary File (Buffer statement))) + +(type: #export (State anchor expression statement) + {#context Context + #anchor (Maybe anchor) + #host (Host expression statement) + #buffer (Maybe (Buffer statement)) + #artifacts (Artifacts statement) + #counter Nat}) + +(type: #export (Operation anchor expression statement) + (extension.Operation (State anchor expression statement) Synthesis expression)) + +(type: #export (Phase anchor expression statement) + (extension.Phase (State anchor expression statement) Synthesis expression)) + +(type: #export (Handler anchor expression statement) + (extension.Handler (State anchor expression statement) Synthesis expression)) + +(type: #export (Bundle anchor expression statement) + (extension.Bundle (State anchor expression statement) Synthesis expression)) + +(def: #export (init host) + (All [anchor expression statement] + (-> (Host expression statement) + (..State anchor expression statement))) + {#context {#scope-name "" + #inner-functions +0} + #anchor #.None + #host host + #buffer #.None + #artifacts (dict.new text.Hash) + #counter +0}) + +(def: #export (with-context expr) + (All [anchor expression statement output] + (-> (Operation anchor expression statement output) + (Operation anchor expression statement [Text output]))) + (function (_ [bundle state]) + (let [[old-scope old-inner] (get@ #context state) + new-scope (format old-scope "c___" (%i (.int old-inner)))] + (case (expr [bundle (set@ #context [new-scope +0] state)]) + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')] + [new-scope output]]) + + (#error.Error error) + (#error.Error error))))) + +(def: #export context + (All [anchor expression statement] + (Operation anchor expression statement Text)) + (extension.read (|>> (get@ #context) + (get@ #scope-name)))) + +(do-template [ + + ] + [(def: #export + (All [anchor expression statement output] ) + (function (_ body) + (function (_ [bundle state]) + (case (body [bundle (set@ (#.Some ) state)]) + (#error.Success [[bundle' state'] output]) + (#error.Success [[bundle' (set@ (get@ state) state')] + output]) + + (#error.Error error) + (#error.Error error))))) + + (def: #export + (All [anchor expression statement] + (Operation anchor expression statement )) + (function (_ (^@ stateE [bundle state])) + (case (get@ state) + (#.Some output) + (#error.Success [stateE output]) + + #.None + (ex.throw []))))] + + [#anchor + (with-anchor anchor) + (-> anchor (Operation anchor expression statement output) + (Operation anchor expression statement output)) + anchor + anchor anchor no-anchor] + + [#buffer + with-buffer + (-> (Operation anchor expression statement output) + (Operation anchor expression statement output)) + row.empty + buffer (Buffer statement) no-active-buffer] + ) + +(def: #export artifacts + (All [anchor expression statement] + (Operation anchor expression statement (Artifacts statement))) + (extension.read (get@ #artifacts))) + +(def: #export next + (All [anchor expression statement] + (Operation anchor expression statement Nat)) + (do //.Monad + [_ (extension.update (update@ #counter inc))] + (extension.read (get@ #counter)))) + +(do-template [ ] + [(def: #export ( code) + (All [anchor expression statement] + (-> (Operation anchor expression statement Any))) + (function (_ (^@ stateE [bundle state])) + (case (:: (get@ #host state) code) + (#error.Error error) + (ex.throw cannot-interpret error) + + (#error.Success output) + (#error.Success [stateE output]))))] + + [evaluate! expression] + [execute! statement] + ) + +(def: #export (save! name code) + (All [anchor expression statement] + (-> Ident statement (Operation anchor expression statement Any))) + (do //.Monad + [_ (execute! code) + ?buffer (extension.read (get@ #buffer))] + (case ?buffer + (#.Some buffer) + (if (row.any? (|>> product.left (ident/= name)) buffer) + (//.throw cannot-overwrite-artifact name) + (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) + + #.None + (//.throw no-buffer-for-saving-code name)))) + +(def: #export (save-buffer! target) + (All [anchor expression statement] + (-> File (Operation anchor expression statement Any))) + (do //.Monad + [buffer ..buffer] + (extension.update (update@ #artifacts (dict.put target buffer))))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux new file mode 100644 index 000000000..5ab0c56dd --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux @@ -0,0 +1,177 @@ +(.module: + [lux (#- case let if) + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." number] + ["." text + format] + [collection + [list ("list/." Functor Fold)] + [set (#+ Set)]]]] + [// + ["." runtime (#+ Operation Phase)] + ["." reference] + ["/." /// ("operation/." Monad) + ["." synthesis (#+ Synthesis Path)] + [// + [reference (#+ Register)] + [// + [host + ["_" scheme (#+ Expression Computation Var)]]]]]]) + +(def: #export (let translate [valueS register bodyS]) + (-> Phase [Synthesis Register Synthesis] + (Operation Computation)) + (do ////.Monad + [valueO (translate valueS) + bodyO (translate bodyS)] + (wrap (_.let (list [(reference.local' register) valueO]) + bodyO)))) + +(def: #export (record-get translate valueS pathP) + (-> Phase Synthesis (List [Nat Bit]) + (Operation Expression)) + (do ////.Monad + [valueO (translate valueS)] + (wrap (list/fold (function (_ [idx tail?] source) + (.let [method (.if tail? + runtime.product//right + runtime.product//left)] + (method source (_.int (:coerce Int idx))))) + valueO + pathP)))) + +(def: #export (if translate [testS thenS elseS]) + (-> Phase [Synthesis Synthesis Synthesis] + (Operation Computation)) + (do ////.Monad + [testO (translate testS) + thenO (translate thenS) + elseO (translate elseS)] + (wrap (_.if testO thenO elseO)))) + +(def: @savepoint (_.var "lux_pm_cursor_savepoint")) + +(def: @cursor (_.var "lux_pm_cursor")) + +(def: top _.length/1) + +(def: (push! value var) + (-> Expression Var Computation) + (_.set! var (_.cons/2 value var))) + +(def: (pop! var) + (-> Var Computation) + (_.set! var var)) + +(def: (push-cursor! value) + (-> Expression Computation) + (push! value @cursor)) + +(def: save-cursor! + Computation + (push! @cursor @savepoint)) + +(def: restore-cursor! + Computation + (_.set! @cursor (_.car/1 @savepoint))) + +(def: cursor-top + Computation + (_.car/1 @cursor)) + +(def: pop-cursor! + Computation + (pop! @cursor)) + +(def: pm-error (_.string "PM-ERROR")) + +(def: fail-pm! (_.raise/1 pm-error)) + +(def: @temp (_.var "lux_pm_temp")) + +(exception: #export (unrecognized-path) + "") + +(def: $alt_error (_.var "alt_error")) + +(def: (pm-catch handler) + (-> Expression Computation) + (_.lambda [(list $alt_error) #.None] + (_.if (|> $alt_error (_.eqv?/2 pm-error)) + handler + (_.raise/1 $alt_error)))) + +(def: (pattern-matching' translate pathP) + (-> Phase Path (Operation Expression)) + (.case pathP + (^ (synthesis.path/then bodyS)) + (translate bodyS) + + #synthesis.Pop + (operation/wrap pop-cursor!) + + (#synthesis.Bind register) + (operation/wrap (_.define (reference.local' register) [(list) #.None] + cursor-top)) + + (^template [ <=>] + (^ ( value)) + (operation/wrap (_.when (|> value (<=> cursor-top) _.not/1) + fail-pm!))) + ([synthesis.path/bit _.bool _.eqv?/2] + [synthesis.path/i64 _.int _.=/2] + [synthesis.path/f64 _.float _.=/2] + [synthesis.path/text _.string _.eqv?/2]) + + (^template [ ] + (^ ( idx)) + (operation/wrap (_.let (list [@temp (|> idx .int _.int (runtime.sum//get cursor-top ))]) + (_.if (_.null?/1 @temp) + fail-pm! + (push-cursor! @temp))))) + ([synthesis.side/left _.nil (<|)] + [synthesis.side/right (_.string "") inc]) + + (^template [ ] + (^ ( idx)) + (operation/wrap (|> idx .int _.int ( cursor-top) push-cursor!))) + ([synthesis.member/left runtime.product//left (<|)] + [synthesis.member/right runtime.product//right inc]) + + (^template [ ] + (^ ( [leftP rightP])) + (do ////.Monad + [leftO (pattern-matching' translate leftP) + rightO (pattern-matching' translate rightP)] + (wrap ))) + ([synthesis.path/seq (_.begin (list leftO + rightO))] + [synthesis.path/alt (_.with-exception-handler + (pm-catch (_.begin (list restore-cursor! + rightO))) + (_.lambda [(list) #.None] + (_.begin (list save-cursor! + leftO))))]) + + _ + (////.throw unrecognized-path []))) + +(def: (pattern-matching translate pathP) + (-> Phase Path (Operation Computation)) + (do ////.Monad + [pattern-matching! (pattern-matching' translate pathP)] + (wrap (_.with-exception-handler + (pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching."))) + (_.lambda [(list) #.None] + pattern-matching!))))) + +(def: #export (case translate [valueS pathP]) + (-> Phase [Synthesis Path] (Operation Computation)) + (do ////.Monad + [valueO (translate valueS)] + (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] + [@savepoint (_.list/* (list))]))) + (pattern-matching translate pathP)))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/expression.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/expression.jvm.lux new file mode 100644 index 000000000..53d7bbbcb --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/expression.jvm.lux @@ -0,0 +1,59 @@ +(.module: + [lux #* + [control + [monad (#+ do)]]] + [// + [runtime (#+ Phase)] + ["." primitive] + ["." structure] + ["." reference] + ["." function] + ["." case] + ["." loop] + ["." /// + ["." synthesis] + ["." extension]]]) + +(def: #export (translate synthesis) + Phase + (case synthesis + (^template [ ] + (^ ( value)) + ( value)) + ([synthesis.bit primitive.bit] + [synthesis.i64 primitive.i64] + [synthesis.f64 primitive.f64] + [synthesis.text primitive.text]) + + (^ (synthesis.variant variantS)) + (structure.variant translate variantS) + + (^ (synthesis.tuple members)) + (structure.tuple translate members) + + (#synthesis.Reference reference) + (reference.reference reference) + + (^ (synthesis.branch/case case)) + (case.case translate case) + + (^ (synthesis.branch/let let)) + (case.let translate let) + + (^ (synthesis.branch/if if)) + (case.if translate if) + + (^ (synthesis.loop/scope scope)) + (loop.scope translate scope) + + (^ (synthesis.loop/recur updates)) + (loop.recur translate updates) + + (^ (synthesis.function/abstraction abstraction)) + (function.function translate abstraction) + + (^ (synthesis.function/apply application)) + (function.apply translate application) + + (#synthesis.Extension extension) + (extension.apply translate extension))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension.jvm.lux new file mode 100644 index 000000000..a40b4953f --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension.jvm.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [// + [runtime (#+ Bundle)]] + [/ + ["." common] + ["." host]]) + +(def: #export bundle + Bundle + (|> common.bundle + (dictionary.merge host.bundle))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux new file mode 100644 index 000000000..53fcfbff7 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -0,0 +1,360 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["e" error] + ["." product] + ["." text + format] + [number (#+ hex)] + [collection + ["." list ("list/." Functor)] + ["dict" dictionary (#+ Dictionary)]]] + ["." macro (#+ with-gensyms) + ["." code] + ["s" syntax (#+ syntax:)]] + [host (#+ import:)]] + [/// + ["." runtime (#+ Operation Phase Handler Bundle)] + ["//." /// + ["." synthesis (#+ Synthesis)] + [extension + ["." bundle]] + [/// + [host + ["_" scheme (#+ Expression Computation)]]]]]) + +## [Types] +(syntax: (Vector {size s.nat} elemT) + (wrap (list (` [(~+ (list.repeat size elemT))])))) + +(type: #export Nullary (-> (Vector +0 Expression) Computation)) +(type: #export Unary (-> (Vector +1 Expression) Computation)) +(type: #export Binary (-> (Vector +2 Expression) Computation)) +(type: #export Trinary (-> (Vector +3 Expression) Computation)) +(type: #export Variadic (-> (List Expression) Computation)) + +## [Utils] +(syntax: (arity: {name s.local-symbol} {arity s.nat}) + (with-gensyms [g!_ g!extension g!name g!translate g!inputs] + (do @ + [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] + (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!extension)) + (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) + Handler) + (function ((~ g!_) (~ g!name) (~ g!translate) (~ g!inputs)) + (case (~ g!inputs) + (^ (list (~+ g!input+))) + (do /////.Monad + [(~+ (|> g!input+ + (list/map (function (_ g!input) + (list g!input (` ((~ g!translate) (~ g!input)))))) + list.concat))] + ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) + + (~' _) + (/////.throw bundle.incorrect-arity [(~ g!name) +1 (list.size (~ g!inputs))])))))))))) + +(arity: nullary +0) +(arity: unary +1) +(arity: binary +2) +(arity: trinary +3) + +(def: #export (variadic extension) + (-> Variadic Handler) + (function (_ extension-name) + (function (_ translate inputsS) + (do /////.Monad + [inputsI (monad.map @ translate inputsS)] + (wrap (extension inputsI)))))) + +## [Bundle] +## [[Lux]] +(def: bundle::lux + Bundle + (|> bundle.empty + (bundle.install "is?" (binary (product.uncurry _.eq?/2))) + (bundle.install "try" (unary runtime.lux//try)))) + +## [[Bits]] +(do-template [ ] + [(def: ( [subjectO paramO]) + Binary + ( paramO subjectO))] + + [bit::and _.bit-and/2] + [bit::or _.bit-or/2] + [bit::xor _.bit-xor/2] + ) + +(def: (bit::left-shift [subjectO paramO]) + Binary + (_.arithmetic-shift/2 (_.remainder/2 (_.int 64) paramO) + subjectO)) + +(def: (bit::arithmetic-right-shift [subjectO paramO]) + Binary + (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int 64)) (_.*/2 (_.int -1))) + subjectO)) + +(def: (bit::logical-right-shift [subjectO paramO]) + Binary + (runtime.bit//logical-right-shift (_.remainder/2 (_.int 64) paramO) subjectO)) + +(def: bundle::bit + Bundle + (<| (bundle.prefix "bit") + (|> bundle.empty + (bundle.install "and" (binary bit::and)) + (bundle.install "or" (binary bit::or)) + (bundle.install "xor" (binary bit::xor)) + (bundle.install "left-shift" (binary bit::left-shift)) + (bundle.install "logical-right-shift" (binary bit::logical-right-shift)) + (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift)) + ))) + +## [[Arrays]] +(def: (array::new size0) + Unary + (_.make-vector/2 size0 _.nil)) + +(def: (array::get [arrayO idxO]) + Binary + (runtime.array//get arrayO idxO)) + +(def: (array::put [arrayO idxO elemO]) + Trinary + (runtime.array//put arrayO idxO elemO)) + +(def: (array::remove [arrayO idxO]) + Binary + (runtime.array//put arrayO idxO _.nil)) + +(def: bundle::array + Bundle + (<| (bundle.prefix "array") + (|> bundle.empty + (bundle.install "new" (unary array::new)) + (bundle.install "get" (binary array::get)) + (bundle.install "put" (trinary array::put)) + (bundle.install "remove" (binary array::remove)) + (bundle.install "size" (unary _.vector-length/1)) + ))) + +## [[Numbers]] +(import: java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double)) + +(do-template [ ] + [(def: ( _) + Nullary + ( ))] + + [frac::smallest Double::MIN_VALUE _.float] + [frac::min (f/* -1.0 Double::MAX_VALUE) _.float] + [frac::max Double::MAX_VALUE _.float] + ) + +(do-template [ ] + [(def: ( [subjectO paramO]) + Binary + (|> subjectO ( paramO)))] + + [int::+ _.+/2] + [int::- _.-/2] + [int::* _.*/2] + [int::/ _.quotient/2] + [int::% _.remainder/2] + ) + +(do-template [ ] + [(def: ( [subjectO paramO]) + Binary + ( paramO subjectO))] + + [frac::+ _.+/2] + [frac::- _.-/2] + [frac::* _.*/2] + [frac::/ _.//2] + [frac::% _.mod/2] + [frac::= _.=/2] + [frac::< _. ] + [(def: ( [subjectO paramO]) + Binary + ( paramO subjectO))] + + [int::= _.=/2] + [int::< _.> _.integer->char/1 _.string/1)) + +(def: bundle::int + Bundle + (<| (bundle.prefix "int") + (|> 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 "to-frac" (unary (|>> (_.//2 (_.float 1.0))))) + (bundle.install "char" (unary int::char))))) + +(def: bundle::frac + Bundle + (<| (bundle.prefix "frac") + (|> bundle.empty + (bundle.install "+" (binary frac::+)) + (bundle.install "-" (binary frac::-)) + (bundle.install "*" (binary frac::*)) + (bundle.install "/" (binary frac::/)) + (bundle.install "%" (binary frac::%)) + (bundle.install "=" (binary frac::=)) + (bundle.install "<" (binary frac::<)) + (bundle.install "smallest" (nullary frac::smallest)) + (bundle.install "min" (nullary frac::min)) + (bundle.install "max" (nullary frac::max)) + (bundle.install "to-int" (unary _.exact/1)) + (bundle.install "encode" (unary _.number->string/1)) + (bundle.install "decode" (unary runtime.frac//decode))))) + +## [[Text]] +(def: (text::char [subjectO paramO]) + Binary + (_.string/1 (_.string-ref/2 subjectO paramO))) + +(def: (text::clip [subjectO startO endO]) + Trinary + (_.substring/3 subjectO startO endO)) + +(def: bundle::text + Bundle + (<| (bundle.prefix "text") + (|> bundle.empty + (bundle.install "=" (binary text::=)) + (bundle.install "<" (binary text::<)) + (bundle.install "concat" (binary (product.uncurry _.string-append/2))) + (bundle.install "size" (unary _.string-length/1)) + (bundle.install "char" (binary text::char)) + (bundle.install "clip" (trinary text::clip))))) + +## [[Math]] +(def: (math::pow [subject param]) + Binary + (_.expt/2 param subject)) + +(def: math-func + (-> Text Unary) + (|>> _.global _.apply/1)) + +(def: bundle::math + Bundle + (<| (bundle.prefix "math") + (|> bundle.empty + (bundle.install "cos" (unary (math-func "cos"))) + (bundle.install "sin" (unary (math-func "sin"))) + (bundle.install "tan" (unary (math-func "tan"))) + (bundle.install "acos" (unary (math-func "acos"))) + (bundle.install "asin" (unary (math-func "asin"))) + (bundle.install "atan" (unary (math-func "atan"))) + (bundle.install "exp" (unary (math-func "exp"))) + (bundle.install "log" (unary (math-func "log"))) + (bundle.install "ceil" (unary (math-func "ceiling"))) + (bundle.install "floor" (unary (math-func "floor"))) + (bundle.install "pow" (binary math::pow)) + ))) + +## [[IO]] +(def: (io::log input) + Unary + (_.begin (list (_.display/1 input) + _.newline/0))) + +(def: (void code) + (-> Expression Computation) + (_.begin (list code (_.string synthesis.unit)))) + +(def: bundle::io + Bundle + (<| (bundle.prefix "io") + (|> bundle.empty + (bundle.install "log" (unary (|>> io::log ..void))) + (bundle.install "error" (unary _.raise/1)) + (bundle.install "exit" (unary _.exit/1)) + (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit)))))))) + +## [[Atoms]] +(def: atom::new + Unary + (|>> (list) _.vector/*)) + +(def: (atom::read atom) + Unary + (_.vector-ref/2 atom (_.int 0))) + +(def: (atom::compare-and-swap [atomO oldO newO]) + Trinary + (runtime.atom//compare-and-swap atomO oldO newO)) + +(def: bundle::atom + Bundle + (<| (bundle.prefix "atom") + (|> bundle.empty + (bundle.install "new" (unary atom::new)) + (bundle.install "read" (unary atom::read)) + (bundle.install "compare-and-swap" (trinary atom::compare-and-swap))))) + +## [[Box]] +(def: (box::write [valueO boxO]) + Binary + (runtime.box//write valueO boxO)) + +(def: bundle::box + Bundle + (<| (bundle.prefix "box") + (|> bundle.empty + (bundle.install "new" (unary atom::new)) + (bundle.install "read" (unary atom::read)) + (bundle.install "write" (binary box::write))))) + +## [[Processes]] +(def: (process::parallelism-level []) + Nullary + (_.int 1)) + +(def: bundle::process + Bundle + (<| (bundle.prefix "process") + (|> bundle.empty + (bundle.install "parallelism-level" (nullary process::parallelism-level)) + (bundle.install "schedule" (binary (product.uncurry runtime.process//schedule))) + ))) + +## [Bundles] +(def: #export bundle + Bundle + (<| (bundle.prefix "lux") + (|> bundle::lux + (dict.merge bundle::bit) + (dict.merge bundle::int) + (dict.merge bundle::frac) + (dict.merge bundle::text) + (dict.merge bundle::array) + (dict.merge bundle::math) + (dict.merge bundle::io) + (dict.merge bundle::atom) + (dict.merge bundle::box) + (dict.merge bundle::process) + ))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/host.jvm.lux new file mode 100644 index 000000000..b8b2b7612 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/host.jvm.lux @@ -0,0 +1,11 @@ +(.module: + [lux #*] + [/// + [runtime (#+ Bundle)] + [/// + [extension + ["." bundle]]]]) + +(def: #export bundle + Bundle + bundle.empty) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/function.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/function.jvm.lux new file mode 100644 index 000000000..113f6b325 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/function.jvm.lux @@ -0,0 +1,92 @@ +(.module: + [lux (#- function) + [control + ["." monad (#+ do)] + pipe] + [data + ["." product] + [text + format] + [collection + ["." list ("list/." Functor)]]]] + [// + ["." runtime (#+ Operation Phase)] + ["." reference] + ["/." // + ["//." // ("operation/." Monad) + [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] + [synthesis (#+ Synthesis)] + [// + [reference (#+ Register Variable)] + ["." name] + [// + [host + ["_" scheme (#+ Expression Computation Var)]]]]]]]) + +(def: #export (apply translate [functionS argsS+]) + (-> Phase (Application Synthesis) (Operation Computation)) + (do ////.Monad + [functionO (translate functionS) + argsO+ (monad.map @ translate argsS+)] + (wrap (_.apply/* functionO argsO+)))) + +(def: (with-closure function-name inits function-definition) + (-> Text (List Expression) Computation (Operation Computation)) + (let [@closure (_.var (format function-name "___CLOSURE"))] + (operation/wrap + (case inits + #.Nil + function-definition + + _ + (_.letrec (list [@closure + (_.lambda [(|> (list.enumerate inits) + (list/map (|>> product.left reference.foreign'))) + #.None] + function-definition)]) + (_.apply/* @closure inits)))))) + +(def: @curried (_.var "curried")) +(def: @missing (_.var "missing")) + +(def: input + (|>> inc reference.local')) + +(def: #export (function translate [environment arity bodyS]) + (-> Phase (Abstraction Synthesis) (Operation Computation)) + (do ////.Monad + [[function-name bodyO] (///.with-context + (do @ + [function-name ///.context] + (///.with-anchor (_.var function-name) + (translate bodyS)))) + closureO+ (monad.map @ reference.variable environment) + #let [arityO (|> arity .int _.int) + @num-args (_.var "num_args") + @function (_.var function-name) + apply-poly (.function (_ args func) + (_.apply/2 (_.global "apply") func args))]] + (with-closure function-name closureO+ + (_.letrec (list [@function (_.lambda [(list) (#.Some @curried)] + (_.let (list [@num-args (_.length/1 @curried)]) + (<| (_.if (|> @num-args (_.=/2 arityO)) + (<| (_.let (list [(reference.local' +0) @function])) + (_.let-values (list [[(|> (list.n/range +0 (dec arity)) + (list/map ..input)) + #.None] + (_.apply/2 (_.global "apply") (_.global "values") @curried)])) + bodyO)) + (_.if (|> @num-args (_.>/2 arityO)) + (let [arity-args (runtime.slice (_.int 0) arityO @curried) + output-func-args (runtime.slice arityO + (|> @num-args (_.-/2 arityO)) + @curried)] + (|> @function + (apply-poly arity-args) + (apply-poly output-func-args)))) + ## (|> @num-args (_. @function + (apply-poly (_.append/2 @curried @missing)))))))]) + @function)) + )) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/loop.jvm.lux new file mode 100644 index 000000000..91757d291 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/loop.jvm.lux @@ -0,0 +1,41 @@ +(.module: + [lux (#- Scope) + [control + ["." monad (#+ do)]] + [data + ["." product] + ["." text + format] + [collection + ["." list ("list/." Functor)]]]] + [// + [runtime (#+ Operation Phase)] + ["." reference] + ["/." // + ["//." // + [synthesis (#+ Scope Synthesis)] + [/// + [host + ["_" scheme (#+ Computation Var)]]]]]]) + +(def: @scope (_.var "scope")) + +(def: #export (scope translate [start initsS+ bodyS]) + (-> Phase (Scope Synthesis) (Operation Computation)) + (do ////.Monad + [initsO+ (monad.map @ translate initsS+) + bodyO (///.with-anchor @scope + (translate bodyS))] + (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ + list.enumerate + (list/map (|>> product.left (n/+ start) reference.local'))) + #.None] + bodyO)]) + (_.apply/* @scope initsO+))))) + +(def: #export (recur translate argsS+) + (-> Phase (List Synthesis) (Operation Computation)) + (do ////.Monad + [@scope ///.anchor + argsO+ (monad.map @ translate argsS+)] + (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/primitive.jvm.lux new file mode 100644 index 000000000..c16c696c4 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/primitive.jvm.lux @@ -0,0 +1,25 @@ +(.module: + [lux (#- i64)] + [// + [runtime (#+ Operation)] + [// (#+ State) + [// ("operation/." Monad) + [/// + [host + ["_" scheme (#+ Expression)]]]]]]) + +(def: #export bit + (-> Bit (Operation Expression)) + (|>> _.bool operation/wrap)) + +(def: #export i64 + (-> (I64 Any) (Operation Expression)) + (|>> .int _.int operation/wrap)) + +(def: #export f64 + (-> Frac (Operation Expression)) + (|>> _.float operation/wrap)) + +(def: #export text + (-> Text (Operation Expression)) + (|>> _.string operation/wrap)) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux new file mode 100644 index 000000000..3fca5842f --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + [control + pipe] + [data + [text + format]]] + [// + [runtime (#+ Operation)] + [/// ("operation/." Monad) + [analysis (#+ Variant Tuple)] + [synthesis (#+ Synthesis)] + [// + ["." reference (#+ Register Variable Reference)] + ["." name] + [// + [host + ["_" scheme (#+ Expression Var)]]]]]]) + +(do-template [ ] + [(def: #export + (-> Register Var) + (|>> .int %i (format ) _.var))] + + [local' "l"] + [foreign' "f"] + ) + +(def: #export variable' + (-> Variable Var) + (|>> (case> (#reference.Local register) + (local' register) + + (#reference.Foreign register) + (foreign' register)))) + +(def: #export variable + (-> Variable (Operation Var)) + (|>> ..variable' + operation/wrap)) + +(def: #export constant' + (-> Ident Var) + (|>> name.definition _.var)) + +(def: #export constant + (-> Ident (Operation Var)) + (|>> constant' operation/wrap)) + +(def: #export reference' + (-> Reference Expression) + (|>> (case> (#reference.Constant value) + (..constant' value) + + (#reference.Variable value) + (..variable' value)))) + +(def: #export reference + (-> Reference (Operation Expression)) + (|>> reference' operation/wrap)) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux new file mode 100644 index 000000000..c67c2623f --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/runtime.jvm.lux @@ -0,0 +1,374 @@ +(.module: + [lux #* + [control + ["p" parser ("parser/." Monad)] + [monad (#+ do)]] + [data + [number (#+ hex)] + [text + format] + [collection + ["." list ("list/." Monad)]]] + ["." function] + [macro + ["." code] + ["s" syntax (#+ syntax:)]]] + ["." /// + ["//." // + [analysis (#+ Variant)] + ["." synthesis] + [// + ["." name] + [// + [host + ["_" scheme (#+ Expression Computation Var)]]]]]]) + +(do-template [ ] + [(type: #export + ( Var Expression Expression))] + + [Operation ///.Operation] + [Phase ///.Phase] + [Handler ///.Handler] + [Bundle ///.Bundle] + ) + +(def: prefix Text "LuxRuntime") + +(def: unit (_.string synthesis.unit)) + +(def: #export variant-tag "lux-variant") + +(def: (flag value) + (-> Bit Computation) + (if value + (_.string "") + _.nil)) + +(def: (variant' tag last? value) + (-> Expression Expression Expression Computation) + (<| (_.cons/2 (_.symbol ..variant-tag)) + (_.cons/2 tag) + (_.cons/2 last?) + value)) + +(def: #export (variant [lefts right? value]) + (-> (Variant Expression) Computation) + (variant' (_.int (.int lefts)) (flag right?) value)) + +(def: #export none + Computation + (variant [+0 #0 ..unit])) + +(def: #export some + (-> Expression Computation) + (|>> [+0 #1] ..variant)) + +(def: #export left + (-> Expression Computation) + (|>> [+0 #0] ..variant)) + +(def: #export right + (-> Expression Computation) + (|>> [+0 #1] ..variant)) + +(def: declaration + (s.Syntax [Text (List Text)]) + (p.either (p.seq s.local-symbol (parser/wrap (list))) + (s.form (p.seq s.local-symbol (p.some s.local-symbol))))) + +(syntax: (runtime: {[name args] declaration} + definition) + (let [implementation (code.local-symbol (format "@@" name)) + runtime (format prefix "__" (name.normalize name)) + @runtime (` (_.var (~ (code.text runtime)))) + argsC+ (list/map code.local-symbol args) + argsLC+ (list/map (|>> name.normalize (format "LRV__") code.text (~) (_.var) (`)) + args) + declaration (` ((~ (code.local-symbol name)) + (~+ argsC+))) + type (` (-> (~+ (list.repeat (list.size argsC+) (` _.Expression))) + _.Computation))] + (wrap (list (` (def: (~' #export) (~ declaration) + (~ type) + (~ (case argsC+ + #.Nil + @runtime + + _ + (` (_.apply/* (~ @runtime) (list (~+ argsC+)))))))) + (` (def: (~ implementation) + _.Computation + (~ (case argsC+ + #.Nil + (` (_.define (~ @runtime) [(list) #.None] (~ definition))) + + _ + (` (let [(~+ (|> (list.zip2 argsC+ argsLC+) + (list/map (function (_ [left right]) + (list left right))) + list/join))] + (_.define (~ @runtime) [(list (~+ argsLC+)) #.None] + (~ definition)))))))))))) + +(runtime: (slice offset length list) + (<| (_.if (_.null?/1 list) + list) + (_.if (|> offset (_.>/2 (_.int 0))) + (slice (|> offset (_.-/2 (_.int 1))) + length + (_.cdr/1 list))) + (_.if (|> length (_.>/2 (_.int 0))) + (_.cons/2 (_.car/1 list) + (slice offset + (|> length (_.-/2 (_.int 1))) + (_.cdr/1 list)))) + _.nil)) + +(syntax: #export (with-vars {vars (s.tuple (p.many s.local-symbol))} + body) + (wrap (list (` (let [(~+ (|> vars + (list/map (function (_ var) + (list (code.local-symbol var) + (` (_.var (~ (code.text (format "LRV__" (name.normalize var))))))))) + list/join))] + (~ body)))))) + +(runtime: (lux//try op) + (with-vars [error] + (_.with-exception-handler + (_.lambda [(list error) #.None] + (..left error)) + (_.lambda [(list) #.None] + (..right (_.apply/* op (list ..unit))))))) + +(runtime: (lux//program-args program-args) + (with-vars [@loop @input @output] + (_.letrec (list [@loop (_.lambda [(list @input @output) #.None] + (_.if (_.eqv?/2 _.nil @input) + @output + (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))]) + (_.apply/2 @loop (_.reverse/1 program-args) ..none)))) + +(def: runtime//lux + Computation + (_.begin (list @@lux//try + @@lux//program-args))) + +(def: minimum-index-length + (-> Expression Computation) + (|>> (_.+/2 (_.int 1)))) + +(def: product-element + (-> Expression Expression Computation) + (function.flip _.vector-ref/2)) + +(def: (product-tail product) + (-> Expression Computation) + (_.vector-ref/2 product (|> (_.length/1 product) (_.-/2 (_.int 1))))) + +(def: (updated-index min-length product) + (-> Expression Expression Computation) + (|> min-length (_.-/2 (_.length/1 product)))) + +(runtime: (product//left product index) + (let [@index_min_length (_.var "index_min_length")] + (_.begin + (list (_.define @index_min_length [(list) #.None] + (minimum-index-length index)) + (_.if (|> product _.length/1 (_.>/2 @index_min_length)) + ## No need for recursion + (product-element index product) + ## Needs recursion + (product//left (product-tail product) + (updated-index @index_min_length product))))))) + +(runtime: (product//right product index) + (let [@index_min_length (_.var "index_min_length") + @product_length (_.var "product_length") + @slice (_.var "slice") + last-element? (|> @product_length (_.=/2 @index_min_length)) + needs-recursion? (|> @product_length (_. @product_length (_.-/2 index)))) + (_.vector-copy!/5 @slice (_.int 0) product index @product_length) + @slice))))))) + +(runtime: (sum//get sum last? wanted-tag) + (with-vars [variant-tag sum-tag sum-flag sum-value] + (let [no-match _.nil + is-last? (|> sum-flag (_.eqv?/2 (_.string ""))) + test-recursion (_.if is-last? + ## Must recurse. + (sum//get sum-value + (|> wanted-tag (_.-/2 sum-tag)) + last?) + no-match)] + (<| (_.let-values (list [[(list variant-tag sum-tag sum-flag sum-value) #.None] + (_.apply/* (_.global "apply") (list (_.global "values") sum))])) + (_.if (|> wanted-tag (_.=/2 sum-tag)) + (_.if (|> sum-flag (_.eqv?/2 last?)) + sum-value + test-recursion)) + (_.if (|> wanted-tag (_.>/2 sum-tag)) + test-recursion) + (_.if (_.and (list (|> last? (_.eqv?/2 (_.string ""))) + (|> wanted-tag (_. sum-tag (_.-/2 wanted-tag)) sum-flag sum-value)) + no-match)))) + +(def: runtime//adt + Computation + (_.begin (list @@product//left + @@product//right + @@sum//get))) + +(runtime: (bit//logical-right-shift shift input) + (_.if (_.=/2 (_.int 0) shift) + input + (|> input + (_.arithmetic-shift/2 (_.*/2 (_.int -1) shift)) + (_.bit-and/2 (_.int (hex "7FFFFFFFFFFFFFFF")))))) + +(def: runtime//bit + Computation + (_.begin (list @@bit//logical-right-shift))) + +(runtime: (frac//decode input) + (with-vars [@output] + (_.let (list [@output ((_.apply/1 (_.global "string->number")) input)]) + (_.if (_.and (list (_.not/1 (_.=/2 @output @output)) + (_.not/1 (_.eqv?/2 (_.string "+nan.0") input)))) + ..none + (..some @output))))) + +(def: runtime//frac + Computation + (_.begin + (list @@frac//decode))) + +(def: (check-index-out-of-bounds array idx body) + (-> Expression Expression Expression Computation) + (_.if (|> idx (_.<=/2 (_.length/1 array))) + body + (_.raise/1 (_.string "Array index out of bounds!")))) + +(runtime: (array//get array idx) + (with-vars [@temp] + (<| (check-index-out-of-bounds array idx) + (_.let (list [@temp (_.vector-ref/2 array idx)]) + (_.if (|> @temp (_.eqv?/2 _.nil)) + ..none + (..some @temp)))))) + +(runtime: (array//put array idx value) + (<| (check-index-out-of-bounds array idx) + (_.begin + (list (_.vector-set!/3 array idx value) + array)))) + +(def: runtime//array + Computation + (_.begin + (list @@array//get + @@array//put))) + +(runtime: (atom//compare-and-swap atom old new) + (with-vars [@temp] + (_.let (list [@temp (_.vector-ref/2 atom (_.int 0))]) + (_.if (_.eq?/2 old @temp) + (_.begin + (list (_.vector-set!/3 atom (_.int 0) new) + (_.bool #1))) + (_.bool #0))))) + +(def: runtime//atom + Computation + @@atom//compare-and-swap) + +(runtime: (box//write value box) + (_.begin + (list + (_.vector-set!/3 box (_.int 0) value) + ..unit))) + +(def: runtime//box + Computation + (_.begin (list @@box//write))) + +(runtime: (io//current-time _) + (|> (_.apply/* (_.global "current-second") (list)) + (_.*/2 (_.int 1_000)) + _.exact/1)) + +(def: runtime//io + (_.begin (list @@io//current-time))) + +(def: process//incoming + Var + (_.var (name.normalize "process//incoming"))) + +(runtime: (process//loop _) + (_.when (_.not/1 (_.null?/1 process//incoming)) + (with-vars [queue process] + (_.let (list [queue process//incoming]) + (_.begin (list (_.set! process//incoming (_.list/* (list))) + (_.map/2 (_.lambda [(list process) #.None] + (_.apply/1 process ..unit)) + queue) + (process//loop ..unit))))))) + +(runtime: (process//schedule milli-seconds procedure) + (let [process//future (function (_ process) + (_.set! process//incoming (_.cons/2 process process//incoming)))] + (_.begin + (list + (_.if (_.=/2 (_.int 0) milli-seconds) + (process//future procedure) + (with-vars [@start @process @now @ignored] + (_.let (list [@start (io//current-time ..unit)]) + (_.letrec (list [@process (_.lambda [(list) (#.Some @ignored)] + (_.let (list [@now (io//current-time ..unit)]) + (_.if (|> @now (_.-/2 @start) (_.>=/2 milli-seconds)) + (_.apply/1 procedure ..unit) + (process//future @process))))]) + (process//future @process))))) + ..unit)))) + +(def: runtime//process + Computation + (_.begin (list (_.define process//incoming [(list) #.None] (_.list/* (list))) + @@process//loop + @@process//schedule))) + +(def: runtime + Computation + (_.begin (list @@slice + runtime//lux + runtime//bit + runtime//adt + runtime//frac + runtime//array + runtime//atom + runtime//box + runtime//io + runtime//process + ))) + +(def: #export translate + (Operation Any) + (///.with-buffer + (do ////.Monad + [_ (///.save! ["" ..prefix] ..runtime)] + (///.save-buffer! "")))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/structure.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/structure.jvm.lux new file mode 100644 index 000000000..3991ea281 --- /dev/null +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/structure.jvm.lux @@ -0,0 +1,33 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)]]] + [// + ["." runtime (#+ Operation Phase)] + ["." primitive] + ["." /// + [analysis (#+ Variant Tuple)] + ["." synthesis (#+ Synthesis)] + [/// + [host + ["_" scheme (#+ Expression)]]]]]) + +(def: #export (tuple translate elemsS+) + (-> Phase (Tuple Synthesis) (Operation Expression)) + (case elemsS+ + #.Nil + (primitive.text synthesis.unit) + + (#.Cons singletonS #.Nil) + (translate singletonS) + + _ + (do ///.Monad + [elemsT+ (monad.map @ translate elemsS+)] + (wrap (_.vector/* elemsT+))))) + +(def: #export (variant translate [lefts right? valueS]) + (-> Phase (Variant Synthesis) (Operation Expression)) + (do ///.Monad + [valueT (translate valueS)] + (wrap (runtime.variant [lefts right? valueT])))) diff --git a/stdlib/source/lux/compiler/default/reference.lux b/stdlib/source/lux/compiler/default/reference.lux new file mode 100644 index 000000000..84b838b3d --- /dev/null +++ b/stdlib/source/lux/compiler/default/reference.lux @@ -0,0 +1,67 @@ +(.module: + [lux #* + [control + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] + pipe]]) + +(type: #export Register Nat) + +(type: #export Variable + (#Local Register) + (#Foreign Register)) + +(type: #export Reference + (#Variable Variable) + (#Constant Ident)) + +(structure: #export _ (Equivalence Variable) + (def: (= reference sample) + (case [reference sample] + (^template [] + [( reference') ( sample')] + (n/= reference' sample')) + ([#Local] [#Foreign]) + + _ + #0))) + +(structure: #export _ (Hash Variable) + (def: eq Equivalence) + (def: (hash var) + (case var + (#Local register) + (n/* +1 register) + + (#Foreign register) + (n/* +2 register)))) + +(do-template [ ] + [(template: #export ( content) + (<| + + content))] + + [local #..Variable #..Local] + [foreign #..Variable #..Foreign] + ) + +(do-template [ ] + [(template: #export ( content) + (<| + content))] + + [variable #..Variable] + [constant #..Constant] + ) + +(def: #export self Reference (..local +0)) + +(def: #export self? + (-> Variable Bit) + (|>> ..variable + (case> (^ (..local +0)) + #1 + + _ + #0))) diff --git a/stdlib/source/lux/compiler/default/repl/type.lux b/stdlib/source/lux/compiler/default/repl/type.lux new file mode 100644 index 000000000..2af590c4b --- /dev/null +++ b/stdlib/source/lux/compiler/default/repl/type.lux @@ -0,0 +1,203 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)] + ["p" parser] + pipe] + [data + ["." error (#+ Error)] + [text + format] + [format + [xml (#+ XML)] + [json (#+ JSON)]] + [collection + ["." list]]] + [time + [instant (#+ Instant)] + [duration (#+ Duration)] + [date (#+ Date)]] + ["." function] + ["." type] + ["." macro + ["." code] + ["." poly (#+ Poly)]]]) + +(exception: #export (cannot-represent-value {type Type}) + (ex.report ["Type" (%type type)])) + +(type: Representation (-> Any Text)) + +(def: primitive-representation + (Poly Representation) + (`` ($_ p.either + (do p.Monad + [_ (poly.exactly Any)] + (wrap (function.constant "[]"))) + + (~~ (do-template [ ] + [(do p.Monad + [_ (poly.sub )] + (wrap (|>> (:coerce ) )))] + + [Bit %b] + [Nat %n] + [Int %i] + [Rev %r] + [Frac %f] + [Text %t]))))) + +(def: (special-representation representation) + (-> (Poly Representation) (Poly Representation)) + (`` ($_ p.either + (~~ (do-template [ ] + [(do p.Monad + [_ (poly.sub )] + (wrap (|>> (:coerce ) )))] + + [Type %type] + [Code %code] + [Instant %instant] + [Duration %duration] + [Date %date] + [JSON %json] + [XML %xml])) + + (do p.Monad + [[_ elemT] (poly.apply (p.seq (poly.exactly List) poly.any)) + elemR (poly.local (list elemT) representation)] + (wrap (|>> (:coerce (List Any)) (%list elemR)))) + + (do p.Monad + [[_ elemT] (poly.apply (p.seq (poly.exactly Maybe) poly.any)) + elemR (poly.local (list elemT) representation)] + (wrap (|>> (:coerce (Maybe Any)) + (case> #.None + "#.None" + + (#.Some elemV) + (format "(#.Some " (elemR elemV) ")")))))))) + +(def: (record-representation tags representation) + (-> (List Ident) (Poly Representation) (Poly Representation)) + (do p.Monad + [membersR+ (poly.tuple (p.many representation)) + _ (p.assert "Number of tags does not match record type size." + (n/= (list.size tags) (list.size membersR+)))] + (wrap (function (_ recordV) + (let [record-body (loop [pairs-left (list.zip2 tags membersR+) + recordV recordV] + (case pairs-left + #.Nil + "" + + (#.Cons [tag repr] #.Nil) + (format (%code (code.tag tag)) " " (repr recordV)) + + (#.Cons [tag repr] tail) + (let [[leftV rightV] (:coerce [Any Any] recordV)] + (format (%code (code.tag tag)) " " (repr leftV) " " + (recur tail rightV)))))] + (format "{" record-body "}")))))) + +(def: (variant-representation tags representation) + (-> (List Ident) (Poly Representation) (Poly Representation)) + (do p.Monad + [casesR+ (poly.variant (p.many representation)) + #let [num-tags (list.size tags)] + _ (p.assert "Number of tags does not match variant type size." + (n/= num-tags (list.size casesR+)))] + (wrap (function (_ variantV) + (loop [cases-left (list.zip3 tags + (list.n/range +0 (dec num-tags)) + casesR+) + variantV variantV] + (case cases-left + #.Nil + "" + + (#.Cons [tag-name tag-idx repr] #.Nil) + (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] + (if (n/= tag-idx _tag) + (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") + (undefined))) + + (#.Cons [tag-name tag-idx repr] tail) + (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] + (if (n/= tag-idx _tag) + (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") + (recur tail variantV))))))))) + +(def: (tagged-representation compiler representation) + (-> Lux (Poly Representation) (Poly Representation)) + (do p.Monad + [[name anonymous] poly.named] + (case (macro.run compiler (macro.tags-of name)) + (#error.Success ?tags) + (case ?tags + (#.Some tags) + (poly.local (list anonymous) + (p.either (record-representation tags representation) + (variant-representation tags representation))) + + #.None + representation) + + (#error.Error error) + (p.fail error)))) + +(def: (tuple-representation representation) + (-> (Poly Representation) (Poly Representation)) + (do p.Monad + [membersR+ (poly.tuple (p.many representation))] + (wrap (function (_ tupleV) + (let [tuple-body (loop [representations membersR+ + tupleV tupleV] + (case representations + #.Nil + "" + + (#.Cons lastR #.Nil) + (lastR tupleV) + + (#.Cons headR tailR) + (let [[leftV rightV] (:coerce [Any Any] tupleV)] + (format (headR leftV) " " (recur tailR rightV)))))] + (format "[" tuple-body "]")))))) + +(def: (representation compiler) + (-> Lux (Poly Representation)) + (p.rec + (function (_ representation) + ($_ p.either + primitive-representation + (special-representation representation) + (tagged-representation compiler representation) + (tuple-representation representation) + + (do p.Monad + [[funcT inputsT+] (poly.apply (p.seq poly.any (p.many poly.any)))] + (case (type.apply inputsT+ funcT) + (#.Some outputT) + (poly.local (list outputT) representation) + + #.None + (p.fail ""))) + + (do p.Monad + [[name anonymous] poly.named] + (poly.local (list anonymous) representation)) + + (p.fail "") + )))) + +(def: #export (represent compiler type value) + (-> Lux Type Any Text) + (case (poly.run type (representation compiler)) + (#error.Success representation) + (ex.report ["Type" (%type type)] + ["Value" (representation value)]) + + (#error.Error error) + (ex.construct cannot-represent-value [type]))) diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux new file mode 100644 index 000000000..41c11ee2d --- /dev/null +++ b/stdlib/source/lux/compiler/default/syntax.lux @@ -0,0 +1,629 @@ +## This is LuxC's parser. +## It takes the source code of a Lux file in raw text form and +## extracts the syntactic structure of the code from it. +## It only produces Lux Code nodes, and thus removes any white-space +## and comments while processing its inputs. + +## Another important aspect of the parser is that it keeps track of +## its position within the input data. +## That is, the parser takes into account the line and column +## information in the input text (it doesn't really touch the +## file-name aspect of the cursor, leaving it intact in whatever +## base-line cursor it is given). + +## This particular piece of functionality is not located in one +## function, but it is instead scattered throughout several parsers, +## since the logic for how to update the cursor varies, depending on +## what is being parsed, and the rules involved. + +## You will notice that several parsers have a "where" parameter, that +## tells them the cursor position prior to the parser being run. +## They are supposed to produce some parsed output, alongside an +## updated cursor pointing to the end position, after the parser was run. + +## Lux Code nodes/tokens are annotated with cursor meta-data +## (file-name, line, column) to keep track of their provenance and +## location, which is helpful for documentation and debugging. +(.module: + [lux (#- nat int rev) + [control + monad + ["p" parser ("parser/." Monad)] + ["ex" exception (#+ exception:)]] + [data + ["e" error] + ["." number] + ["." product] + ["." maybe] + ["." text + ["l" lexer] + format] + [collection + ["." row (#+ Row)] + ["dict" dictionary (#+ Dictionary)]]]]) + +(type: #export Aliases (Dictionary Text Text)) + +(def: white-space Text "\t\v \r\f") +(def: new-line Text "\n") + +## This is the parser for white-space. +## Whenever a new-line is encountered, the column gets reset to 0, and +## the line gets incremented. +## It operates recursively in order to produce the longest continuous +## chunk of white-space. +(def: (space^ where) + (-> Cursor (l.Lexer [Cursor Text])) + (p.either (do p.Monad + [content (l.many (l.one-of white-space))] + (wrap [(update@ #.column (n/+ (text.size content)) where) + content])) + ## New-lines must be handled as a separate case to ensure line + ## information is handled properly. + (do p.Monad + [content (l.many (l.one-of new-line))] + (wrap [(|> where + (update@ #.line (n/+ (text.size content))) + (set@ #.column +0)) + content])) + )) + +## Single-line comments can start anywhere, but only go up to the +## next new-line. +(def: (single-line-comment^ where) + (-> Cursor (l.Lexer [Cursor Text])) + (do p.Monad + [_ (l.this "##") + comment (l.some (l.none-of new-line)) + _ (l.this new-line)] + (wrap [(|> where + (update@ #.line inc) + (set@ #.column +0)) + comment]))) + +## This is just a helper parser to find text which doesn't run into +## any special character sequences for multi-line comments. +(def: comment-bound^ + (l.Lexer Any) + ($_ p.either + (l.this new-line) + (l.this ")#") + (l.this "#("))) + +## Multi-line comments are bounded by #( these delimiters, #(and, they may +## also be nested)# )#. +## Multi-line comment syntax must be balanced. +## That is, any nested comment must have matched delimiters. +## Unbalanced comments ought to be rejected as invalid code. +(def: (multi-line-comment^ where) + (-> Cursor (l.Lexer [Cursor Text])) + (do p.Monad + [_ (l.this "#(")] + (loop [comment "" + where (update@ #.column (n/+ +2) where)] + ($_ p.either + ## These are normal chunks of commented text. + (do @ + [chunk (l.many (l.not comment-bound^))] + (recur (format comment chunk) + (|> where + (update@ #.column (n/+ (text.size chunk)))))) + ## This is a special rule to handle new-lines within + ## comments properly. + (do @ + [_ (l.this new-line)] + (recur (format comment new-line) + (|> where + (update@ #.line inc) + (set@ #.column +0)))) + ## This is the rule for handling nested sub-comments. + ## Ultimately, the whole comment is just treated as text + ## (the comment must respect the syntax structure, but the + ## output produced is just a block of text). + ## That is why the sub-comment is covered in delimiters + ## and then appended to the rest of the comment text. + (do @ + [[sub-where sub-comment] (multi-line-comment^ where)] + (recur (format comment "#(" sub-comment ")#") + sub-where)) + ## Finally, this is the rule for closing the comment. + (do @ + [_ (l.this ")#")] + (wrap [(update@ #.column (n/+ +2) where) + comment])) + )))) + +## This is the only parser that should be used directly by other +## parsers, since all comments must be treated as either being +## single-line or multi-line. +## That is, there is no syntactic rule prohibiting one type of comment +## from being used in any situation (alternatively, forcing one type +## of comment to be the only usable one). +(def: (comment^ where) + (-> Cursor (l.Lexer [Cursor Text])) + (p.either (single-line-comment^ where) + (multi-line-comment^ where))) + +## To simplify parsing, I remove any left-padding that an Code token +## may have prior to parsing the token itself. +## Left-padding is assumed to be either white-space or a comment. +## The cursor gets updated, but the padding gets ignored. +(def: (left-padding^ where) + (-> Cursor (l.Lexer Cursor)) + ($_ p.either + (do p.Monad + [[where comment] (comment^ where)] + (left-padding^ where)) + (do p.Monad + [[where white-space] (space^ where)] + (left-padding^ where)) + (:: p.Monad wrap where))) + +## Escaped character sequences follow the usual syntax of +## back-slash followed by a letter (e.g. \n). +## Unicode escapes are possible, with hexadecimal sequences between 1 +## and 4 characters long (e.g. \u12aB). +## Escaped characters may show up in Char and Text literals. +(def: escaped-char^ + (l.Lexer [Nat Text]) + (p.after (l.this "\\") + (do p.Monad + [code l.any] + (case code + ## Handle special cases. + "t" (wrap [+2 "\t"]) + "v" (wrap [+2 "\v"]) + "b" (wrap [+2 "\b"]) + "n" (wrap [+2 "\n"]) + "r" (wrap [+2 "\r"]) + "f" (wrap [+2 "\f"]) + "\"" (wrap [+2 "\""]) + "\\" (wrap [+2 "\\"]) + + ## Handle unicode escapes. + "u" + (do p.Monad + [code (l.between +1 +4 l.hexadecimal)] + (wrap (case (|> code (format "+") (:: number.Hex@Codec decode)) + (#.Right value) + [(n/+ +2 (text.size code)) (text.from-code value)] + + _ + (undefined)))) + + _ + (p.fail (format "Invalid escaping syntax: " (%t code))))))) + +## These are very simple parsers that just cut chunks of text in +## specific shapes and then use decoders already present in the +## standard library to actually produce the values from the literals. +(def: rich-digit + (l.Lexer Text) + (p.either l.decimal + (p.after (l.this "_") (parser/wrap "")))) + +(def: rich-digits^ + (l.Lexer Text) + (l.seq l.decimal + (l.some rich-digit))) + +(do-template [ ] + [(def: #export ( where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [chunk ] + (case (:: decode chunk) + (#.Left error) + (p.fail error) + + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where ( value)]]))))] + + [int #.Int + (l.seq (p.default "" (l.one-of "-")) + rich-digits^) + number.Codec] + + [rev #.Rev + (l.seq (l.one-of ".") + rich-digits^) + number.Codec] + ) + +(def: (nat-char where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [_ (l.this "#\"") + [where' char] (: (l.Lexer [Cursor Text]) + ($_ p.either + ## Normal text characters. + (do @ + [normal (l.none-of "\\\"\n")] + (wrap [(|> where + (update@ #.column inc)) + normal])) + ## Must handle escaped + ## chars separately. + (do @ + [[chars-consumed char] escaped-char^] + (wrap [(|> where + (update@ #.column (n/+ chars-consumed))) + char])))) + _ (l.this "\"") + #let [char (maybe.assume (text.nth +0 char))]] + (wrap [(|> where' + (update@ #.column inc)) + [where (#.Nat char)]]))) + +(def: (normal-nat where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [chunk (l.seq (l.one-of "+") + rich-digits^)] + (case (:: number.Codec decode chunk) + (#.Left error) + (p.fail error) + + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Nat value)]])))) + +(def: #export (nat where) + (-> Cursor (l.Lexer [Cursor Code])) + (p.either (normal-nat where) + (nat-char where))) + +(def: (normal-frac where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [chunk ($_ l.seq + (p.default "" (l.one-of "-")) + rich-digits^ + (l.one-of ".") + rich-digits^ + (p.default "" + ($_ l.seq + (l.one-of "eE") + (p.default "" (l.one-of "+-")) + rich-digits^)))] + (case (:: number.Codec decode chunk) + (#.Left error) + (p.fail error) + + (#.Right value) + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Frac value)]])))) + +(def: frac-ratio-fragment + (l.Lexer Frac) + (<| (p.codec number.Codec) + (:: p.Monad map (function (_ digits) + (format digits ".0"))) + rich-digits^)) + +(def: (ratio-frac where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [chunk ($_ l.seq + (p.default "" (l.one-of "-")) + rich-digits^ + (l.one-of "/") + rich-digits^) + value (l.local chunk + (do @ + [signed? (l.this? "-") + numerator frac-ratio-fragment + _ (l.this? "/") + denominator frac-ratio-fragment + _ (p.assert "Denominator cannot be 0." + (not (f/= 0.0 denominator)))] + (wrap (|> numerator + (f/* (if signed? -1.0 1.0)) + (f// denominator)))))] + (wrap [(update@ #.column (n/+ (text.size chunk)) where) + [where (#.Frac value)]]))) + +(def: #export (frac where) + (-> Cursor (l.Lexer [Cursor Code])) + (p.either (normal-frac where) + (ratio-frac where))) + +## This parser looks so complex because text in Lux can be multi-line +## and there are rules regarding how this is handled. +(def: #export (text where) + (-> Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [## Lux text "is delimited by double-quotes", as usual in most + ## programming languages. + _ (l.this "\"") + ## I must know what column the text body starts at (which is + ## always 1 column after the left-delimiting quote). + ## This is important because, when procesing subsequent lines, + ## they must all start at the same column, being left-padded with + ## as many spaces as necessary to be column-aligned. + ## This helps ensure that the formatting on the text in the + ## source-code matches the formatting of the Text value. + #let [offset-column (inc (get@ #.column where))] + [where' text-read] (: (l.Lexer [Cursor Text]) + ## I must keep track of how much of the + ## text body has been read, how far the + ## cursor has progressed, and whether I'm + ## processing a subsequent line, or just + ## processing normal text body. + (loop [text-read "" + where (|> where + (update@ #.column inc)) + must-have-offset? #0] + (p.either (if must-have-offset? + ## If I'm at the start of a + ## new line, I must ensure the + ## space-offset is at least + ## as great as the column of + ## the text's body's column, + ## to ensure they are aligned. + (do @ + [offset (l.many (l.one-of " ")) + #let [offset-size (text.size offset)]] + (if (n/>= offset-column offset-size) + ## Any extra offset + ## becomes part of the + ## text's body. + (recur (|> offset + (text.split offset-column) + (maybe.default (undefined)) + product.right + (format text-read)) + (|> where + (update@ #.column (n/+ offset-size))) + #0) + (p.fail (format "Each line of a multi-line text must have an appropriate offset!\n" + "Expected: " (%i (.int offset-column)) " columns.\n" + " Actual: " (%i (.int offset-size)) " columns.\n")))) + ($_ p.either + ## Normal text characters. + (do @ + [normal (l.many (l.none-of "\\\"\n"))] + (recur (format text-read normal) + (|> where + (update@ #.column (n/+ (text.size normal)))) + #0)) + ## Must handle escaped + ## chars separately. + (do @ + [[chars-consumed char] escaped-char^] + (recur (format text-read char) + (|> where + (update@ #.column (n/+ chars-consumed))) + #0)) + ## The text ends when it + ## reaches the right-delimiter. + (do @ + [_ (l.this "\"")] + (wrap [(update@ #.column inc where) + text-read])))) + ## If a new-line is + ## encountered, it gets + ## appended to the value and + ## the loop is alerted that the + ## next line must have an offset. + (do @ + [_ (l.this new-line)] + (recur (format text-read new-line) + (|> where + (update@ #.line inc) + (set@ #.column +0)) + #1)))))] + (wrap [where' + [where (#.Text text-read)]]))) + +## Form and tuple syntax is mostly the same, differing only in the +## delimiters involved. +## They may have an arbitrary number of arbitrary Code nodes as elements. +(do-template [ ] + [(def: ( where ast) + (-> Cursor + (-> Cursor (l.Lexer [Cursor Code])) + (l.Lexer [Cursor Code])) + (do p.Monad + [_ (l.this ) + [where' elems] (loop [elems (: (Row Code) + row.empty) + where where] + (p.either (do @ + [## Must update the cursor as I + ## go along, to keep things accurate. + [where' elem] (ast where)] + (recur (row.add elem elems) + where')) + (do @ + [## Must take into account any + ## padding present before the + ## end-delimiter. + where' (left-padding^ where) + _ (l.this )] + (wrap [(update@ #.column inc where') + (row.to-list elems)]))))] + (wrap [where' + [where ( elems)]])))] + + [form #.Form "(" ")"] + [tuple #.Tuple "[" "]"] + ) + +## Records are almost (syntactically) the same as forms and tuples, +## with the exception that their elements must come in pairs (as in +## key-value pairs). +## Semantically, though, records and tuples are just 2 different +## representations for the same thing (a tuple). +## In normal Lux syntax, the key position in the pair will be a tag +## Code node, however, record Code nodes allow any Code node to occupy +## this position, since it may be useful when processing Code syntax in +## macros. +(def: (record where ast) + (-> Cursor + (-> Cursor (l.Lexer [Cursor Code])) + (l.Lexer [Cursor Code])) + (do p.Monad + [_ (l.this "{") + [where' elems] (loop [elems (: (Row [Code Code]) + row.empty) + where where] + (p.either (do @ + [[where' key] (ast where) + [where' val] (ast where')] + (recur (row.add [key val] elems) + where')) + (do @ + [where' (left-padding^ where) + _ (l.this "}")] + (wrap [(update@ #.column inc where') + (row.to-list elems)]))))] + (wrap [where' + [where (#.Record elems)]]))) + +## The parts of an identifier are separated by a single mark. +## E.g. module.name. +## Only one such mark may be used in an identifier, since there +## can only be 2 parts to an identifier (the module [before the +## mark], and the name [after the mark]). +## There are also some extra rules regarding identifier syntax, +## encoded on the parser. +(def: identifier-separator Text ".") + +## A Lux identifier is a pair of chunks of text, where the first-part +## refers to the module that gives context to the identifier, and the +## second part corresponds to the name of the identifier itself. +## The module part may be absent (by being the empty text ""), but the +## name part must always be present. +## The rules for which characters you may use are specified in terms +## of which characters you must avoid (to keep things as open-ended as +## possible). +## In particular, no white-space can be used, and neither can other +## characters which are already used by Lux as delimiters for other +## Code nodes (thereby reducing ambiguity while parsing). +## Additionally, the first character in an identifier's part cannot be +## a digit, to avoid confusion with regards to numbers. +(def: ident-part^ + (l.Lexer Text) + (do p.Monad + [#let [digits "0123456789" + delimiters (format "()[]{}#\"" identifier-separator) + space (format white-space new-line) + head-lexer (l.none-of (format digits delimiters space)) + tail-lexer (l.some (l.none-of (format delimiters space)))] + head head-lexer + tail tail-lexer] + (wrap (format head tail)))) + +(def: current-module-mark Text (format identifier-separator identifier-separator)) + +(def: (ident^ current-module aliases) + (-> Text Aliases (l.Lexer [Ident Nat])) + ($_ p.either + ## When an identifier starts with 2 marks, its module is + ## taken to be the current-module being compiled at the moment. + ## This can be useful when mentioning identifiers and tags + ## inside quoted/templated code in macros. + (do p.Monad + [_ (l.this current-module-mark) + def-name ident-part^] + (wrap [[current-module def-name] + (n/+ +2 (text.size def-name))])) + ## If the identifier is prefixed by the mark, but no module + ## part, the module is assumed to be "lux" (otherwise known as + ## the 'prelude'). + ## This makes it easy to refer to definitions in that module, + ## since it is the most fundamental module in the entire + ## standard library. + (do p.Monad + [_ (l.this identifier-separator) + def-name ident-part^] + (wrap [["lux" def-name] + (inc (text.size def-name))])) + ## Not all identifiers must be specified with a module part. + ## If that part is not provided, the identifier will be created + ## with the empty "" text as the module. + ## During program analysis, such identifiers tend to be treated + ## as if their context is the current-module, but this only + ## applies to identifiers for tags and module definitions. + ## Function arguments and local-variables may not be referred-to + ## using identifiers with module parts, so being able to specify + ## identifiers with empty modules helps with those use-cases. + (do p.Monad + [first-part ident-part^] + (p.either (do @ + [_ (l.this identifier-separator) + second-part ident-part^] + (wrap [[(|> aliases (dict.get first-part) (maybe.default first-part)) + second-part] + ($_ n/+ + (text.size first-part) + +1 + (text.size second-part))])) + (wrap [["" first-part] + (text.size first-part)]))))) + +(def: #export (tag current-module aliases where) + (-> Text Aliases Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [[value length] (p.after (l.this "#") + (ident^ current-module aliases))] + (wrap [(update@ #.column (|>> ($_ n/+ +1 length)) where) + [where (#.Tag value)]]))) + +(def: #export (symbol current-module aliases where) + (-> Text Aliases Cursor (l.Lexer [Cursor Code])) + (do p.Monad + [[value length] (ident^ current-module aliases)] + (wrap [(update@ #.column (|>> (n/+ length)) where) + [where (case value + (^template [ ] + ["" ] + (#.Bit )) + (["#0" #0] + ["#1" #1]) + + _ + (#.Symbol value))]]))) + +(exception: #export (end-of-file {module Text}) + module) + +(exception: #export (unrecognized-input {[file line column] Cursor}) + (ex.report ["File" file] + ["Line" (%n line)] + ["Column" (%n column)])) + +(def: (ast current-module aliases) + (-> Text Aliases Cursor (l.Lexer [Cursor Code])) + (: (-> Cursor (l.Lexer [Cursor Code])) + (function (ast' where) + (do p.Monad + [where (left-padding^ where)] + ($_ p.either + (form where ast') + (tuple where ast') + (record where ast') + (nat where) + (frac where) + (int where) + (rev where) + (symbol current-module aliases where) + (tag current-module aliases where) + (text where) + (do @ + [end? l.end?] + (if end? + (p.fail (ex.construct end-of-file current-module)) + (p.fail (ex.construct unrecognized-input where)))) + ))))) + +(def: #export (read current-module aliases [where offset source]) + (-> Text Aliases Source (e.Error [Source Code])) + (case (p.run [offset source] (ast current-module aliases where)) + (#e.Error error) + (#e.Error error) + + (#e.Success [[offset' remaining] [where' output]]) + (#e.Success [[where' offset' remaining] output]))) diff --git a/stdlib/source/lux/compiler/host.lux b/stdlib/source/lux/compiler/host.lux new file mode 100644 index 000000000..218de67a4 --- /dev/null +++ b/stdlib/source/lux/compiler/host.lux @@ -0,0 +1,18 @@ +(.module: + lux) + +(type: #export Host Text) + +(do-template [ ] + [(def: #export Host )] + + [common-lisp "Common Lisp"] + [js "JavaScript"] + [jvm "JVM"] + [lua "Lua"] + [php "PHP"] + [python "Python"] + [r "R"] + [ruby "Ruby"] + [scheme "Scheme"] + ) diff --git a/stdlib/source/lux/compiler/host/scheme.lux b/stdlib/source/lux/compiler/host/scheme.lux new file mode 100644 index 000000000..8d5cbdbcd --- /dev/null +++ b/stdlib/source/lux/compiler/host/scheme.lux @@ -0,0 +1,306 @@ +(.module: + [lux (#- Code' Code int or and if function cond when let) + [control + pipe] + [data + ["." number] + ["." text + format] + [collection + ["." list ("list/." Functor Fold)]]] + [type + abstract]]) + +(abstract: Global' {} Any) +(abstract: Var' {} Any) +(abstract: Computation' {} Any) +(abstract: (Expression' k) {} Any) + +(abstract: (Code' k) + {} + + Text + + (type: #export Code (Ex [k] (Code' k))) + (type: #export Expression (Code' (Ex [k] (Expression' k)))) + (type: #export Global (Code' (Expression' Global'))) + (type: #export Computation (Code' (Expression' Computation'))) + (type: #export Var (Code' (Expression' Var'))) + + (type: #export Arguments + {#mandatory (List Var) + #rest (Maybe Var)}) + + (def: #export code (-> Code Text) (|>> :representation)) + + (def: #export var (-> Text Var) (|>> :abstraction)) + + (def: (arguments [vars rest]) + (-> Arguments Code) + (case rest + (#.Some rest) + (case vars + #.Nil + rest + + _ + (|> (format " . " (:representation rest)) + (format (|> vars + (list/map ..code) + (text.join-with " "))) + (text.enclose ["(" ")"]) + :abstraction)) + + #.None + (|> vars + (list/map ..code) + (text.join-with " ") + (text.enclose ["(" ")"]) + :abstraction))) + + (def: #export nil + Computation + (:abstraction "'()")) + + (def: #export bool + (-> Bit Computation) + (|>> (case> #0 "#f" + #1 "#t") + :abstraction)) + + (def: #export int + (-> Int Computation) + (|>> %i :abstraction)) + + (def: #export float + (-> Frac Computation) + (|>> (cond> [(f/= number.positive-infinity)] + [(new> "+inf.0")] + + [(f/= number.negative-infinity)] + [(new> "-inf.0")] + + [number.not-a-number?] + [(new> "+nan.0")] + + ## else + [%f]) + :abstraction)) + + (def: #export positive-infinity Computation (..float number.positive-infinity)) + (def: #export negative-infinity Computation (..float number.negative-infinity)) + (def: #export not-a-number Computation (..float number.not-a-number)) + + (def: #export string + (-> Text Computation) + (|>> %t :abstraction)) + + (def: #export symbol + (-> Text Computation) + (|>> (format "'") :abstraction)) + + (def: #export global + (-> Text Global) + (|>> :abstraction)) + + (def: form + (-> (List Code) Text) + (|>> (list/map ..code) + (text.join-with " ") + (text.enclose ["(" ")"]))) + + (def: #export (apply/* func args) + (-> Expression (List Expression) Computation) + (:abstraction (..form (#.Cons func args)))) + + (do-template [ ] + [(def: #export + (-> (List Expression) Computation) + (apply/* (..global )))] + + [vector/* "vector"] + [list/* "list"] + ) + + (def: #export (apply/0 func) + (-> Expression Computation) + (..apply/* func (list))) + + (do-template [ ] + [(def: #export (apply/0 (..global )))] + + [newline/0 "newline"] + ) + + (def: #export (apply/1 func) + (-> Expression (-> Expression Computation)) + (|>> (list) (..apply/* func))) + + (do-template [ ] + [(def: #export (apply/1 (..global )))] + + [exact/1 "exact"] + [integer->char/1 "integer->char"] + [number->string/1 "number->string"] + [string/1 "string"] + [length/1 "length"] + [values/1 "values"] + [null?/1 "null?"] + [car/1 "car"] + [cdr/1 "cdr"] + [raise/1 "raise"] + [error-object-message/1 "error-object-message"] + [make-vector/1 "make-vector"] + [vector-length/1 "vector-length"] + [not/1 "not"] + [string-length/1 "string-length"] + [string-hash/1 "string-hash"] + [reverse/1 "reverse"] + [display/1 "display"] + [exit/1 "exit"] + ) + + (def: #export (apply/2 func) + (-> Expression (-> Expression Expression Computation)) + (.function (_ _0 _1) + (..apply/* func (list _0 _1)))) + + (do-template [ ] + [(def: #export (apply/2 (..global )))] + + [append/2 "append"] + [cons/2 "cons"] + [make-vector/2 "make-vector"] + [vector-ref/2 "vector-ref"] + [list-tail/2 "list-tail"] + [map/2 "map"] + [string-ref/2 "string-ref"] + [string-append/2 "string-append"] + ) + + (do-template [ ] + [(def: #export ( param subject) + (-> Expression Expression Computation) + (..apply/2 (..global ) subject param))] + + [=/2 "="] + [eq?/2 "eq?"] + [eqv?/2 "eqv?"] + [/2 ">"] + [>=/2 ">="] + [string=?/2 "string=?"] + [string Expression (-> Expression Expression Expression Computation)) + (.function (_ _0 _1 _2) + (..apply/* func (list _0 _1 _2)))) + + (do-template [ ] + [(def: #export (apply/3 (..global )))] + + [substring/3 "substring"] + [vector-set!/3 "vector-set!"] + ) + + (def: #export (vector-copy!/5 _0 _1 _2 _3 _4) + (-> Expression Expression Expression Expression Expression + Computation) + (..apply/* (..global "vector-copy!") + (list _0 _1 _2 _3 _4))) + + (do-template [ ] + [(def: #export + (-> (List Expression) Computation) + (|>> (list& (..global )) ..form :abstraction))] + + [or "or"] + [and "and"] + ) + + (do-template [ 
]
+    [(def: #export ( bindings body)
+       (-> (List [ Expression]) Expression Computation)
+       (:abstraction
+        (..form (list (..global )
+                      (|> bindings
+                          (list/map (.function (_ [binding/name binding/value])
+                                      (:abstraction
+                                       (..form (list (
 binding/name)
+                                                     binding/value)))))
+                          ..form
+                          :abstraction)
+                      body))))]
+
+    [let           "let"           Var       .id]
+    [let*          "let*"          Var       .id]
+    [letrec        "letrec"        Var       .id]
+    [let-values    "let-values"    Arguments ..arguments]
+    [let*-values   "let*-values"   Arguments ..arguments]
+    [letrec-values "letrec-values" Arguments ..arguments]
+    )
+
+  (def: #export (if test then else)
+    (-> Expression Expression Expression Computation)
+    (:abstraction
+     (..form (list (..global "if") test then else))))
+
+  (def: #export (when test then)
+    (-> Expression Expression Computation)
+    (:abstraction
+     (..form (list (..global "when") test then))))
+
+  (def: #export (cond clauses else)
+    (-> (List [Expression Expression]) Expression Computation)
+    (|> (list/fold (.function (_ [test then] next)
+                     (if test then next))
+                   else
+                   (list.reverse clauses))
+        :representation
+        :abstraction))
+
+  (def: #export (lambda arguments body)
+    (-> Arguments Expression Computation)
+    (:abstraction
+     (..form (list (..global "lambda")
+                   (..arguments arguments)
+                   body))))
+
+  (def: #export (define name arguments body)
+    (-> Var Arguments Expression Computation)
+    (:abstraction
+     (..form (list (..global "define")
+                   (|> arguments
+                       (update@ #mandatory (|>> (#.Cons name)))
+                       ..arguments)
+                   body))))
+
+  (def: #export begin
+    (-> (List Expression) Computation)
+    (|>> (#.Cons (..global "begin")) ..form :abstraction))
+
+  (def: #export (set! name value)
+    (-> Var Expression Computation)
+    (:abstraction
+     (..form (list (..global "set!") name value))))
+
+  (def: #export (with-exception-handler handler body)
+    (-> Expression Expression Computation)
+    (:abstraction
+     (..form (list (..global "with-exception-handler") handler body))))
+  )
diff --git a/stdlib/source/lux/compiler/meta/archive.lux b/stdlib/source/lux/compiler/meta/archive.lux
new file mode 100644
index 000000000..ee31e65d9
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/archive.lux
@@ -0,0 +1,122 @@
+(.module:
+  [lux #*
+   [control
+    ["ex" exception (#+ exception:)]
+    ["." equivalence (#+ Equivalence)]
+    ["." monad (#+ do)]]
+   [data
+    ["." error (#+ Error)]
+    ["." ident]
+    ["." text
+     format]
+    [collection
+     ["dict" dictionary (#+ Dictionary)]]]
+   [type (#+ :share)
+    abstract]
+   [world
+    [file (#+ File)]]]
+  [///
+   ["." default (#+ Version)]])
+
+## Key
+(type: #export Signature
+  {#name Ident
+   #version Version})
+
+(def: Equivalence
+  (Equivalence Signature)
+  (equivalence.product ident.Equivalence text.Equivalence))
+
+(def: (describe signature)
+  (-> Signature Text)
+  (format (%ident (get@ #name signature)) " " (get@ #version signature)))
+
+(abstract: #export (Key k)
+  {}
+
+  Signature
+
+  (structure: #export Equivalence
+    (All [k] (Equivalence (Key k)))
+    (def: (= reference sample)
+      (:: Equivalence = (:representation reference) (:representation sample))))
+
+  (def: #export default
+    (Key Nothing)
+    (:abstraction {#name ["" ""]
+                   #version default.version}))
+
+  (def: #export signature
+    (-> (Key Any) Signature)
+    (|>> :representation))
+  )
+
+## Document
+(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)})
+  (ex.report ["Expected" (describe (..signature expected))]
+             ["Actual" (describe (..signature actual))]))
+
+(exception: #export (signature-does-not-match-key {key (Key Any)} {signature Signature})
+  (ex.report ["Key" (describe (..signature key))]
+             ["Signature" (describe signature)]))
+
+(type: #export Reference Text)
+
+(type: #export Descriptor
+  {#hash Nat
+   #file File
+   #references (List Reference)
+   #state Module-State})
+
+(type: #export (Document d)
+  {#key (Key d)
+   #descriptor Descriptor
+   #content d})
+
+(def: #export (open expected [actual _descriptor content])
+  (All [d] (-> (Key d) (Document Any) (Error d)))
+  (if (:: Equivalence = expected actual)
+    (#error.Success (:share [e]
+                            {(Key e)
+                             expected}
+                            {e
+                             content}))
+    (ex.throw invalid-key-for-document [expected actual])))
+
+(def: #export (close key signature descriptor content)
+  (All [d] (-> (Key d) Signature Descriptor d (Error (Document d))))
+  (if (:: Equivalence = (..signature key) signature)
+    (#error.Success {#key key
+                     #descriptor descriptor
+                     #content content})
+    (ex.throw signature-does-not-match-key [key signature])))
+
+## Archive
+(exception: #export (cannot-replace-document-in-archive {name Text} {old (Document Any)} {new (Document Any)})
+  (ex.report ["Module's name" name]
+             ["Old document's key" (describe (..signature (get@ #key old)))]
+             ["New document's key" (describe (..signature (get@ #key new)))]))
+
+(type: #export Archive
+  (Dictionary Text (Ex [d] (Document d))))
+
+(def: #export empty Archive (dict.new text.Hash))
+
+(def: #export (add name document archive)
+  (-> Text (Ex [d] (Document d)) Archive (Error Archive))
+  (case (dict.get name archive)
+    (#.Some existing)
+    (if (is? document existing)
+      (#error.Success archive)
+      (ex.throw cannot-replace-document-in-archive [name existing document]))
+    
+    #.None
+    (#error.Success (dict.put name document archive))))
+
+(def: #export (merge additions archive)
+  (-> Archive Archive (Error Archive))
+  (monad.fold error.Monad
+              (function (_ [name' document'] archive')
+                (..add name' document' archive'))
+              archive
+              (dict.entries additions)))
diff --git a/stdlib/source/lux/compiler/meta/cache.lux b/stdlib/source/lux/compiler/meta/cache.lux
new file mode 100644
index 000000000..eb702c0da
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/cache.lux
@@ -0,0 +1,167 @@
+(.module:
+  [lux (#- Module)
+   [control
+    ["." monad (#+ Monad do)]
+    ["ex" exception (#+ exception:)]
+    pipe]
+   [data
+    ["." bit ("bit/." Equivalence)]
+    ["." maybe]
+    ["." error]
+    ["." product]
+    [format
+     ["." binary (#+ Format)]]
+    ["." text
+     [format (#- Format)]]
+    [collection
+     ["." list ("list/." Functor Fold)]
+     ["dict" dictionary (#+ Dictionary)]
+     ["." set (#+ Set)]]]
+   [world
+    [file (#+ File System)]]]
+  [//io (#+ Context Module)]
+  ["." //io/context]
+  ["." //io/archive]
+  ["." //archive (#+ Signature Key Descriptor Document Archive)]
+  ["." /dependency (#+ Dependency Graph)])
+
+(exception: #export (cannot-delete-cached-file {file File})
+  (ex.report ["File" file]))
+
+(exception: #export (stale-document {module Text} {current-hash Nat} {stale-hash Nat})
+  (ex.report ["Module" module]
+             ["Current hash" (%n current-hash)]
+             ["Stale hash" (%n stale-hash)]))
+
+(do-template []
+  [(exception: #export ( {message Text})
+     message)]
+
+  [cannot-load-definition]
+  )
+
+## General
+(def: #export (cached System root)
+  (All [m] (-> (System m) File (m (List File))))
+  (|> root
+      (//io/archive.archive System)
+      (do> (:: System &monad)
+           [(:: System files)]
+           [(monad.map @ (function (recur file)
+                           (do @
+                             [is-dir? (:: System directory? file)]
+                             (if is-dir?
+                               (|> file
+                                   (do> @
+                                        [(:: System files)]
+                                        [(monad.map @ recur)]
+                                        [list.concat
+                                         (list& (maybe.assume (//io/archive.module System root file)))
+                                         wrap]))
+                               (wrap (list))))))]
+           [list.concat wrap])))
+
+## Clean
+(def: (delete System document)
+  (All [m] (-> (System m) File (m Any)))
+  (do (:: System &monad)
+    [deleted? (:: System delete document)]
+    (if deleted?
+      (wrap [])
+      (:: System throw cannot-delete-cached-file document))))
+
+(def: (un-install System root module)
+  (All [m] (-> (System m) File Module (m Any)))
+  (let [document (//io/archive.document System root module)]
+    (|> document
+        (do> (:: System &monad)
+             [(:: System files)]
+             [(monad.map @ (function (_ file)
+                             (do @
+                               [? (:: System directory? file)]
+                               (if ?
+                                 (wrap #0)
+                                 (do @
+                                   [_ (..delete System file)]
+                                   (wrap #1))))))]
+             [(list.every? (bit/= #1))
+              (if> [(..delete System document)]
+                   [(wrap [])])]))))
+
+(def: #export (clean System root wanted-modules)
+  (All [m] (-> (System m) File (Set Module) (m Any)))
+  (|> root
+      (do> (:: System &monad)
+           [(..cached System)]
+           [(list.filter (bit.complement (set.member? wanted-modules)))
+            (monad.map @ (un-install System root))])))
+
+## Load
+(def: signature
+  (Format Signature)
+  ($_ binary.seq binary.ident binary.text))
+
+(def: descriptor
+  (Format Descriptor)
+  ($_ binary.seq binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))
+
+(def: document
+  (All [a] (-> (Format a) (Format [Signature Descriptor a])))
+  (|>> ($_ binary.seq ..signature ..descriptor)))
+
+(def: (load-document System contexts root key binary module)
+  (All [m d] (-> (System m) (List File) File (Key d) (Format d) Module
+                 (m (Maybe [Dependency (Document d)]))))
+  (do (:: System &monad)
+    [document' (:: System read (//io/archive.document System root module))
+     [module' source-code] (//io/context.read System contexts module)
+     #let [current-hash (:: text.Hash hash source-code)]]
+    (case (do error.Monad
+            [[signature descriptor content] (binary.read (..document binary) document')
+             #let [[document-hash _file references _state] descriptor]
+             _ (ex.assert stale-document [module current-hash document-hash]
+                          (n/= current-hash document-hash))
+             document (//archive.close key signature descriptor content)]
+            (wrap [[module references] document]))
+      (#error.Success [dependency document])
+      (wrap (#.Some [dependency document]))
+      
+      (#error.Error error)
+      (do @
+        [_ (un-install System root module)]
+        (wrap #.None)))))
+
+(def: #export (load-archive System contexts root key binary)
+  (All [m d] (-> (System m) (List Context) File (Key d) (Format d) (m Archive)))
+  (do (:: System &monad)
+    [candidate (|> root
+                   (do> @
+                        [(..cached System)]
+                        [(monad.map @ (load-document System contexts root key binary))
+                         (:: @ map (list/fold (function (_ full-document archive)
+                                                (case full-document
+                                                  (#.Some [[module references] document])
+                                                  (dict.put module [references document] archive)
+                                                  
+                                                  #.None
+                                                  archive))
+                                              (: (Dictionary Text [(List Module) (Ex [d] (Document d))])
+                                                 (dict.new text.Hash))))]))
+     #let [candidate-entries (dict.entries candidate)
+           candidate-dependencies (list/map (product.both id product.left)
+                                            candidate-entries)
+           candidate-archive (|> candidate-entries
+                                 (list/map (product.both id product.right))
+                                 (dict.from-list text.Hash))
+           graph (|> candidate
+                     dict.entries
+                     (list/map (product.both id product.left))
+                     /dependency.graph
+                     (/dependency.prune candidate-archive))
+           archive (list/fold (function (_ module archive)
+                                (if (dict.contains? module graph)
+                                  archive
+                                  (dict.remove module archive)))
+                              candidate-archive
+                              (dict.keys candidate))]]
+    (wrap archive)))
diff --git a/stdlib/source/lux/compiler/meta/cache/dependency.lux b/stdlib/source/lux/compiler/meta/cache/dependency.lux
new file mode 100644
index 000000000..e63fa192b
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/cache/dependency.lux
@@ -0,0 +1,53 @@
+(.module:
+  [lux (#- Module)
+   [data
+    ["." text]
+    [collection
+     [list ("list/." Functor Fold)]
+     ["dict" dictionary (#+ Dictionary)]]]]
+  [///io (#+ Module)]
+  [///archive (#+ Archive)])
+
+(type: #export Graph (Dictionary Module (List Module)))
+
+(def: #export empty Graph (dict.new text.Hash))
+
+(def: #export (add to from)
+  (-> Module Module Graph Graph)
+  (|>> (dict.update~ from (list) (|>> (#.Cons to)))
+       (dict.update~ to (list) id)))
+
+(def: dependents
+  (-> Module Graph (Maybe (List Text)))
+  dict.get)
+
+(def: #export (remove module dependency)
+  (-> Module Graph Graph)
+  (case (dependents module dependency)
+    (#.Some dependents)
+    (list/fold remove (dict.remove module dependency) dependents)
+
+    #.None
+    dependency))
+
+(type: #export Dependency
+  {#module Module
+   #imports (List Module)})
+
+(def: #export (dependency [module imports])
+  (-> Dependency Graph)
+  (list/fold (..add module) ..empty imports))
+
+(def: #export graph
+  (-> (List Dependency) Graph)
+  (|>> (list/map ..dependency)
+       (list/fold dict.merge empty)))
+
+(def: #export (prune archive graph)
+  (-> Archive Graph Graph)
+  (list/fold (function (_ module graph)
+               (if (dict.contains? module archive)
+                 graph
+                 (..remove module graph)))
+             graph
+             (dict.keys graph)))
diff --git a/stdlib/source/lux/compiler/meta/io.lux b/stdlib/source/lux/compiler/meta/io.lux
new file mode 100644
index 000000000..a46f78d5a
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/io.lux
@@ -0,0 +1,14 @@
+(.module:
+  [lux (#- Module)
+   [data
+    ["." text]]
+   [world
+    [file (#+ File System)]]])
+
+(type: #export Context File)
+
+(type: #export Module Text)
+
+(def: #export (sanitize system)
+  (All [m] (-> (System m) Text Text))
+  (text.replace-all "/" (:: system separator)))
diff --git a/stdlib/source/lux/compiler/meta/io/archive.lux b/stdlib/source/lux/compiler/meta/io/archive.lux
new file mode 100644
index 000000000..1c5924df7
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/io/archive.lux
@@ -0,0 +1,74 @@
+(.module:
+  [lux (#- Module)
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error]
+    ["." text
+     format]]
+   [world
+    ["." file (#+ File System)]
+    [binary (#+ Binary)]]]
+  ["." // (#+ Module)
+   [///
+    ["." host]]])
+
+(type: #export Document File)
+
+(exception: #export (cannot-prepare {archive File} {module Module})
+  (ex.report ["Archive" archive]
+             ["Module" module]))
+
+(def: #export (archive System root)
+  (All [m] (-> (System m) File File))
+  (<| (format root (:: System separator))
+      (`` (for {(~~ (static host.common-lisp)) host.common-lisp
+                (~~ (static host.js))          host.js
+                (~~ (static host.jvm))         host.jvm
+                (~~ (static host.lua))         host.lua
+                (~~ (static host.php))         host.php
+                (~~ (static host.python))      host.python
+                (~~ (static host.r))           host.r
+                (~~ (static host.ruby))        host.ruby
+                (~~ (static host.scheme))      host.scheme}))))
+
+(def: #export (document System root module)
+  (All [m] (-> (System m) File Module Document))
+  (let [archive (..archive System root)]
+    (|> module
+        (//.sanitize System)
+        (format archive (:: System separator)))))
+
+(def: #export (prepare System root module)
+  (All [m] (-> (System m) File Module (m Any)))
+  (do (:: System &monad)
+    [#let [archive (..archive System root)
+           document (..document System root module)]
+     document-exists? (file.exists? System document)]
+    (if document-exists?
+      (wrap [])
+      (do @
+        [outcome (:: System try (:: System make-directory document))]
+        (case outcome
+          (#error.Success output)
+          (wrap output)
+
+          (#error.Error _)
+          (:: System throw cannot-prepare [archive module]))))))
+
+(def: #export (write System root content name)
+  (All [m] (-> (System m) File Binary Text (m Any)))
+  (:: System write content (..document System root name)))
+
+(def: #export (module System root document)
+  (All [m] (-> (System m) File Document (Maybe Module)))
+  (case (text.split-with (..archive System root) document)
+    (#.Some ["" post])
+    (let [raw (text.replace-all (:: System separator) "/" post)]
+      (if (text.starts-with? "/" raw)
+        (text.clip' +1 raw)
+        (#.Some raw)))
+
+    _
+    #.None))
diff --git a/stdlib/source/lux/compiler/meta/io/context.lux b/stdlib/source/lux/compiler/meta/io/context.lux
new file mode 100644
index 000000000..6d90483e2
--- /dev/null
+++ b/stdlib/source/lux/compiler/meta/io/context.lux
@@ -0,0 +1,94 @@
+(.module:
+  [lux (#- Module Code)
+   [control
+    monad
+    ["ex" exception (#+ Exception exception:)]]
+   [data
+    ["." error]
+    [text
+     format
+     ["." encoding]]]
+   [world
+    ["." file (#+ File System)]
+    [binary (#+ Binary)]]]
+  ["." // (#+ Context Module)
+   [///
+    ["." host]]])
+
+(type: #export Extension Text)
+
+(def: #export (file System context module)
+  (All [m] (-> (System m) Context Module File))
+  (|> module
+      (//.sanitize System)
+      (format context (:: System separator))))
+
+(def: host-extension
+  Extension
+  (`` (for {(~~ (static host.common-lisp)) ".cl"
+            (~~ (static host.js))          ".js"
+            (~~ (static host.jvm))         ".jvm"
+            (~~ (static host.lua))         ".lua"
+            (~~ (static host.php))         ".php"
+            (~~ (static host.python))      ".py"
+            (~~ (static host.r))           ".r"
+            (~~ (static host.ruby))        ".rb"
+            (~~ (static host.scheme))      ".scm"})))
+
+(def: lux-extension Extension ".lux")
+
+(do-template []
+  [(exception: #export ( {module Module})
+     (ex.report ["Module" module]))]
+
+  [module-not-found]
+  [cannot-read-module]
+  )
+
+(def: (find-source System contexts module extension)
+  (All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File]))))
+  (case contexts
+    #.Nil
+    (:: (:: System &monad) wrap #.None)
+
+    (#.Cons context contexts')
+    (do (:: System &monad)
+      [#let [file (format (..file System context module) extension)]
+       ? (file.exists? System file)]
+      (if ?
+        (wrap (#.Some [module file]))
+        (find-source System contexts' module)))))
+
+(def: (try System computations exception message)
+  (All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a)))
+  (case computations
+    #.Nil
+    (:: System throw exception message)
+
+    (#.Cons computation computations')
+    (do (:: System &monad)
+      [outcome computation]
+      (case outcome
+        (#.Some output)
+        (wrap output)
+
+        #.None
+        (try System computations' exception message)))))
+
+(type: #export Code Text)
+
+(def: #export (read System contexts name)
+  (All [m] (-> (System m) (List Context) Module (m [Text Code])))
+  (let [find-source' (find-source System contexts name)]
+    (do (:: System &monad)
+      [[path file] (try System
+                        (list (find-source' (format host-extension lux-extension))
+                              (find-source' lux-extension))
+                        module-not-found [name])
+       binary (:: System read file)]
+      (case (encoding.from-utf8 binary)
+        (#error.Success code)
+        (wrap [path code])
+        
+        (#error.Error _)
+        (:: System throw cannot-read-module [name])))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index c29783146..28679b429 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -4,7 +4,7 @@
     [monoid (#+ Monoid)]
     [equivalence (#+ Equivalence)]
     [order (#+ Order)]
-    [monad (#+ do Monad)]
+    [monad (#+ Monad do)]
     [codec (#+ Codec)]
     hash]
    [data
@@ -13,7 +13,7 @@
      ["." i64]]
     [collection
      ["." list ("list/." Fold)]]]
-   [language
+   [compiler
     ["." host]]])
 
 (def: #export (size x)
diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux
index a7d3da76a..f8042abc0 100644
--- a/stdlib/source/lux/data/text/buffer.lux
+++ b/stdlib/source/lux/data/text/buffer.lux
@@ -6,7 +6,7 @@
      format]
     [collection
      ["." row (#+ Row) ("row/." Fold)]]]
-   [language
+   [compiler
     ["_" host]]
    [type
     abstract]
diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux
index 661e0bbf9..029505b21 100644
--- a/stdlib/source/lux/data/text/encoding.lux
+++ b/stdlib/source/lux/data/text/encoding.lux
@@ -4,7 +4,7 @@
     ["." error (#+ Error)]]
    [world
     [binary (#+ Binary)]]
-   [language
+   [compiler
     ["_" host]]
    [host (#+ import:)]])
 
diff --git a/stdlib/source/lux/language.lux b/stdlib/source/lux/language.lux
deleted file mode 100644
index bc6e2c9ec..000000000
--- a/stdlib/source/lux/language.lux
+++ /dev/null
@@ -1,9 +0,0 @@
-(.module:
-  lux)
-
-(type: #export Eval
-  (-> Type Code (Meta Any)))
-
-(type: #export Version Text)
-
-(def: #export version Version "0.6.0")
diff --git a/stdlib/source/lux/language/compiler.lux b/stdlib/source/lux/language/compiler.lux
deleted file mode 100644
index 03dd30e2a..000000000
--- a/stdlib/source/lux/language/compiler.lux
+++ /dev/null
@@ -1,69 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." state]
-    ["ex" exception (#+ Exception exception:)]
-    [monad (#+ do)]]
-   [data
-    ["." product]
-    ["." error (#+ Error)]
-    ["." text
-     format]]
-   [macro
-    ["s" syntax (#+ syntax:)]]])
-
-(type: #export (Operation s o)
-  (state.State' Error s o))
-
-(def: #export Monad
-  (state.Monad error.Monad))
-
-(type: #export (Compiler s i o)
-  (-> i (Operation s o)))
-
-(def: #export (run' state operation)
-  (All [s o]
-    (-> s (Operation s o) (Error [s o])))
-  (operation state))
-
-(def: #export (run state operation)
-  (All [s o]
-    (-> s (Operation s o) (Error o)))
-  (|> state
-      operation
-      (:: error.Monad map product.right)))
-
-(def: #export fail
-  (-> Text Operation)
-  (|>> error.fail (state.lift error.Monad)))
-
-(def: #export (throw exception parameters)
-  (All [e] (-> (Exception e) e Operation))
-  (state.lift error.Monad
-              (ex.throw exception parameters)))
-
-(syntax: #export (assert exception message test)
-  (wrap (list (` (if (~ test)
-                   (:: ..Monad (~' wrap) [])
-                   (..throw (~ exception) (~ message)))))))
-
-(def: #export (with-stack exception message action)
-  (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
-  (<<| (ex.with-stack exception message)
-       action))
-
-(def: #export identity
-  (All [s a] (Compiler s a a))
-  (function (_ input state)
-    (#error.Success [state input])))
-
-(def: #export (compose pre post)
-  (All [s0 s1 i t o]
-    (-> (Compiler s0 i t)
-        (Compiler s1 t o)
-        (Compiler [s0 s1] i o)))
-  (function (_ input [pre/state post/state])
-    (do error.Monad
-      [[pre/state' temp] (pre input pre/state)
-       [post/state' output] (post temp post/state)]
-      (wrap [[pre/state' post/state'] output]))))
diff --git a/stdlib/source/lux/language/compiler/analysis.lux b/stdlib/source/lux/language/compiler/analysis.lux
deleted file mode 100644
index 4b8a19c66..000000000
--- a/stdlib/source/lux/language/compiler/analysis.lux
+++ /dev/null
@@ -1,285 +0,0 @@
-(.module:
-  [lux (#- nat int rev)
-   [data
-    ["." product]
-    ["." error]
-    [text ("text/." Equivalence)]
-    [collection
-     ["." list ("list/." Fold)]]]
-   ["." function]]
-  [//
-   ["." extension (#+ Extension)]
-   [//
-    ["." reference (#+ Register Variable Reference)]]])
-
-(type: #export #rec Primitive
-  #Unit
-  (#Bit Bit)
-  (#Nat Nat)
-  (#Int Int)
-  (#Rev Rev)
-  (#Frac Frac)
-  (#Text Text))
-
-(type: #export Tag Nat)
-
-(type: #export (Composite a)
-  (#Sum (Either a a))
-  (#Product [a a]))
-
-(type: #export #rec Pattern
-  (#Simple Primitive)
-  (#Complex (Composite Pattern))
-  (#Bind Register))
-
-(type: #export (Branch' e)
-  {#when Pattern
-   #then e})
-
-(type: #export (Match' e)
-  [(Branch' e) (List (Branch' e))])
-
-(type: #export Environment
-  (List Variable))
-
-(type: #export #rec Analysis
-  (#Primitive Primitive)
-  (#Structure (Composite Analysis))
-  (#Reference Reference)
-  (#Case Analysis (Match' Analysis))
-  (#Function Environment Analysis)
-  (#Apply Analysis Analysis)
-  (#Extension (Extension Analysis)))
-
-(type: #export Operation
-  (extension.Operation .Lux Code Analysis))
-
-(type: #export Compiler
-  (extension.Compiler .Lux Code Analysis))
-
-(type: #export Handler
-  (extension.Handler .Lux .Code Analysis))
-
-(type: #export Bundle
-  (extension.Bundle .Lux .Code Analysis))
-
-(type: #export Branch
-  (Branch' Analysis))
-
-(type: #export Match
-  (Match' Analysis))
-
-(do-template [ ]
-  [(template: #export ( content)
-     ( content))]
-
-  [control/case #Case]
-  )
-
-(do-template [  ]
-  [(def: #export 
-     (->  Analysis)
-     (|>>  #Primitive))]
-
-  [bit  Bit  #Bit]
-  [nat  Nat  #Nat]
-  [int  Int  #Int]
-  [rev  Rev  #Rev]
-  [frac Frac #Frac]
-  [text Text #Text]
-  )
-
-(type: #export (Variant a)
-  {#lefts Nat
-   #right? Bit
-   #value a})
-
-(type: #export (Tuple a) (List a))
-
-(type: #export Arity Nat)
-
-(type: #export (Abstraction c) [Environment Arity c])
-
-(type: #export (Application c) [c (List c)])
-
-(def: (last? size tag)
-  (-> Nat Tag Bit)
-  (n/= (dec size) tag))
-
-(template: #export (no-op value)
-  (|> +1 #reference.Local #reference.Variable #..Reference
-      (#..Function (list))
-      (#..Apply value)))
-
-(do-template [   ]
-  [(def: #export ( size tag value)
-     (-> Nat Tag  )
-     (let [left (function.constant (|>> #.Left #Sum ))
-           right (|>> #.Right #Sum )]
-       (if (last? size tag)
-         (if (n/= +1 tag)
-           (right value)
-           (list/fold left
-                      (right value)
-                      (list.n/range +0 (n/- +2 tag))))
-         (list/fold left
-                    (case value
-                      ( (#Sum _))
-                      ( value)
-
-                      _
-                      value)
-                    (list.n/range +0 tag)))))]
-
-  [sum-analysis Analysis #Structure no-op]
-  [sum-pattern  Pattern  #Complex   id]
-  )
-
-(do-template [   ]
-  [(def: #export ( members)
-     (-> (Tuple ) )
-     (case (list.reverse members)
-       #.Nil
-       ( #Unit)
-
-       (#.Cons singleton #.Nil)
-       singleton
-
-       (#.Cons last prevs)
-       (list/fold (function (_ left right) ( (#Product left right)))
-                  last prevs)))]
-
-  [product-analysis Analysis #Primitive #Structure]
-  [product-pattern  Pattern  #Simple    #Complex]
-  )
-
-(def: #export (apply [func args])
-  (-> (Application Analysis) Analysis)
-  (list/fold (function (_ arg func) (#Apply arg func)) func args))
-
-(do-template [  ]
-  [(def: #export ( value)
-     (->  (Tuple ))
-     (case value
-       ( (#Product left right))
-       (#.Cons left ( right))
-
-       _
-       (list value)))]
-
-  [tuple         Analysis #Structure]
-  [tuple-pattern Pattern  #Complex]
-  )
-
-(do-template [  ]
-  [(def: #export ( value)
-     (->  (Maybe (Variant )))
-     (loop [lefts +0
-            variantA value]
-       (case variantA
-         ( (#Sum (#.Left valueA)))
-         (case valueA
-           ( (#Sum _))
-           (recur (inc lefts) valueA)
-
-           _
-           (#.Some {#lefts lefts
-                    #right? #0
-                    #value valueA}))
-         
-         ( (#Sum (#.Right valueA)))
-         (#.Some {#lefts lefts
-                  #right? #1
-                  #value valueA})
-
-         _
-         #.None)))]
-
-  [variant         Analysis #Structure]
-  [variant-pattern Pattern  #Complex]
-  )
-
-(def: #export (application analysis)
-  (-> Analysis (Application Analysis))
-  (case analysis
-    (#Apply head func)
-    (let [[func' tail] (application func)]
-      [func' (#.Cons head tail)])
-
-    _
-    [analysis (list)]))
-
-(template: #export (pattern/unit)
-  (#..Simple #..Unit))
-
-(do-template [ ]
-  [(template: #export ( content)
-     (#..Simple ( content)))]
-  
-  [pattern/bit  #..Bit]
-  [pattern/nat  #..Nat]
-  [pattern/int  #..Int]
-  [pattern/rev  #..Rev]
-  [pattern/frac #..Frac]
-  [pattern/text #..Text]
-  )
-
-(def: #export (with-source-code source action)
-  (All [a] (-> Source (Operation a) (Operation a)))
-  (function (_ [bundle compiler])
-    (let [old-source (get@ #.source compiler)]
-      (case (action [bundle (set@ #.source source compiler)])
-        (#error.Error error)
-        (#error.Error error)
-
-        (#error.Success [[bundle' compiler'] output])
-        (#error.Success [[bundle' (set@ #.source old-source compiler')]
-                         output])))))
-
-(def: fresh-bindings
-  (All [k v] (Bindings k v))
-  {#.counter +0
-   #.mappings (list)})
-
-(def: fresh-scope
-  Scope
-  {#.name     (list)
-   #.inner    +0
-   #.locals   fresh-bindings
-   #.captured fresh-bindings})
-
-(def: #export (with-scope action)
-  (All [a] (-> (Operation a) (Operation [Scope a])))
-  (function (_ [bundle compiler])
-    (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler)])
-      (#error.Success [[bundle' compiler'] output])
-      (case (get@ #.scopes compiler')
-        #.Nil
-        (#error.Error "Impossible error: Drained scopes!")
-
-        (#.Cons head tail)
-        (#error.Success [[bundle' (set@ #.scopes tail compiler')]
-                         [head output]]))
-
-      (#error.Error error)
-      (#error.Error error))))
-
-(def: #export (with-current-module name)
-  (All [a] (-> Text (Operation a) (Operation a)))
-  (extension.localized (get@ #.current-module)
-                       (set@ #.current-module)
-                       (function.constant (#.Some name))))
-
-(def: #export (with-cursor cursor action)
-  (All [a] (-> Cursor (Operation a) (Operation a)))
-  (if (text/= "" (product.left cursor))
-    action
-    (function (_ [bundle compiler])
-      (let [old-cursor (get@ #.cursor compiler)]
-        (case (action [bundle (set@ #.cursor cursor compiler)])
-          (#error.Success [[bundle' compiler'] output])
-          (#error.Success [[bundle' (set@ #.cursor old-cursor compiler')]
-                           output])
-
-          (#error.Error error)
-          (#error.Error error))))))
diff --git a/stdlib/source/lux/language/compiler/analysis/case.lux b/stdlib/source/lux/language/compiler/analysis/case.lux
deleted file mode 100644
index 841173629..000000000
--- a/stdlib/source/lux/language/compiler/analysis/case.lux
+++ /dev/null
@@ -1,296 +0,0 @@
-(.module:
-  [lux (#- case)
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." product]
-    ["." error]
-    ["." maybe]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Fold Monoid Functor)]]]
-   ["." type
-    ["." check]]
-   ["." macro
-    ["." code]]]
-  ["." // (#+ Pattern Analysis Operation Compiler)
-   ["." scope]
-   ["//." type]
-   ["." structure]
-   ["/." //
-    ["." extension]]]
-  [/
-   ["." coverage]])
-
-(exception: #export (cannot-match-with-pattern {type Type} {pattern Code})
-  (ex.report ["Type" (%type type)]
-             ["Pattern" (%code pattern)]))
-
-(exception: #export (sum-has-no-case {case Nat} {type Type})
-  (ex.report ["Case" (%n case)]
-             ["Type" (%type type)]))
-
-(exception: #export (unrecognized-pattern-syntax {pattern Code})
-  (%code pattern))
-
-(exception: #export (cannot-simplify-for-pattern-matching {type Type})
-  (%type type))
-
-(do-template []
-  [(exception: #export ( {message Text})
-     message)]
-
-  [cannot-have-empty-branches]
-  [non-exhaustive-pattern-matching]
-  )
-
-(def: (re-quantify envs baseT)
-  (-> (List (List Type)) Type Type)
-  (.case envs
-    #.Nil
-    baseT
-
-    (#.Cons head tail)
-    (re-quantify tail (#.UnivQ head baseT))))
-
-## Type-checking on the input value is done during the analysis of a
-## "case" expression, to ensure that the patterns being used make
-## sense for the type of the input value.
-## Sometimes, that input value is complex, by depending on
-## type-variables or quantifications.
-## This function makes it easier for "case" analysis to properly
-## type-check the input with respect to the patterns.
-(def: (simplify-case caseT)
-  (-> Type (Operation Type))
-  (loop [envs (: (List (List Type))
-                 (list))
-         caseT caseT]
-    (.case caseT
-      (#.Var id)
-      (do ///.Monad
-        [?caseT' (//type.with-env
-                   (check.read id))]
-        (.case ?caseT'
-          (#.Some caseT')
-          (recur envs caseT')
-
-          _
-          (///.throw cannot-simplify-for-pattern-matching caseT)))
-
-      (#.Named name unnamedT)
-      (recur envs unnamedT)
-
-      (#.UnivQ env unquantifiedT)
-      (recur (#.Cons env envs) unquantifiedT)
-
-      (#.ExQ _)
-      (do ///.Monad
-        [[ex-id exT] (//type.with-env
-                       check.existential)]
-        (recur envs (maybe.assume (type.apply (list exT) caseT))))
-
-      (#.Apply inputT funcT)
-      (.case funcT
-        (#.Var funcT-id)
-        (do ///.Monad
-          [funcT' (//type.with-env
-                    (do check.Monad
-                      [?funct' (check.read funcT-id)]
-                      (.case ?funct'
-                        (#.Some funct')
-                        (wrap funct')
-
-                        _
-                        (check.throw cannot-simplify-for-pattern-matching caseT))))]
-          (recur envs (#.Apply inputT funcT')))
-
-        _
-        (.case (type.apply (list inputT) funcT)
-          (#.Some outputT)
-          (recur envs outputT)
-
-          #.None
-          (///.throw cannot-simplify-for-pattern-matching caseT)))
-
-      (#.Product _)
-      (|> caseT
-          type.flatten-tuple
-          (list/map (re-quantify envs))
-          type.tuple
-          (:: ///.Monad wrap))
-
-      _
-      (:: ///.Monad wrap (re-quantify envs caseT)))))
-
-(def: (analyse-primitive type inputT cursor output next)
-  (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a])))
-  (//.with-cursor cursor
-    (do ///.Monad
-      [_ (//type.with-env
-           (check.check inputT type))
-       outputA next]
-      (wrap [output outputA]))))
-
-## This function handles several concerns at once, but it must be that
-## way because those concerns are interleaved when doing
-## pattern-matching and they cannot be separated.
-## The pattern is analysed in order to get a general feel for what is
-## expected of the input value. This, in turn, informs the
-## type-checking of the input.
-## A kind of "continuation" value is passed around which signifies
-## what needs to be done _after_ analysing a pattern.
-## In general, this is done to analyse the "body" expression
-## associated to a particular pattern _in the context of_ said
-## pattern.
-## The reason why *context* is important is because patterns may bind
-## values to local variables, which may in turn be referenced in the
-## body expressions.
-## That is why the body must be analysed in the context of the
-## pattern, and not separately.
-(def: (analyse-pattern num-tags inputT pattern next)
-  (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
-  (.case pattern
-    [cursor (#.Symbol ["" name])]
-    (//.with-cursor cursor
-      (do ///.Monad
-        [outputA (scope.with-local [name inputT]
-                   next)
-         idx scope.next-local]
-        (wrap [(#//.Bind idx) outputA])))
-
-    (^template [  ]
-      [cursor ]
-      (analyse-primitive  inputT cursor (#//.Simple ) next))
-    ([Bit  (#.Bit pattern-value)  (#//.Bit pattern-value)]
-     [Nat  (#.Nat pattern-value)  (#//.Nat pattern-value)]
-     [Int  (#.Int pattern-value)  (#//.Int pattern-value)]
-     [Rev  (#.Rev pattern-value)  (#//.Rev pattern-value)]
-     [Frac (#.Frac pattern-value) (#//.Frac pattern-value)]
-     [Text (#.Text pattern-value) (#//.Text pattern-value)]
-     [Any  (#.Tuple #.Nil)        #//.Unit])
-    
-    (^ [cursor (#.Tuple (list singleton))])
-    (analyse-pattern #.None inputT singleton next)
-    
-    [cursor (#.Tuple sub-patterns)]
-    (//.with-cursor cursor
-      (do ///.Monad
-        [inputT' (simplify-case inputT)]
-        (.case inputT'
-          (#.Product _)
-          (let [subs (type.flatten-tuple inputT')
-                num-subs (maybe.default (list.size subs)
-                                        num-tags)
-                num-sub-patterns (list.size sub-patterns)
-                matches (cond (n/< num-subs num-sub-patterns)
-                              (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)]
-                                (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
-
-                              (n/> num-subs num-sub-patterns)
-                              (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)]
-                                (list.zip2 subs (list/compose prefix (list (code.tuple suffix)))))
-                              
-                              ## (n/= num-subs num-sub-patterns)
-                              (list.zip2 subs sub-patterns))]
-            (do @
-              [[memberP+ thenA] (list/fold (: (All [a]
-                                                (-> [Type Code] (Operation [(List Pattern) a])
-                                                    (Operation [(List Pattern) a])))
-                                              (function (_ [memberT memberC] then)
-                                                (do @
-                                                  [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
-                                                                                        analyse-pattern)
-                                                                               #.None memberT memberC then)]
-                                                  (wrap [(list& memberP memberP+) thenA]))))
-                                           (do @
-                                             [nextA next]
-                                             (wrap [(list) nextA]))
-                                           (list.reverse matches))]
-              (wrap [(//.product-pattern memberP+)
-                     thenA])))
-
-          _
-          (///.throw cannot-match-with-pattern [inputT pattern])
-          )))
-
-    [cursor (#.Record record)]
-    (do ///.Monad
-      [record (structure.normalize record)
-       [members recordT] (structure.order record)
-       _ (//type.with-env
-           (check.check inputT recordT))]
-      (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next))
-
-    [cursor (#.Tag tag)]
-    (//.with-cursor cursor
-      (analyse-pattern #.None inputT (` ((~ pattern))) next))
-
-    (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
-    (//.with-cursor cursor
-      (do ///.Monad
-        [inputT' (simplify-case inputT)]
-        (.case inputT'
-          (#.Sum _)
-          (let [flat-sum (type.flatten-variant inputT')
-                size-sum (list.size flat-sum)
-                num-cases (maybe.default size-sum num-tags)]
-            (.case (list.nth idx flat-sum)
-              (^multi (#.Some caseT)
-                      (n/< num-cases idx))
-              (do ///.Monad
-                [[testP nextA] (if (and (n/> num-cases size-sum)
-                                        (n/= (dec num-cases) idx))
-                                 (analyse-pattern #.None
-                                                  (type.variant (list.drop (dec num-cases) flat-sum))
-                                                  (` [(~+ values)])
-                                                  next)
-                                 (analyse-pattern #.None caseT (` [(~+ values)]) next))]
-                (wrap [(//.sum-pattern num-cases idx testP)
-                       nextA]))
-
-              _
-              (///.throw sum-has-no-case [idx inputT])))
-
-          _
-          (///.throw cannot-match-with-pattern [inputT pattern]))))
-
-    (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
-    (//.with-cursor cursor
-      (do ///.Monad
-        [tag (extension.lift (macro.normalize tag))
-         [idx group variantT] (extension.lift (macro.resolve-tag tag))
-         _ (//type.with-env
-             (check.check inputT variantT))]
-        (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next)))
-
-    _
-    (///.throw unrecognized-pattern-syntax pattern)
-    ))
-
-(def: #export (case analyse inputC branches)
-  (-> Compiler Code (List [Code Code]) (Operation Analysis))
-  (.case branches
-    #.Nil
-    (///.throw cannot-have-empty-branches "")
-
-    (#.Cons [patternH bodyH] branchesT)
-    (do ///.Monad
-      [[inputT inputA] (//type.with-inference
-                         (analyse inputC))
-       outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
-       outputT (monad.map @
-                          (function (_ [patternT bodyT])
-                            (analyse-pattern #.None inputT patternT (analyse bodyT)))
-                          branchesT)
-       outputHC (|> outputH product.left coverage.determine)
-       outputTC (monad.map @ (|>> product.left coverage.determine) outputT)
-       _ (.case (monad.fold error.Monad coverage.merge outputHC outputTC)
-           (#error.Success coverage)
-           (///.assert non-exhaustive-pattern-matching ""
-                       (coverage.exhaustive? coverage))
-
-           (#error.Error error)
-           (///.fail error))]
-      (wrap (#//.Case inputA [outputH outputT])))))
diff --git a/stdlib/source/lux/language/compiler/analysis/case/coverage.lux b/stdlib/source/lux/language/compiler/analysis/case/coverage.lux
deleted file mode 100644
index 24ded5476..000000000
--- a/stdlib/source/lux/language/compiler/analysis/case/coverage.lux
+++ /dev/null
@@ -1,325 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    equivalence]
-   [data
-    [bit ("bit/." Equivalence)]
-    ["." number]
-    ["e" error ("error/." Monad)]
-    ["." maybe]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Fold)]
-     ["dict" dictionary (#+ Dictionary)]]]]
-  ["." //// ("operation/." Monad)]
-  ["." /// (#+ Pattern Variant Operation)])
-
-(def: cases
-  (-> (Maybe Nat) Nat)
-  (|>> (maybe.default +0)))
-
-(def: (variant sum-side)
-  (-> (Either Pattern Pattern) (Variant Pattern))
-  (loop [lefts +0
-         variantP sum-side]
-    (case variantP
-      (#.Left valueP)
-      (case valueP
-        (#///.Complex (#///.Sum value-side))
-        (recur (inc lefts) value-side)
-
-        _
-        {#///.lefts lefts
-         #///.right? #0
-         #///.value valueP})
-      
-      (#.Right valueP)
-      {#///.lefts lefts
-       #///.right? #1
-       #///.value valueP})))
-
-## The coverage of a pattern-matching expression summarizes how well
-## all the possible values of an input are being covered by the
-## different patterns involved.
-## Ideally, the pattern-matching has "exhaustive" coverage, which just
-## means that every possible value can be matched by at least 1
-## pattern.
-## Every other coverage is considered partial, and it would be valued
-## as insuficient (since it could lead to runtime errors due to values
-## not being handled by any pattern).
-## The #Partial tag covers arbitrary partial coverages in a general
-## way, while the other tags cover more specific cases for bits
-## and variants.
-(type: #export #rec Coverage
-  #Partial
-  (#Bit Bit)
-  (#Variant (Maybe Nat) (Dictionary Nat Coverage))
-  (#Seq Coverage Coverage)
-  (#Alt Coverage Coverage)
-  #Exhaustive)
-
-(def: #export (exhaustive? coverage)
-  (-> Coverage Bit)
-  (case coverage
-    (#Exhaustive _)
-    #1
-
-    _
-    #0))
-
-(def: #export (determine pattern)
-  (-> Pattern (Operation Coverage))
-  (case pattern
-    (^or (#///.Simple #///.Unit)
-         (#///.Bind _))
-    (operation/wrap #Exhaustive)
-
-    ## Primitive patterns always have partial coverage because there
-    ## are too many possibilities as far as values go.
-    (^template []
-      (#///.Simple ( _))
-      (operation/wrap #Partial))
-    ([#///.Nat]
-     [#///.Int]
-     [#///.Rev]
-     [#///.Frac]
-     [#///.Text])
-
-    ## Bits are the exception, since there is only "#1" and
-    ## "#0", which means it is possible for bit
-    ## pattern-matching to become exhaustive if complementary parts meet.
-    (#///.Simple (#///.Bit value))
-    (operation/wrap (#Bit value))
-
-    ## Tuple patterns can be exhaustive if there is exhaustiveness for all of
-    ## their sub-patterns.
-    (#///.Complex (#///.Product [left right]))
-    (do ////.Monad
-      [left (determine left)
-       right (determine right)]
-      (case right
-        (#Exhaustive _)
-        (wrap left)
-
-        _
-        (wrap (#Seq left right))))
-
-    (#///.Complex (#///.Sum sum-side))
-    (let [[variant-lefts variant-right? variant-value] (variant sum-side)]
-      ## Variant patterns can be shown to be exhaustive if all the possible
-      ## cases are handled exhaustively.
-      (do ////.Monad
-        [value-coverage (determine variant-value)
-         #let [variant-idx (if variant-right?
-                             (inc variant-lefts)
-                             variant-lefts)]]
-        (wrap (#Variant (if variant-right?
-                          (#.Some variant-idx)
-                          #.None)
-                        (|> (dict.new number.Hash)
-                            (dict.put variant-idx value-coverage))))))))
-
-(def: (xor left right)
-  (-> Bit Bit Bit)
-  (or (and left (not right))
-      (and (not left) right)))
-
-## The coverage checker not only verifies that pattern-matching is
-## exhaustive, but also that there are no redundant patterns.
-## Redundant patterns will never be executed, since there will
-## always be a pattern prior to them that would match the input.
-## Because of that, the presence of redundant patterns is assumed to
-## be a bug, likely due to programmer carelessness.
-(def: redundant-pattern
-  (e.Error Coverage)
-  (e.fail "Redundant pattern."))
-
-(def: (flatten-alt coverage)
-  (-> Coverage (List Coverage))
-  (case coverage
-    (#Alt left right)
-    (list& left (flatten-alt right))
-
-    _
-    (list coverage)))
-
-(structure: _ (Equivalence Coverage)
-  (def: (= reference sample)
-    (case [reference sample]
-      [#Exhaustive #Exhaustive]
-      #1
-
-      [(#Bit sideR) (#Bit sideS)]
-      (bit/= sideR sideS)
-
-      [(#Variant allR casesR) (#Variant allS casesS)]
-      (and (n/= (cases allR)
-                (cases allS))
-           (:: (dict.Equivalence =) = casesR casesS))
-      
-      [(#Seq leftR rightR) (#Seq leftS rightS)]
-      (and (= leftR leftS)
-           (= rightR rightS))
-
-      [(#Alt _) (#Alt _)]
-      (let [flatR (flatten-alt reference)
-            flatS (flatten-alt sample)]
-        (and (n/= (list.size flatR) (list.size flatS))
-             (list.every? (function (_ [coverageR coverageS])
-                            (= coverageR coverageS))
-                          (list.zip2 flatR flatS))))
-
-      _
-      #0)))
-
-(open: "coverage/." Equivalence)
-
-## After determining the coverage of each individual pattern, it is
-## necessary to merge them all to figure out if the entire
-## pattern-matching expression is exhaustive and whether it contains
-## redundant patterns.
-(def: #export (merge addition so-far)
-  (-> Coverage Coverage (e.Error Coverage))
-  (case [addition so-far]
-    ## The addition cannot possibly improve the coverage.
-    [_ #Exhaustive]
-    redundant-pattern
-
-    ## The addition completes the coverage.
-    [#Exhaustive _]
-    (error/wrap #Exhaustive)
-
-    [#Partial #Partial]
-    (error/wrap #Partial)
-
-    ## 2 bit coverages are exhaustive if they complement one another.
-    (^multi [(#Bit sideA) (#Bit sideSF)]
-            (xor sideA sideSF))
-    (error/wrap #Exhaustive)
-
-    [(#Variant allA casesA) (#Variant allSF casesSF)]
-    (cond (not (n/= (cases allSF) (cases allA)))
-          (e.fail "Variants do not match.")
-
-          (:: (dict.Equivalence Equivalence) = casesSF casesA)
-          redundant-pattern
-
-          ## else
-          (do e.Monad
-            [casesM (monad.fold @
-                                (function (_ [tagA coverageA] casesSF')
-                                  (case (dict.get tagA casesSF')
-                                    (#.Some coverageSF)
-                                    (do @
-                                      [coverageM (merge coverageA coverageSF)]
-                                      (wrap (dict.put tagA coverageM casesSF')))
-
-                                    #.None
-                                    (wrap (dict.put tagA coverageA casesSF'))))
-                                casesSF (dict.entries casesA))]
-            (wrap (if (let [case-coverages (dict.values casesM)]
-                        (and (n/= (cases allSF) (list.size case-coverages))
-                             (list.every? exhaustive? case-coverages)))
-                    #Exhaustive
-                    (#Variant allSF casesM)))))
-
-    [(#Seq leftA rightA) (#Seq leftSF rightSF)]
-    (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)]
-      ## There is nothing the addition adds to the coverage.
-      [#1 #1]
-      redundant-pattern
-
-      ## The 2 sequences cannot possibly be merged.
-      [#0 #0]
-      (error/wrap (#Alt so-far addition))
-
-      ## Same prefix
-      [#1 #0]
-      (do e.Monad
-        [rightM (merge rightA rightSF)]
-        (if (exhaustive? rightM)
-          ## If all that follows is exhaustive, then it can be safely dropped
-          ## (since only the "left" part would influence whether the
-          ## merged coverage is exhaustive or not).
-          (wrap leftSF)
-          (wrap (#Seq leftSF rightM))))
-
-      ## Same suffix
-      [#0 #1]
-      (do e.Monad
-        [leftM (merge leftA leftSF)]
-        (wrap (#Seq leftM rightA))))
-    
-    ## The left part will always match, so the addition is redundant.
-    (^multi [(#Seq left right) single]
-            (coverage/= left single))
-    redundant-pattern
-
-    ## The right part is not necessary, since it can always match the left.
-    (^multi [single (#Seq left right)]
-            (coverage/= left single))
-    (error/wrap single)
-
-    ## When merging a new coverage against one based on Alt, it may be
-    ## that one of the many coverages in the Alt is complementary to
-    ## the new one, so effort must be made to fuse carefully, to match
-    ## the right coverages together.
-    ## If one of the Alt sub-coverages matches the new one, the cycle
-    ## must be repeated, in case the resulting coverage can now match
-    ## other ones in the original Alt.
-    ## This process must be repeated until no further productive
-    ## merges can be done.
-    [_ (#Alt leftS rightS)]
-    (do e.Monad
-      [#let [fuse-once (: (-> Coverage (List Coverage)
-                              (e.Error [(Maybe Coverage)
-                                        (List Coverage)]))
-                          (function (_ coverage possibilities)
-                            (loop [alts possibilities]
-                              (case alts
-                                #.Nil
-                                (wrap [#.None (list coverage)])
-                                
-                                (#.Cons alt alts')
-                                (case (merge coverage alt)
-                                  (#e.Success altM)
-                                  (case altM
-                                    (#Alt _)
-                                    (do @
-                                      [[success alts+] (recur alts')]
-                                      (wrap [success (#.Cons alt alts+)]))
-
-                                    _
-                                    (wrap [(#.Some altM) alts']))
-                                  
-                                  (#e.Error error)
-                                  (e.fail error))
-                                ))))]
-       [success possibilities] (fuse-once addition (flatten-alt so-far))]
-      (loop [success success
-             possibilities possibilities]
-        (case success
-          (#.Some coverage')
-          (do @
-            [[success' possibilities'] (fuse-once coverage' possibilities)]
-            (recur success' possibilities'))
-          
-          #.None
-          (case (list.reverse possibilities)
-            (#.Cons last prevs)
-            (wrap (list/fold (function (_ left right) (#Alt left right))
-                             last
-                             prevs))
-
-            #.Nil
-            (undefined)))))
-
-    _
-    (if (coverage/= so-far addition)
-      ## The addition cannot possibly improve the coverage.
-      redundant-pattern
-      ## There are now 2 alternative paths.
-      (error/wrap (#Alt so-far addition)))))
diff --git a/stdlib/source/lux/language/compiler/analysis/expression.lux b/stdlib/source/lux/language/compiler/analysis/expression.lux
deleted file mode 100644
index 1c74499ad..000000000
--- a/stdlib/source/lux/language/compiler/analysis/expression.lux
+++ /dev/null
@@ -1,121 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["e" error]
-    [text
-     format]]
-   ["." macro]]
-  ["." // (#+ Analysis Operation Compiler)
-   ["." type]
-   ["." primitive]
-   ["." structure]
-   ["." reference]
-   ["/." //
-    ["." extension]
-    ["//." // (#+ Eval)
-     ## [".L" macro]
-     ]]])
-
-(exception: #export (macro-expansion-failed {message Text})
-  message)
-
-(do-template []
-  [(exception: #export ( {code Code})
-     (%code code))]
-
-  [macro-call-must-have-single-expansion]
-  [unrecognized-syntax]
-  )
-
-(def: #export (analyser eval)
-  (-> Eval Compiler)
-  (function (compile code)
-    (do ///.Monad
-      [expectedT (extension.lift macro.expected-type)]
-      (let [[cursor code'] code]
-        ## The cursor must be set in the compiler for the sake
-        ## of having useful error messages.
-        (//.with-cursor cursor
-          (case code'
-            (^template [ ]
-              ( value)
-              ( value))
-            ([#.Bit  primitive.bit]
-             [#.Nat  primitive.nat]
-             [#.Int  primitive.int]
-             [#.Rev  primitive.rev]
-             [#.Frac primitive.frac]
-             [#.Text primitive.text])
-
-            (^template [ ]
-              (^ (#.Form (list& [_ ( tag)]
-                                values)))
-              (case values
-                (#.Cons value #.Nil)
-                ( compile tag value)
-
-                _
-                ( compile tag (` [(~+ values)]))))
-            ([#.Nat structure.sum]
-             [#.Tag structure.tagged-sum])
-
-            (#.Tag tag)
-            (structure.tagged-sum compile tag (' []))
-
-            (^ (#.Tuple (list)))
-            primitive.unit
-
-            (^ (#.Tuple (list singleton)))
-            (compile singleton)
-
-            (^ (#.Tuple elems))
-            (structure.product compile elems)
-
-            (^ (#.Record pairs))
-            (structure.record compile pairs)
-
-            (#.Symbol reference)
-            (reference.reference reference)
-
-            (^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
-            (extension.apply compile [extension-name extension-args])
-
-            ## (^ (#.Form (list& func args)))
-            ## (do ///.Monad
-            ##   [[funcT funcA] (type.with-inference
-            ##                    (compile func))]
-            ##   (case funcA
-            ##     [_ (#.Symbol def-name)]
-            ##     (do @
-            ##       [?macro (///.with-error-tracking
-            ##                 (extension.lift (macro.find-macro def-name)))]
-            ##       (case ?macro
-            ##         (#.Some macro)
-            ##         (do @
-            ##           [expansion (: (Operation (List Code))
-            ##                         (function (_ compiler)
-            ##                           (case (macroL.expand macro args compiler)
-            ##                             (#e.Error error)
-            ##                             ((///.throw macro-expansion-failed error) compiler)
-
-            ##                             output
-            ##                             output)))]
-            ##           (case expansion
-            ##             (^ (list single))
-            ##             (compile single)
-
-            ##             _
-            ##             (///.throw macro-call-must-have-single-expansion code)))
-
-            ##         _
-            ##         (functionA.apply compile funcT funcA args)))
-
-            ##     _
-            ##     (functionA.apply compile funcT funcA args)))
-
-            _
-            (///.throw unrecognized-syntax code)
-            ))))))
diff --git a/stdlib/source/lux/language/compiler/analysis/function.lux b/stdlib/source/lux/language/compiler/analysis/function.lux
deleted file mode 100644
index d12880afa..000000000
--- a/stdlib/source/lux/language/compiler/analysis/function.lux
+++ /dev/null
@@ -1,102 +0,0 @@
-(.module:
-  [lux (#- function)
-   [control
-    monad
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." maybe]
-    ["." text
-     format]
-    [collection
-     ["." list ("list/." Fold Monoid Monad)]]]
-   ["." type
-    ["." check]]
-   ["." macro]]
-  ["." // (#+ Analysis Operation Compiler)
-   ["." scope]
-   ["//." type]
-   ["." inference]
-   ["/." //
-    ["." extension]]])
-
-(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code})
-  (ex.report ["Type" (%type expected)]
-             ["Function" function]
-             ["Argument" argument]
-             ["Body" (%code body)]))
-
-(exception: #export (cannot-apply {function Type} {arguments (List Code)})
-  (ex.report [" Function" (%type function)]
-             ["Arguments" (|> arguments
-                              list.enumerate
-                              (list/map (.function (_ [idx argC])
-                                          (format "\n  " (%n idx) " " (%code argC))))
-                              (text.join-with ""))]))
-
-(def: #export (function analyse function-name arg-name body)
-  (-> Compiler Text Text Code (Operation Analysis))
-  (do ///.Monad
-    [functionT (extension.lift macro.expected-type)]
-    (loop [expectedT functionT]
-      (///.with-stack cannot-analyse [expectedT function-name arg-name body]
-        (case expectedT
-          (#.Named name unnamedT)
-          (recur unnamedT)
-
-          (#.Apply argT funT)
-          (case (type.apply (list argT) funT)
-            (#.Some value)
-            (recur value)
-
-            #.None
-            (///.fail (ex.construct cannot-analyse [expectedT function-name arg-name body])))
-
-          (^template [ ]
-            ( _)
-            (do @
-              [[_ instanceT] (//type.with-env )]
-              (recur (maybe.assume (type.apply (list instanceT) expectedT)))))
-          ([#.UnivQ check.existential]
-           [#.ExQ check.var])
-          
-          (#.Var id)
-          (do @
-            [?expectedT' (//type.with-env
-                           (check.read id))]
-            (case ?expectedT'
-              (#.Some expectedT')
-              (recur expectedT')
-
-              ## Inference
-              _
-              (do @
-                [[input-id inputT] (//type.with-env check.var)
-                 [output-id outputT] (//type.with-env check.var)
-                 #let [functionT (#.Function inputT outputT)]
-                 functionA (recur functionT)
-                 _ (//type.with-env
-                     (check.check expectedT functionT))]
-                (wrap functionA))
-              ))
-
-          (#.Function inputT outputT)
-          (<| (:: @ map (.function (_ [scope bodyA])
-                          (#//.Function (scope.environment scope) bodyA)))
-              //.with-scope
-              ## Functions have access not only to their argument, but
-              ## also to themselves, through a local variable.
-              (scope.with-local [function-name expectedT])
-              (scope.with-local [arg-name inputT])
-              (//type.with-type outputT)
-              (analyse body))
-          
-          _
-          (///.fail "")
-          )))))
-
-(def: #export (apply analyse functionT functionA argsC+)
-  (-> Compiler Type Analysis (List Code) (Operation Analysis))
-  (<| (///.with-stack cannot-apply [functionT argsC+])
-      (do ///.Monad
-        [[applyT argsA+] (inference.general analyse functionT argsC+)])
-      (wrap (//.apply [functionA argsA+]))))
diff --git a/stdlib/source/lux/language/compiler/analysis/inference.lux b/stdlib/source/lux/language/compiler/analysis/inference.lux
deleted file mode 100644
index 160978d39..000000000
--- a/stdlib/source/lux/language/compiler/analysis/inference.lux
+++ /dev/null
@@ -1,259 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." maybe]
-    ["." text
-     format]
-    [collection
-     ["." list ("list/." Functor)]]]
-   ["." type
-    ["." check]]
-   ["." macro]]
-  ["." /// ("operation/." Monad)
-   ["." extension]]
-  [// (#+ Tag Analysis Operation Compiler)]
-  ["." //type])
-
-(exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type})
-  (ex.report ["Tag" (%n tag)]
-             ["Variant size" (%i (.int size))]
-             ["Variant type" (%type type)]))
-
-(exception: #export (cannot-infer {type Type} {args (List Code)})
-  (ex.report ["Type" (%type type)]
-             ["Arguments" (|> args
-                              list.enumerate
-                              (list/map (function (_ [idx argC])
-                                          (format "\n  " (%n idx) " " (%code argC))))
-                              (text.join-with ""))]))
-
-(exception: #export (cannot-infer-argument {inferred Type} {argument Code})
-  (ex.report ["Inferred Type" (%type inferred)]
-             ["Argument" (%code argument)]))
-
-(exception: #export (smaller-variant-than-expected {expected Nat} {actual Nat})
-  (ex.report ["Expected" (%i (.int expected))]
-             ["Actual" (%i (.int actual))]))
-
-(do-template []
-  [(exception: #export ( {type Type})
-     (%type type))]
-
-  [not-a-variant-type]
-  [not-a-record-type]
-  [invalid-type-application]
-  )
-
-(def: (replace parameter-idx replacement type)
-  (-> Nat Type Type Type)
-  (case type
-    (#.Primitive name params)
-    (#.Primitive name (list/map (replace parameter-idx replacement) params))
-
-    (^template []
-      ( left right)
-      ( (replace parameter-idx replacement left)
-             (replace parameter-idx replacement right)))
-    ([#.Sum]
-     [#.Product]
-     [#.Function]
-     [#.Apply])
-    
-    (#.Parameter idx)
-    (if (n/= parameter-idx idx)
-      replacement
-      type)
-
-    (^template []
-      ( env quantified)
-      ( (list/map (replace parameter-idx replacement) env)
-             (replace (n/+ +2 parameter-idx) replacement quantified)))
-    ([#.UnivQ]
-     [#.ExQ])
-    
-    _
-    type))
-
-(def: (named-type cursor id)
-  (-> Cursor Nat Type)
-  (let [name (format "{New Type @ " (.cursor-description cursor) " " (%n id) "}")]
-    (#.Primitive name (list))))
-
-(def: new-named-type
-  (Operation Type)
-  (do ///.Monad
-    [cursor (extension.lift macro.cursor)
-     [ex-id _] (//type.with-env check.existential)]
-    (wrap (named-type cursor ex-id))))
-
-## Type-inference works by applying some (potentially quantified) type
-## to a sequence of values.
-## Function types are used for this, although inference is not always
-## done for function application (alternative uses may be records and
-## tagged variants).
-## But, so long as the type being used for the inference can be treated
-## as a function type, this method of inference should work.
-(def: #export (general analyse inferT args)
-  (-> Compiler Type (List Code) (Operation [Type (List Analysis)]))
-  (case args
-    #.Nil
-    (do ///.Monad
-      [_ (//type.infer inferT)]
-      (wrap [inferT (list)]))
-    
-    (#.Cons argC args')
-    (case inferT
-      (#.Named name unnamedT)
-      (general analyse unnamedT args)
-
-      (#.UnivQ _)
-      (do ///.Monad
-        [[var-id varT] (//type.with-env check.var)]
-        (general analyse (maybe.assume (type.apply (list varT) inferT)) args))
-
-      (#.ExQ _)
-      (do ///.Monad
-        [[var-id varT] (//type.with-env check.var)
-         output (general analyse
-                         (maybe.assume (type.apply (list varT) inferT))
-                         args)
-         bound? (//type.with-env
-                  (check.bound? var-id))
-         _ (if bound?
-             (wrap [])
-             (do @
-               [newT new-named-type]
-               (//type.with-env
-                 (check.check varT newT))))]
-        (wrap output))
-
-      (#.Apply inputT transT)
-      (case (type.apply (list inputT) transT)
-        (#.Some outputT)
-        (general analyse outputT args)
-
-        #.None
-        (///.throw invalid-type-application inferT))
-
-      ## Arguments are inferred back-to-front because, by convention,
-      ## Lux functions take the most important arguments *last*, which
-      ## means that the most information for doing proper inference is
-      ## located in the last arguments to a function call.
-      ## By inferring back-to-front, a lot of type-annotations can be
-      ## avoided in Lux code, since the inference algorithm can piece
-      ## things together more easily.
-      (#.Function inputT outputT)
-      (do ///.Monad
-        [[outputT' args'A] (general analyse outputT args')
-         argA (<| (///.with-stack cannot-infer-argument [inputT argC])
-                  (//type.with-type inputT)
-                  (analyse argC))]
-        (wrap [outputT' (list& argA args'A)]))
-
-      (#.Var infer-id)
-      (do ///.Monad
-        [?inferT' (//type.with-env (check.read infer-id))]
-        (case ?inferT'
-          (#.Some inferT')
-          (general analyse inferT' args)
-
-          _
-          (///.throw cannot-infer [inferT args])))
-
-      _
-      (///.throw cannot-infer [inferT args]))
-    ))
-
-## Turns a record type into the kind of function type suitable for inference.
-(def: #export (record inferT)
-  (-> Type (Operation Type))
-  (case inferT
-    (#.Named name unnamedT)
-    (record unnamedT)
-
-    (^template []
-      ( env bodyT)
-      (do ///.Monad
-        [bodyT+ (record bodyT)]
-        (wrap ( env bodyT+))))
-    ([#.UnivQ]
-     [#.ExQ])
-
-    (#.Apply inputT funcT)
-    (case (type.apply (list inputT) funcT)
-      (#.Some outputT)
-      (record outputT)
-
-      #.None
-      (///.throw invalid-type-application inferT))
-
-    (#.Product _)
-    (operation/wrap (type.function (type.flatten-tuple inferT) inferT))
-
-    _
-    (///.throw not-a-record-type inferT)))
-
-## Turns a variant type into the kind of function type suitable for inference.
-(def: #export (variant tag expected-size inferT)
-  (-> Nat Nat Type (Operation Type))
-  (loop [depth +0
-         currentT inferT]
-    (case currentT
-      (#.Named name unnamedT)
-      (do ///.Monad
-        [unnamedT+ (recur depth unnamedT)]
-        (wrap unnamedT+))
-
-      (^template []
-        ( env bodyT)
-        (do ///.Monad
-          [bodyT+ (recur (inc depth) bodyT)]
-          (wrap ( env bodyT+))))
-      ([#.UnivQ]
-       [#.ExQ])
-
-      (#.Sum _)
-      (let [cases (type.flatten-variant currentT)
-            actual-size (list.size cases)
-            boundary (dec expected-size)]
-        (cond (or (n/= expected-size actual-size)
-                  (and (n/> expected-size actual-size)
-                       (n/< boundary tag)))
-              (case (list.nth tag cases)
-                (#.Some caseT)
-                (operation/wrap (if (n/= +0 depth)
-                                  (type.function (list caseT) currentT)
-                                  (let [replace' (replace (|> depth dec (n/* +2)) inferT)]
-                                    (type.function (list (replace' caseT))
-                                      (replace' currentT)))))
-
-                #.None
-                (///.throw variant-tag-out-of-bounds [expected-size tag inferT]))
-              
-              (n/< expected-size actual-size)
-              (///.throw smaller-variant-than-expected [expected-size actual-size])
-
-              (n/= boundary tag)
-              (let [caseT (type.variant (list.drop boundary cases))]
-                (operation/wrap (if (n/= +0 depth)
-                                  (type.function (list caseT) currentT)
-                                  (let [replace' (replace (|> depth dec (n/* +2)) inferT)]
-                                    (type.function (list (replace' caseT))
-                                      (replace' currentT))))))
-              
-              ## else
-              (///.throw variant-tag-out-of-bounds [expected-size tag inferT])))
-
-      (#.Apply inputT funcT)
-      (case (type.apply (list inputT) funcT)
-        (#.Some outputT)
-        (variant tag expected-size outputT)
-
-        #.None
-        (///.throw invalid-type-application inferT))
-
-      _
-      (///.throw not-a-variant-type inferT))))
diff --git a/stdlib/source/lux/language/compiler/analysis/module.lux b/stdlib/source/lux/language/compiler/analysis/module.lux
deleted file mode 100644
index adc442c1f..000000000
--- a/stdlib/source/lux/language/compiler/analysis/module.lux
+++ /dev/null
@@ -1,255 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    pipe]
-   [data
-    ["." text ("text/." Equivalence)
-     format]
-    ["." error]
-    [collection
-     ["." list ("list/." Fold Functor)]
-     [dictionary
-      ["." plist]]]]
-   ["." macro]]
-  ["." // (#+ Operation)
-   ["/." //
-    ["." extension]]])
-
-(type: #export Tag Text)
-
-(exception: #export (unknown-module {module Text})
-  module)
-
-(exception: #export (cannot-declare-tag-twice {module Text} {tag Text})
-  (ex.report ["Module" module]
-             ["Tag" tag]))
-
-(do-template []
-  [(exception: #export ( {tags (List Text)} {owner Type})
-     (ex.report ["Tags" (text.join-with " " tags)]
-                ["Type" (%type owner)]))]
-
-  [cannot-declare-tags-for-unnamed-type]
-  [cannot-declare-tags-for-foreign-type]
-  )
-
-(exception: #export (cannot-define-more-than-once {name Ident})
-  (%ident name))
-
-(exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State})
-  (ex.report ["Module" module]
-             ["Desired state" (case state
-                                #.Active   "Active"
-                                #.Compiled "Compiled"
-                                #.Cached   "Cached")]))
-
-(exception: #export (cannot-set-module-annotations-more-than-once {module Text} {old Code} {new Code})
-  (ex.report ["Module" module]
-             ["Old annotations" (%code old)]
-             ["New annotations" (%code new)]))
-
-(def: (new hash)
-  (-> Nat Module)
-  {#.module-hash        hash
-   #.module-aliases     (list)
-   #.definitions        (list)
-   #.imports            (list)
-   #.tags               (list)
-   #.types              (list)
-   #.module-annotations #.None
-   #.module-state       #.Active})
-
-(def: #export (set-annotations annotations)
-  (-> Code (Operation Any))
-  (do ///.Monad
-    [self-name (extension.lift macro.current-module-name)
-     self (extension.lift macro.current-module)]
-    (case (get@ #.module-annotations self)
-      #.None
-      (extension.lift
-       (function (_ state)
-         (#error.Success [(update@ #.modules
-                                   (plist.put self-name (set@ #.module-annotations (#.Some annotations) self))
-                                   state)
-                          []])))
-      
-      (#.Some old)
-      (///.throw cannot-set-module-annotations-more-than-once [self-name old annotations]))))
-
-(def: #export (import module)
-  (-> Text (Operation Any))
-  (do ///.Monad
-    [self-name (extension.lift macro.current-module-name)]
-    (extension.lift
-     (function (_ state)
-       (#error.Success [(update@ #.modules
-                                 (plist.update self-name (update@ #.imports (|>> (#.Cons module))))
-                                 state)
-                        []])))))
-
-(def: #export (alias alias module)
-  (-> Text Text (Operation Any))
-  (do ///.Monad
-    [self-name (extension.lift macro.current-module-name)]
-    (extension.lift
-     (function (_ state)
-       (#error.Success [(update@ #.modules
-                                 (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
-                                                                                      (|>> (#.Cons [alias module])))))
-                                 state)
-                        []])))))
-
-(def: #export (exists? module)
-  (-> Text (Operation Bit))
-  (extension.lift
-   (function (_ state)
-     (|> state
-         (get@ #.modules)
-         (plist.get module)
-         (case> (#.Some _) #1 #.None #0)
-         [state] #error.Success))))
-
-(def: #export (define name definition)
-  (-> Text Definition (Operation []))
-  (do ///.Monad
-    [self-name (extension.lift macro.current-module-name)
-     self (extension.lift macro.current-module)]
-    (extension.lift
-     (function (_ state)
-       (case (plist.get name (get@ #.definitions self))
-         #.None
-         (#error.Success [(update@ #.modules
-                                   (plist.put self-name
-                                              (update@ #.definitions
-                                                       (: (-> (List [Text Definition]) (List [Text Definition]))
-                                                          (|>> (#.Cons [name definition])))
-                                                       self))
-                                   state)
-                          []])
-
-         (#.Some already-existing)
-         ((///.throw cannot-define-more-than-once [self-name name]) state))))))
-
-(def: #export (create hash name)
-  (-> Nat Text (Operation []))
-  (extension.lift
-   (function (_ state)
-     (let [module (new hash)]
-       (#error.Success [(update@ #.modules
-                                 (plist.put name module)
-                                 state)
-                        []])))))
-
-(def: #export (with-module hash name action)
-  (All [a] (-> Nat Text (Operation a) (Operation [Module a])))
-  (do ///.Monad
-    [_ (create hash name)
-     output (//.with-current-module name
-              action)
-     module (extension.lift (macro.find-module name))]
-    (wrap [module output])))
-
-(do-template [  ]
-  [(def: #export ( module-name)
-     (-> Text (Operation Any))
-     (extension.lift
-      (function (_ state)
-        (case (|> state (get@ #.modules) (plist.get module-name))
-          (#.Some module)
-          (let [active? (case (get@ #.module-state module)
-                          #.Active #1
-                          _        #0)]
-            (if active?
-              (#error.Success [(update@ #.modules
-                                        (plist.put module-name (set@ #.module-state  module))
-                                        state)
-                               []])
-              ((///.throw can-only-change-state-of-active-module [module-name ])
-               state)))
-
-          #.None
-          ((///.throw unknown-module module-name) state)))))
-   
-   (def: #export ( module-name)
-     (-> Text (Operation Bit))
-     (extension.lift
-      (function (_ state)
-        (case (|> state (get@ #.modules) (plist.get module-name))
-          (#.Some module)
-          (#error.Success [state
-                           (case (get@ #.module-state module)
-                              #1
-                             _     #0)])
-
-          #.None
-          ((///.throw unknown-module module-name) state)))))]
-
-  [set-active   active?   #.Active]
-  [set-compiled compiled? #.Compiled]
-  [set-cached   cached?   #.Cached]
-  )
-
-(do-template [  ]
-  [(def: ( module-name)
-     (-> Text (Operation ))
-     (extension.lift
-      (function (_ state)
-        (case (|> state (get@ #.modules) (plist.get module-name))
-          (#.Some module)
-          (#error.Success [state (get@  module)])
-
-          #.None
-          ((///.throw unknown-module module-name) state)))))]
-
-  [tags  #.tags        (List [Text [Nat (List Ident) Bit Type]])]
-  [types #.types       (List [Text [(List Ident) Bit Type]])]
-  [hash  #.module-hash Nat]
-  )
-
-(def: (ensure-undeclared-tags module-name tags)
-  (-> Text (List Tag) (Operation Any))
-  (do ///.Monad
-    [bindings (..tags module-name)
-     _ (monad.map @
-                  (function (_ tag)
-                    (case (plist.get tag bindings)
-                      #.None
-                      (wrap [])
-
-                      (#.Some _)
-                      (///.throw cannot-declare-tag-twice [module-name tag])))
-                  tags)]
-    (wrap [])))
-
-(def: #export (declare-tags tags exported? type)
-  (-> (List Tag) Bit Type (Operation Any))
-  (do ///.Monad
-    [self-name (extension.lift macro.current-module-name)
-     [type-module type-name] (case type
-                               (#.Named type-ident _)
-                               (wrap type-ident)
-
-                               _
-                               (///.throw cannot-declare-tags-for-unnamed-type [tags type]))
-     _ (ensure-undeclared-tags self-name tags)
-     _ (///.assert cannot-declare-tags-for-foreign-type [tags type]
-                   (text/= self-name type-module))]
-    (extension.lift
-     (function (_ state)
-       (case (|> state (get@ #.modules) (plist.get self-name))
-         (#.Some module)
-         (let [namespaced-tags (list/map (|>> [self-name]) tags)]
-           (#error.Success [(update@ #.modules
-                                     (plist.update self-name
-                                                   (|>> (update@ #.tags (function (_ tag-bindings)
-                                                                          (list/fold (function (_ [idx tag] table)
-                                                                                       (plist.put tag [idx namespaced-tags exported? type] table))
-                                                                                     tag-bindings
-                                                                                     (list.enumerate tags))))
-                                                        (update@ #.types (plist.put type-name [namespaced-tags exported? type]))))
-                                     state)
-                            []]))
-         #.None
-         ((///.throw unknown-module self-name) state))))))
diff --git a/stdlib/source/lux/language/compiler/analysis/primitive.lux b/stdlib/source/lux/language/compiler/analysis/primitive.lux
deleted file mode 100644
index bd42825d3..000000000
--- a/stdlib/source/lux/language/compiler/analysis/primitive.lux
+++ /dev/null
@@ -1,29 +0,0 @@
-(.module:
-  [lux (#- nat int rev)
-   [control
-    monad]]
-  ["." // (#+ Analysis Operation)
-   [".A" type]
-   ["/." //]])
-
-## [Analysers]
-(do-template [  ]
-  [(def: #export ( value)
-     (->  (Operation Analysis))
-     (do ///.Monad
-       [_ (typeA.infer )]
-       (wrap (#//.Primitive ( value)))))]
-
-  [bit  Bit  #//.Bit]
-  [nat  Nat  #//.Nat]
-  [int  Int  #//.Int]
-  [rev  Rev  #//.Rev]
-  [frac Frac #//.Frac]
-  [text Text #//.Text]
-  )
-
-(def: #export unit
-  (Operation Analysis)
-  (do ///.Monad
-    [_ (typeA.infer Any)]
-    (wrap (#//.Primitive #//.Unit))))
diff --git a/stdlib/source/lux/language/compiler/analysis/reference.lux b/stdlib/source/lux/language/compiler/analysis/reference.lux
deleted file mode 100644
index bb78a32fb..000000000
--- a/stdlib/source/lux/language/compiler/analysis/reference.lux
+++ /dev/null
@@ -1,79 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    monad
-    ["ex" exception (#+ exception:)]]
-   ["." macro]
-   [data
-    [text ("text/." Equivalence)
-     format]]]
-  ["." // (#+ Analysis Operation)
-   ["." scope]
-   ["." type]
-   ["/." //
-    ["." extension]
-    [//
-     ["." reference]]]])
-
-(exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text})
-  (ex.report ["Current" current]
-             ["Foreign" foreign]))
-
-(exception: #export (definition-has-not-been-expored {definition Ident})
-  (ex.report ["Definition" (%ident definition)]))
-
-## [Analysers]
-(def: (definition def-name)
-  (-> Ident (Operation Analysis))
-  (with-expansions [ (wrap (|> def-name reference.constant #//.Reference))]
-    (do ///.Monad
-      [[actualT def-anns _] (extension.lift (macro.find-def def-name))]
-      (case (macro.get-symbol-ann (ident-for #.alias) def-anns)
-        (#.Some real-def-name)
-        (definition real-def-name)
-
-        _
-        (do @
-          [_ (type.infer actualT)
-           (^@ def-name [::module ::name]) (extension.lift (macro.normalize def-name))
-           current (extension.lift macro.current-module-name)]
-          (if (text/= current ::module)
-            
-            (if (macro.export? def-anns)
-              (do @
-                [imported! (extension.lift (macro.imported-by? ::module current))]
-                (if imported!
-                  
-                  (///.throw foreign-module-has-not-been-imported [current ::module])))
-              (///.throw definition-has-not-been-expored def-name))))))))
-
-(def: (variable var-name)
-  (-> Text (Operation (Maybe Analysis)))
-  (do ///.Monad
-    [?var (scope.find var-name)]
-    (case ?var
-      (#.Some [actualT ref])
-      (do @
-        [_ (type.infer actualT)]
-        (wrap (#.Some (|> ref reference.variable #//.Reference))))
-
-      #.None
-      (wrap #.None))))
-
-(def: #export (reference reference)
-  (-> Ident (Operation Analysis))
-  (case reference
-    ["" simple-name]
-    (do ///.Monad
-      [?var (variable simple-name)]
-      (case ?var
-        (#.Some varA)
-        (wrap varA)
-
-        #.None
-        (do @
-          [this-module (extension.lift macro.current-module-name)]
-          (definition [this-module simple-name]))))
-
-    _
-    (definition reference)))
diff --git a/stdlib/source/lux/language/compiler/analysis/scope.lux b/stdlib/source/lux/language/compiler/analysis/scope.lux
deleted file mode 100644
index 108e450e1..000000000
--- a/stdlib/source/lux/language/compiler/analysis/scope.lux
+++ /dev/null
@@ -1,197 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    monad]
-   [data
-    [text ("text/." Equivalence)
-     format]
-    ["." maybe ("maybe/." Monad)]
-    ["." product]
-    ["e" error]
-    [collection
-     ["." list ("list/." Functor Fold Monoid)]
-     [dictionary
-      ["." plist]]]]]
-  [// (#+ Operation Compiler)
-   ["/." //
-    ["." extension]
-    [//
-     ["." reference (#+ Register Variable)]]]])
-
-(type: Local (Bindings Text [Type Register]))
-(type: Foreign (Bindings Text [Type Variable]))
-
-(def: (local? name scope)
-  (-> Text Scope Bit)
-  (|> scope
-      (get@ [#.locals #.mappings])
-      (plist.contains? name)))
-
-(def: (local name scope)
-  (-> Text Scope (Maybe [Type Variable]))
-  (|> scope
-      (get@ [#.locals #.mappings])
-      (plist.get name)
-      (maybe/map (function (_ [type value])
-                   [type (#reference.Local value)]))))
-
-(def: (captured? name scope)
-  (-> Text Scope Bit)
-  (|> scope
-      (get@ [#.captured #.mappings])
-      (plist.contains? name)))
-
-(def: (captured name scope)
-  (-> Text Scope (Maybe [Type Variable]))
-  (loop [idx +0
-         mappings (get@ [#.captured #.mappings] scope)]
-    (case mappings
-      #.Nil
-      #.None
-
-      (#.Cons [_name [_source-type _source-ref]] mappings')
-      (if (text/= name _name)
-        (#.Some [_source-type (#reference.Foreign idx)])
-        (recur (inc idx) mappings')))))
-
-(def: (reference? name scope)
-  (-> Text Scope Bit)
-  (or (local? name scope)
-      (captured? name scope)))
-
-(def: (reference name scope)
-  (-> Text Scope (Maybe [Type Variable]))
-  (case (..local name scope)
-    (#.Some type)
-    (#.Some type)
-
-    _
-    (..captured name scope)))
-
-(def: #export (find name)
-  (-> Text (Operation (Maybe [Type Variable])))
-  (extension.lift
-   (function (_ state)
-     (let [[inner outer] (|> state
-                             (get@ #.scopes)
-                             (list.split-with (|>> (reference? name) not)))]
-       (case outer
-         #.Nil
-         (#.Right [state #.None])
-
-         (#.Cons top-outer _)
-         (let [[ref-type init-ref] (maybe.default (undefined)
-                                                  (..reference name top-outer))
-               [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)])
-                                          (function (_ scope ref+inner)
-                                            [(#reference.Foreign (get@ [#.captured #.counter] scope))
-                                             (#.Cons (update@ #.captured
-                                                              (: (-> Foreign Foreign)
-                                                                 (|>> (update@ #.counter inc)
-                                                                      (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)]))))
-                                                              scope)
-                                                     (product.right ref+inner))]))
-                                       [init-ref #.Nil]
-                                       (list.reverse inner))
-               scopes (list/compose inner' outer)]
-           (#.Right [(set@ #.scopes scopes state)
-                     (#.Some [ref-type ref])]))
-         )))))
-
-(def: #export (with-local [name type] action)
-  (All [a] (-> [Text Type] (Operation a) (Operation a)))
-  (function (_ [bundle state])
-    (case (get@ #.scopes state)
-      (#.Cons head tail)
-      (let [old-mappings (get@ [#.locals #.mappings] head)
-            new-var-id (get@ [#.locals #.counter] head)
-            new-head (update@ #.locals
-                              (: (-> Local Local)
-                                 (|>> (update@ #.counter inc)
-                                      (update@ #.mappings (plist.put name [type new-var-id]))))
-                              head)]
-        (case (///.run' [bundle (set@ #.scopes (#.Cons new-head tail) state)]
-                        action)
-          (#e.Success [[bundle' state'] output])
-          (case (get@ #.scopes state')
-            (#.Cons head' tail')
-            (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
-                                  tail')]
-              (#e.Success [[bundle' (set@ #.scopes scopes' state')]
-                           output]))
-
-            _
-            (error! "Invalid scope alteration."))
-
-          (#e.Error error)
-          (#e.Error error)))
-
-      _
-      (#e.Error "Cannot create local binding without a scope."))
-    ))
-
-(do-template [ ]
-  [(def: 
-     (Bindings Text [Type ])
-     {#.counter +0
-      #.mappings (list)})]
-
-  [init-locals   Nat]
-  [init-captured Variable]
-  )
-
-(def: (scope parent-name child-name)
-  (-> (List Text) Text Scope)
-  {#.name     (list& child-name parent-name)
-   #.inner    +0
-   #.locals   init-locals
-   #.captured init-captured})
-
-(def: #export (with-scope name action)
-  (All [a] (-> Text (Operation a) (Operation a)))
-  (function (_ [bundle state])
-    (let [parent-name (case (get@ #.scopes state)
-                        #.Nil
-                        (list)
-                        
-                        (#.Cons top _)
-                        (get@ #.name top))]
-      (case (action [bundle (update@ #.scopes
-                                     (|>> (#.Cons (scope parent-name name)))
-                                     state)])
-        (#e.Error error)
-        (#e.Error error)
-
-        (#e.Success [[bundle' state'] output])
-        (#e.Success [[bundle' (update@ #.scopes
-                                       (|>> list.tail (maybe.default (list)))
-                                       state')]
-                     output])
-        ))
-    ))
-
-(def: #export next-local
-  (Operation Register)
-  (extension.lift
-   (function (_ state)
-     (case (get@ #.scopes state)
-       #.Nil
-       (#e.Error "Cannot get next reference when there is no scope.")
-       
-       (#.Cons top _)
-       (#e.Success [state (get@ [#.locals #.counter] top)])))))
-
-(def: (ref-to-variable ref)
-  (-> Ref Variable)
-  (case ref
-    (#.Local register)
-    (#reference.Local register)
-    
-    (#.Captured register)
-    (#reference.Foreign register)))
-
-(def: #export (environment scope)
-  (-> Scope (List Variable))
-  (|> scope
-      (get@ [#.captured #.mappings])
-      (list/map (function (_ [_ [_ ref]]) (ref-to-variable ref)))))
diff --git a/stdlib/source/lux/language/compiler/analysis/structure.lux b/stdlib/source/lux/language/compiler/analysis/structure.lux
deleted file mode 100644
index b2eb5dc17..000000000
--- a/stdlib/source/lux/language/compiler/analysis/structure.lux
+++ /dev/null
@@ -1,360 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." ident]
-    ["." number]
-    ["." product]
-    ["." maybe]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Functor)]
-     ["dict" dictionary (#+ Dictionary)]]]
-   ["." type
-    ["." check]]
-   ["." macro
-    ["." code]]]
-  ["." // (#+ Tag Analysis Operation Compiler)
-   ["//." type]
-   ["." primitive]
-   ["." inference]
-   ["/." //
-    ["." extension]
-    ["//." //]]])
-
-(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code})
-  (ex.report ["Type" (%type type)]
-             ["Tag" (%n tag)]
-             ["Expression" (%code code)]))
-
-(do-template []
-  [(exception: #export ( {type Type} {members (List Code)})
-     (ex.report ["Type" (%type type)]
-                ["Expression" (%code (` [(~+ members)]))]))]
-
-  [invalid-tuple-type]
-  [cannot-analyse-tuple]
-  )
-
-(exception: #export (not-a-quantified-type {type Type})
-  (%type type))
-
-(do-template []
-  [(exception: #export ( {type Type} {tag Tag} {code Code})
-     (ex.report ["Type" (%type type)]
-                ["Tag" (%n tag)]
-                ["Expression" (%code code)]))]
-
-  [cannot-analyse-variant]
-  [cannot-infer-numeric-tag]
-  )
-
-(exception: #export (record-keys-must-be-tags {key Code} {record (List [Code Code])})
-  (ex.report ["Key" (%code key)]
-             ["Record" (%code (code.record record))]))
-
-(do-template []
-  [(exception: #export ( {key Ident} {record (List [Ident Code])})
-     (ex.report ["Tag" (%code (code.tag key))]
-                ["Record" (%code (code.record (list/map (function (_ [keyI valC])
-                                                          [(code.tag keyI) valC])
-                                                        record)))]))]
-
-  [cannot-repeat-tag]
-  )
-
-(exception: #export (tag-does-not-belong-to-record {key Ident} {type Type})
-  (ex.report ["Tag" (%code (code.tag key))]
-             ["Type" (%type type)]))
-
-(exception: #export (record-size-mismatch {expected Nat} {actual Nat} {type Type} {record (List [Ident Code])})
-  (ex.report ["Expected" (|> expected .int %i)]
-             ["Actual" (|> actual .int %i)]
-             ["Type" (%type type)]
-             ["Expression" (%code (|> record
-                                      (list/map (function (_ [keyI valueC])
-                                                  [(code.tag keyI) valueC]))
-                                      code.record))]))
-
-(def: #export (sum analyse tag valueC)
-  (-> Compiler Nat Code (Operation Analysis))
-  (do ///.Monad
-    [expectedT (extension.lift macro.expected-type)]
-    (///.with-stack cannot-analyse-variant [expectedT tag valueC]
-      (case expectedT
-        (#.Sum _)
-        (let [flat (type.flatten-variant expectedT)
-              type-size (list.size flat)]
-          (case (list.nth tag flat)
-            (#.Some variant-type)
-            (do @
-              [valueA (//type.with-type variant-type
-                        (analyse valueC))]
-              (wrap (//.sum-analysis type-size tag valueA)))
-
-            #.None
-            (///.throw inference.variant-tag-out-of-bounds [type-size tag expectedT])))
-
-        (#.Named name unnamedT)
-        (//type.with-type unnamedT
-          (sum analyse tag valueC))
-
-        (#.Var id)
-        (do @
-          [?expectedT' (//type.with-env
-                         (check.read id))]
-          (case ?expectedT'
-            (#.Some expectedT')
-            (//type.with-type expectedT'
-              (sum analyse tag valueC))
-
-            _
-            ## Cannot do inference when the tag is numeric.
-            ## This is because there is no way of knowing how many
-            ## cases the inferred sum type would have.
-            (///.throw cannot-infer-numeric-tag [expectedT tag valueC])
-            ))
-
-        (^template [ ]
-          ( _)
-          (do @
-            [[instance-id instanceT] (//type.with-env )]
-            (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
-              (sum analyse tag valueC))))
-        ([#.UnivQ check.existential]
-         [#.ExQ check.var])
-
-        (#.Apply inputT funT)
-        (case funT
-          (#.Var funT-id)
-          (do @
-            [?funT' (//type.with-env (check.read funT-id))]
-            (case ?funT'
-              (#.Some funT')
-              (//type.with-type (#.Apply inputT funT')
-                (sum analyse tag valueC))
-
-              _
-              (///.throw invalid-variant-type [expectedT tag valueC])))
-
-          _
-          (case (type.apply (list inputT) funT)
-            #.None
-            (///.throw not-a-quantified-type funT)
-            
-            (#.Some outputT)
-            (//type.with-type outputT
-              (sum analyse tag valueC))))
-        
-        _
-        (///.throw invalid-variant-type [expectedT tag valueC])))))
-
-(def: (typed-product analyse membersC+)
-  (-> Compiler (List Code) (Operation Analysis))
-  (do ///.Monad
-    [expectedT (extension.lift macro.expected-type)]
-    (loop [expectedT expectedT
-           membersC+ membersC+]
-      (case [expectedT membersC+]
-        ## If the tuple runs out, whatever expression is the last gets
-        ## matched to the remaining type.
-        [tailT (#.Cons tailC #.Nil)]
-        (//type.with-type tailT
-          (analyse tailC))
-
-        ## If the type and the code are still ongoing, match each
-        ## sub-expression to its corresponding type.
-        [(#.Product leftT rightT) (#.Cons leftC rightC)]
-        (do @
-          [leftA (//type.with-type leftT
-                   (analyse leftC))
-           rightA (recur rightT rightC)]
-          (wrap (#//.Structure (#//.Product leftA rightA))))
-
-        ## If, however, the type runs out but there is still enough
-        ## tail, the remaining elements get packaged into another
-        ## tuple.
-        ## The reason for this is that it is assumed that the type of
-        ## the tuple represents the expectations of the user.
-        ## If the type is for a 3-tuple, but a 5-tuple is provided, it
-        ## is assumed that the user intended the following layout:
-        ## [0, 1, [2, 3, 4]]
-        ## but that, for whatever reason, it was written in a flat
-        ## way.
-        [tailT tailC]
-        (|> tailC
-            code.tuple
-            analyse
-            (//type.with-type tailT)
-            (:: @ map (|>> //.no-op)))))))
-
-(def: #export (product analyse membersC)
-  (-> Compiler (List Code) (Operation Analysis))
-  (do ///.Monad
-    [expectedT (extension.lift macro.expected-type)]
-    (///.with-stack cannot-analyse-tuple [expectedT membersC]
-      (case expectedT
-        (#.Product _)
-        (..typed-product analyse membersC)
-
-        (#.Named name unnamedT)
-        (//type.with-type unnamedT
-          (product analyse membersC))
-
-        (#.Var id)
-        (do @
-          [?expectedT' (//type.with-env
-                         (check.read id))]
-          (case ?expectedT'
-            (#.Some expectedT')
-            (//type.with-type expectedT'
-              (product analyse membersC))
-
-            _
-            ## Must do inference...
-            (do @
-              [membersTA (monad.map @ (|>> analyse //type.with-inference)
-                                    membersC)
-               _ (//type.with-env
-                   (check.check expectedT
-                                (type.tuple (list/map product.left membersTA))))]
-              (wrap (//.product-analysis (list/map product.right membersTA))))))
-
-        (^template [ ]
-          ( _)
-          (do @
-            [[instance-id instanceT] (//type.with-env )]
-            (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
-              (product analyse membersC))))
-        ([#.UnivQ check.existential]
-         [#.ExQ check.var])
-
-        (#.Apply inputT funT)
-        (case funT
-          (#.Var funT-id)
-          (do @
-            [?funT' (//type.with-env (check.read funT-id))]
-            (case ?funT'
-              (#.Some funT')
-              (//type.with-type (#.Apply inputT funT')
-                (product analyse membersC))
-
-              _
-              (///.throw invalid-tuple-type [expectedT membersC])))
-
-          _
-          (case (type.apply (list inputT) funT)
-            #.None
-            (///.throw not-a-quantified-type funT)
-            
-            (#.Some outputT)
-            (//type.with-type outputT
-              (product analyse membersC))))
-        
-        _
-        (///.throw invalid-tuple-type [expectedT membersC])
-        ))))
-
-(def: #export (tagged-sum analyse tag valueC)
-  (-> Compiler Ident Code (Operation Analysis))
-  (do ///.Monad
-    [tag (extension.lift (macro.normalize tag))
-     [idx group variantT] (extension.lift (macro.resolve-tag tag))
-     expectedT (extension.lift macro.expected-type)]
-    (case expectedT
-      (#.Var _)
-      (do @
-        [#let [case-size (list.size group)]
-         inferenceT (inference.variant idx case-size variantT)
-         [inferredT valueA+] (inference.general analyse inferenceT (list valueC))]
-        (wrap (//.sum-analysis case-size idx (|> valueA+ list.head maybe.assume))))
-
-      _
-      (..sum analyse idx valueC))))
-
-## There cannot be any ambiguity or improper syntax when analysing
-## records, so they must be normalized for further analysis.
-## Normalization just means that all the tags get resolved to their
-## canonical form (with their corresponding module identified).
-(def: #export (normalize record)
-  (-> (List [Code Code]) (Operation (List [Ident Code])))
-  (monad.map ///.Monad
-             (function (_ [key val])
-               (case key
-                 [_ (#.Tag key)]
-                 (do ///.Monad
-                   [key (extension.lift (macro.normalize key))]
-                   (wrap [key val]))
-
-                 _
-                 (///.throw record-keys-must-be-tags [key record])))
-             record))
-
-## Lux already possesses the means to analyse tuples, so
-## re-implementing the same functionality for records makes no sense.
-## Records, thus, get transformed into tuples by ordering the elements.
-(def: #export (order record)
-  (-> (List [Ident Code]) (Operation [(List Code) Type]))
-  (case record
-    ## empty-record = empty-tuple = unit = []
-    #.Nil
-    (:: ///.Monad wrap [(list) Any])
-
-    (#.Cons [head-k head-v] _)
-    (do ///.Monad
-      [head-k (extension.lift (macro.normalize head-k))
-       [_ tag-set recordT] (extension.lift (macro.resolve-tag head-k))
-       #let [size-record (list.size record)
-             size-ts (list.size tag-set)]
-       _ (if (n/= size-ts size-record)
-           (wrap [])
-           (///.throw record-size-mismatch [size-ts size-record recordT record]))
-       #let [tuple-range (list.n/range +0 (dec size-ts))
-             tag->idx (dict.from-list ident.Hash (list.zip2 tag-set tuple-range))]
-       idx->val (monad.fold @
-                            (function (_ [key val] idx->val)
-                              (do @
-                                [key (extension.lift (macro.normalize key))]
-                                (case (dict.get key tag->idx)
-                                  #.None
-                                  (///.throw tag-does-not-belong-to-record [key recordT])
-
-                                  (#.Some idx)
-                                  (if (dict.contains? idx idx->val)
-                                    (///.throw cannot-repeat-tag [key record])
-                                    (wrap (dict.put idx val idx->val))))))
-                            (: (Dictionary Nat Code)
-                               (dict.new number.Hash))
-                            record)
-       #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val)))
-                                     tuple-range)]]
-      (wrap [ordered-tuple recordT]))
-    ))
-
-(def: #export (record analyse members)
-  (-> Compiler (List [Code Code]) (Operation Analysis))
-  (do ///.Monad
-    [members (normalize members)
-     [membersC recordT] (order members)]
-    (case membersC
-      (^ (list))
-      primitive.unit
-      
-      (^ (list singletonC))
-      (analyse singletonC)
-
-      _
-      (do @
-        [expectedT (extension.lift macro.expected-type)]
-        (case expectedT
-          (#.Var _)
-          (do @
-            [inferenceT (inference.record recordT)
-             [inferredT membersA] (inference.general analyse inferenceT membersC)]
-            (wrap (//.product-analysis membersA)))
-
-          _
-          (..product analyse membersC))))))
diff --git a/stdlib/source/lux/language/compiler/analysis/type.lux b/stdlib/source/lux/language/compiler/analysis/type.lux
deleted file mode 100644
index 3eb574986..000000000
--- a/stdlib/source/lux/language/compiler/analysis/type.lux
+++ /dev/null
@@ -1,52 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]]
-   [data
-    ["." error]]
-   ["." function]
-   [type
-    ["tc" check]]
-   ["." macro]]
-  [// (#+ Operation)
-   ["/." //
-    ["." extension]]])
-
-(def: #export (with-type expected)
-  (All [a] (-> Type (Operation a) (Operation a)))
-  (extension.localized (get@ #.expected) (set@ #.expected)
-                       (function.constant (#.Some expected))))
-
-(def: #export (with-env action)
-  (All [a] (-> (tc.Check a) (Operation a)))
-  (function (_ (^@ stateE [bundle state]))
-    (case (action (get@ #.type-context state))
-      (#error.Error error)
-      ((///.fail error) stateE)
-
-      (#error.Success [context' output])
-      (#error.Success [[bundle (set@ #.type-context context' state)]
-                       output]))))
-
-(def: #export with-fresh-env
-  (All [a] (-> (Operation a) (Operation a)))
-  (extension.localized (get@ #.type-context) (set@ #.type-context)
-                       (function.constant tc.fresh-context)))
-
-(def: #export (infer actualT)
-  (-> Type (Operation Any))
-  (do ///.Monad
-    [expectedT (extension.lift macro.expected-type)]
-    (with-env
-      (tc.check expectedT actualT))))
-
-(def: #export (with-inference action)
-  (All [a] (-> (Operation a) (Operation [Type a])))
-  (do ///.Monad
-    [[_ varT] (..with-env
-                tc.var)
-     output (with-type varT
-              action)
-     knownT (..with-env
-              (tc.clean varT))]
-    (wrap [knownT output])))
diff --git a/stdlib/source/lux/language/compiler/default/cache.lux b/stdlib/source/lux/language/compiler/default/cache.lux
deleted file mode 100644
index d8f841e13..000000000
--- a/stdlib/source/lux/language/compiler/default/cache.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [format
-     ["_" binary (#+ Format)]]]])
-
-(def: definition
-  (Format Definition)
-  ($_ _.seq _.type _.code _.any))
-
-(def: alias
-  (Format [Text Text])
-  (_.seq _.text _.text))
-
-## TODO: Remove #module-hash, #imports & #module-state ASAP.
-## TODO: Not just from this parser, but from the lux.Module type.
-(def: #export module
-  (Format Module)
-  ($_ _.seq
-      ## #module-hash
-      (_.ignore +0)
-      ## #module-aliases
-      (_.list ..alias)
-      ## #definitions
-      (_.list (_.seq _.text ..definition))
-      ## #imports
-      (_.list _.text)
-      ## #tags
-      (_.ignore (list))
-      ## #types
-      (_.ignore (list))
-      ## #module-annotations
-      (_.maybe _.code)
-      ## #module-state
-      (_.ignore #.Cached)))
diff --git a/stdlib/source/lux/language/compiler/default/repl/type.lux b/stdlib/source/lux/language/compiler/default/repl/type.lux
deleted file mode 100644
index 2af590c4b..000000000
--- a/stdlib/source/lux/language/compiler/default/repl/type.lux
+++ /dev/null
@@ -1,203 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    ["p" parser]
-    pipe]
-   [data
-    ["." error (#+ Error)]
-    [text
-     format]
-    [format
-     [xml (#+ XML)]
-     [json (#+ JSON)]]
-    [collection
-     ["." list]]]
-   [time
-    [instant (#+ Instant)]
-    [duration (#+ Duration)]
-    [date (#+ Date)]]
-   ["." function]
-   ["." type]
-   ["." macro
-    ["." code]
-    ["." poly (#+ Poly)]]])
-
-(exception: #export (cannot-represent-value {type Type})
-  (ex.report ["Type" (%type type)]))
-
-(type: Representation (-> Any Text))
-
-(def: primitive-representation
-  (Poly Representation)
-  (`` ($_ p.either
-          (do p.Monad
-            [_ (poly.exactly Any)]
-            (wrap (function.constant "[]")))
-          
-          (~~ (do-template [ ]
-                [(do p.Monad
-                   [_ (poly.sub )]
-                   (wrap (|>> (:coerce ) )))]
-
-                [Bit %b]
-                [Nat %n]
-                [Int %i]
-                [Rev %r]
-                [Frac %f]
-                [Text %t])))))
-
-(def: (special-representation representation)
-  (-> (Poly Representation) (Poly Representation))
-  (`` ($_ p.either
-          (~~ (do-template [ ]
-                [(do p.Monad
-                   [_ (poly.sub )]
-                   (wrap (|>> (:coerce ) )))]
-
-                [Type %type]
-                [Code %code]
-                [Instant %instant]
-                [Duration %duration]
-                [Date %date]
-                [JSON %json]
-                [XML %xml]))
-
-          (do p.Monad
-            [[_ elemT] (poly.apply (p.seq (poly.exactly List) poly.any))
-             elemR (poly.local (list elemT) representation)]
-            (wrap (|>> (:coerce (List Any)) (%list elemR))))
-
-          (do p.Monad
-            [[_ elemT] (poly.apply (p.seq (poly.exactly Maybe) poly.any))
-             elemR (poly.local (list elemT) representation)]
-            (wrap (|>> (:coerce (Maybe Any))
-                       (case> #.None
-                              "#.None"
-
-                              (#.Some elemV)
-                              (format "(#.Some " (elemR elemV) ")"))))))))
-
-(def: (record-representation tags representation)
-  (-> (List Ident) (Poly Representation) (Poly Representation))
-  (do p.Monad
-    [membersR+ (poly.tuple (p.many representation))
-     _ (p.assert "Number of tags does not match record type size."
-                 (n/= (list.size tags) (list.size membersR+)))]
-    (wrap (function (_ recordV)
-            (let [record-body (loop [pairs-left (list.zip2 tags membersR+)
-                                     recordV recordV]
-                                (case pairs-left
-                                  #.Nil
-                                  ""
-
-                                  (#.Cons [tag repr] #.Nil)
-                                  (format (%code (code.tag tag)) " " (repr recordV))
-
-                                  (#.Cons [tag repr] tail)
-                                  (let [[leftV rightV] (:coerce [Any Any] recordV)]
-                                    (format (%code (code.tag tag)) " " (repr leftV) " "
-                                            (recur tail rightV)))))]
-              (format "{" record-body "}"))))))
-
-(def: (variant-representation tags representation)
-  (-> (List Ident) (Poly Representation) (Poly Representation))
-  (do p.Monad
-    [casesR+ (poly.variant (p.many representation))
-     #let [num-tags (list.size tags)]
-     _ (p.assert "Number of tags does not match variant type size."
-                 (n/= num-tags (list.size casesR+)))]
-    (wrap (function (_ variantV)
-            (loop [cases-left (list.zip3 tags
-                                         (list.n/range +0 (dec num-tags))
-                                         casesR+)
-                   variantV variantV]
-              (case cases-left
-                #.Nil
-                ""
-
-                (#.Cons [tag-name tag-idx repr] #.Nil)
-                (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)]
-                  (if (n/= tag-idx _tag)
-                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
-                    (undefined)))
-
-                (#.Cons [tag-name tag-idx repr] tail)
-                (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)]
-                  (if (n/= tag-idx _tag)
-                    (format "(" (%code (code.tag tag-name)) " " (repr _value) ")")
-                    (recur tail variantV)))))))))
-
-(def: (tagged-representation compiler representation)
-  (-> Lux (Poly Representation) (Poly Representation))
-  (do p.Monad
-    [[name anonymous] poly.named]
-    (case (macro.run compiler (macro.tags-of name))
-      (#error.Success ?tags)
-      (case ?tags
-        (#.Some tags)
-        (poly.local (list anonymous)
-                    (p.either (record-representation tags representation)
-                              (variant-representation tags representation)))
-        
-        #.None
-        representation)
-      
-      (#error.Error error)
-      (p.fail error))))
-
-(def: (tuple-representation representation)
-  (-> (Poly Representation) (Poly Representation))
-  (do p.Monad
-    [membersR+ (poly.tuple (p.many representation))]
-    (wrap (function (_ tupleV)
-            (let [tuple-body (loop [representations membersR+
-                                    tupleV tupleV]
-                               (case representations
-                                 #.Nil
-                                 ""
-                                 
-                                 (#.Cons lastR #.Nil)
-                                 (lastR tupleV)
-                                 
-                                 (#.Cons headR tailR)
-                                 (let [[leftV rightV] (:coerce [Any Any] tupleV)]
-                                   (format (headR leftV) " " (recur tailR rightV)))))]
-              (format "[" tuple-body "]"))))))
-
-(def: (representation compiler)
-  (-> Lux (Poly Representation))
-  (p.rec
-   (function (_ representation)
-     ($_ p.either
-         primitive-representation
-         (special-representation representation)
-         (tagged-representation compiler representation)
-         (tuple-representation representation)
-
-         (do p.Monad
-           [[funcT inputsT+] (poly.apply (p.seq poly.any (p.many poly.any)))]
-           (case (type.apply inputsT+ funcT)
-             (#.Some outputT)
-             (poly.local (list outputT) representation)
-
-             #.None
-             (p.fail "")))
-
-         (do p.Monad
-           [[name anonymous] poly.named]
-           (poly.local (list anonymous) representation))
-
-         (p.fail "")
-         ))))
-
-(def: #export (represent compiler type value)
-  (-> Lux Type Any Text)
-  (case (poly.run type (representation compiler))
-    (#error.Success representation)
-    (ex.report ["Type" (%type type)]
-               ["Value" (representation value)])
-
-    (#error.Error error)
-    (ex.construct cannot-represent-value [type])))
diff --git a/stdlib/source/lux/language/compiler/extension.lux b/stdlib/source/lux/language/compiler/extension.lux
deleted file mode 100644
index 10d2d62ca..000000000
--- a/stdlib/source/lux/language/compiler/extension.lux
+++ /dev/null
@@ -1,114 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." error (#+ Error)]
-    ["." text]
-    [collection
-     ["dict" dictionary (#+ Dictionary)]]]
-   ["." function]]
-  ["." //])
-
-(type: #export (Extension i)
-  [Text (List i)])
-
-(with-expansions [ (as-is (Dictionary Text (Handler s i o)))]
-  (type: #export (Handler s i o)
-    (-> Text
-        (//.Compiler [ s] i o)
-        (//.Compiler [ s] (List i) o)))
-
-  (type: #export (Bundle s i o)
-    ))
-
-(type: #export (Operation s i o v)
-  (//.Operation [(Bundle s i o) s] v))
-
-(type: #export (Compiler s i o)
-  (//.Compiler [(Bundle s i o) s] i o))
-
-(do-template []
-  [(exception: #export ( {name Text})
-     (ex.report ["Name" name]))]
-
-  [unknown]
-  [cannot-overwrite]
-  )
-
-(def: #export (install name handler)
-  (All [s i o]
-    (-> Text (Handler s i o) (Operation s i o Any)))
-  (function (_ [bundle state])
-    (if (dict.contains? name bundle)
-      (ex.throw cannot-overwrite name)
-      (#error.Success [[(dict.put name handler bundle) state]
-                       []]))))
-
-(def: #export (apply compiler [name parameters])
-  (All [s i o]
-    (-> (Compiler s i o) (Extension i) (Operation s i o o)))
-  (function (_ (^@ stateE [bundle state]))
-    (case (dict.get name bundle)
-      #.None
-      (ex.throw unknown name)
-      
-      (#.Some handler)
-      ((handler name compiler) parameters stateE))))
-
-(def: #export (localized get set transform)
-  (All [s s' i o v]
-    (-> (-> s s') (-> s' s s) (-> s' s')
-        (-> (Operation s i o v) (Operation s i o v))))
-  (function (_ operation)
-    (function (_ [bundle state])
-      (let [old (get state)]
-        (case (operation [bundle (set (transform old) state)])
-          (#error.Error error)
-          (#error.Error error)
-
-          (#error.Success [[bundle' state'] output])
-          (#error.Success [[bundle' (set old state')] output]))))))
-
-(def: #export (temporary transform)
-  (All [s i o v]
-    (-> (-> s s)
-        (-> (Operation s i o v) (Operation s i o v))))
-  (function (_ operation)
-    (function (_ [bundle state])
-      (case (operation [bundle (transform state)])
-        (#error.Error error)
-        (#error.Error error)
-
-        (#error.Success [[bundle' state'] output])
-        (#error.Success [[bundle' state] output])))))
-
-(def: #export (with-state state)
-  (All [s i o v]
-    (-> s (-> (Operation s i o v) (Operation s i o v))))
-  (..temporary (function.constant state)))
-
-(def: #export (read get)
-  (All [s i o v]
-    (-> (-> s v) (Operation s i o v)))
-  (function (_ [bundle state])
-    (#error.Success [[bundle state] (get state)])))
-
-(def: #export (update transform)
-  (All [s i o]
-    (-> (-> s s) (Operation s i o Any)))
-  (function (_ [bundle state])
-    (#error.Success [[bundle (transform state)] []])))
-
-(def: #export (lift action)
-  (All [s i o v]
-    (-> (//.Operation s v)
-        (//.Operation [(Bundle s i o) s] v)))
-  (function (_ [bundle state])
-    (case (action state)
-      (#error.Error error)
-      (#error.Error error)
-
-      (#error.Success [state' output])
-      (#error.Success [[bundle state] output]))))
diff --git a/stdlib/source/lux/language/compiler/extension/analysis.lux b/stdlib/source/lux/language/compiler/extension/analysis.lux
deleted file mode 100644
index 4d78ceb43..000000000
--- a/stdlib/source/lux/language/compiler/extension/analysis.lux
+++ /dev/null
@@ -1,15 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [collection
-     ["." dictionary]]]]
-  [///
-   [analysis (#+ Bundle)]]
-  [/
-   ["." common]
-   ["." host]])
-
-(def: #export bundle
-  Bundle
-  (dictionary.merge host.bundle
-                    common.bundle))
diff --git a/stdlib/source/lux/language/compiler/extension/analysis/common.lux b/stdlib/source/lux/language/compiler/extension/analysis/common.lux
deleted file mode 100644
index 201616ac9..000000000
--- a/stdlib/source/lux/language/compiler/extension/analysis/common.lux
+++ /dev/null
@@ -1,371 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    [thread (#+ Box)]]
-   [concurrency
-    [atom (#+ Atom)]]
-   [data
-    ["." text
-     format]
-    [collection
-     ["." list ("list/." Functor)]
-     ["." array]
-     ["dict" dictionary (#+ Dictionary)]]]
-   [type
-    ["." check]]
-   ["." language]
-   [io (#+ IO)]]
-  ["." ////
-   ["." analysis (#+ Analysis Handler Bundle)
-    [".A" type]
-    [".A" case]
-    [".A" function]]]
-  ["." ///
-   ["." bundle]])
-
-## [Utils]
-(def: (simple inputsT+ outputT)
-  (-> (List Type) Type Handler)
-  (let [num-expected (list.size inputsT+)]
-    (function (_ extension-name analyse args)
-      (let [num-actual (list.size args)]
-        (if (n/= num-expected num-actual)
-          (do ////.Monad
-            [_ (typeA.infer outputT)
-             argsA (monad.map @
-                              (function (_ [argT argC])
-                                (typeA.with-type argT
-                                  (analyse argC)))
-                              (list.zip2 inputsT+ args))]
-            (wrap (#analysis.Extension extension-name argsA)))
-          (////.throw bundle.incorrect-arity [extension-name num-expected num-actual]))))))
-
-(def: #export (nullary valueT)
-  (-> Type Handler)
-  (simple (list) valueT))
-
-(def: #export (unary inputT outputT)
-  (-> Type Type Handler)
-  (simple (list inputT) outputT))
-
-(def: #export (binary subjectT paramT outputT)
-  (-> Type Type Type Handler)
-  (simple (list subjectT paramT) outputT))
-
-(def: #export (trinary subjectT param0T param1T outputT)
-  (-> Type Type Type Type Handler)
-  (simple (list subjectT param0T param1T) outputT))
-
-## [Analysers]
-## "lux is" represents reference/pointer equality.
-(def: lux::is
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((binary varT varT Bit extension-name)
-       analyse args))))
-
-## "lux try" provides a simple way to interact with the host platform's
-## error-handling facilities.
-(def: lux::try
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list opC))
-      (do ////.Monad
-        [[var-id varT] (typeA.with-env check.var)
-         _ (typeA.infer (type (Either Text varT)))
-         opA (typeA.with-type (type (IO varT))
-               (analyse opC))]
-        (wrap (#analysis.Extension extension-name (list opA))))
-      
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: lux::in-module
-  Handler
-  (function (_ extension-name analyse argsC+)
-    (case argsC+
-      (^ (list [_ (#.Text module-name)] exprC))
-      (analysis.with-current-module module-name
-        (analyse exprC))
-      
-      _
-      (////.throw bundle.invalid-syntax [extension-name]))))
-
-## (do-template [ ]
-##   [(def: 
-##      Handler
-##      (function (_ extension-name analyse args)
-##        (case args
-##          (^ (list typeC valueC))
-##          (do ////.Monad
-##            [actualT (eval Type typeC)
-##             _ (typeA.infer (:coerce Type actualT))]
-##            (typeA.with-type 
-##              (analyse valueC)))
-
-##          _
-##          (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))]
-
-##   [lux::check  (:coerce Type actualT)]
-##   [lux::coerce Any]
-##   )
-
-(def: lux::check::type
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list valueC))
-      (do ////.Monad
-        [_ (typeA.infer Type)
-         valueA (typeA.with-type Type
-                  (analyse valueC))]
-        (wrap valueA))
-      
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: bundle::lux
-  Bundle
-  (|> bundle.empty
-      (bundle.install "is" lux::is)
-      (bundle.install "try" lux::try)
-      ## (bundle.install "check" lux::check)
-      ## (bundle.install "coerce" lux::coerce)
-      (bundle.install "check type" lux::check::type)
-      (bundle.install "in-module" lux::in-module)))
-
-(def: bundle::io
-  Bundle
-  (<| (bundle.prefix "io")
-      (|> bundle.empty
-          (bundle.install "log" (unary Text Any))
-          (bundle.install "error" (unary Text Nothing))
-          (bundle.install "exit" (unary Int Nothing))
-          (bundle.install "current-time" (nullary Int)))))
-
-(def: bundle::bit
-  Bundle
-  (<| (bundle.prefix "bit")
-      (|> bundle.empty
-          (bundle.install "and" (binary Nat Nat Nat))
-          (bundle.install "or" (binary Nat Nat Nat))
-          (bundle.install "xor" (binary Nat Nat Nat))
-          (bundle.install "left-shift" (binary Nat Nat Nat))
-          (bundle.install "logical-right-shift" (binary Nat Nat Nat))
-          (bundle.install "arithmetic-right-shift" (binary Int Nat Int))
-          )))
-
-(def: bundle::int
-  Bundle
-  (<| (bundle.prefix "int")
-      (|> bundle.empty
-          (bundle.install "+" (binary Int Int Int))
-          (bundle.install "-" (binary Int Int Int))
-          (bundle.install "*" (binary Int Int Int))
-          (bundle.install "/" (binary Int Int Int))
-          (bundle.install "%" (binary Int Int Int))
-          (bundle.install "=" (binary Int Int Bit))
-          (bundle.install "<" (binary Int Int Bit))
-          (bundle.install "to-frac" (unary Int Frac))
-          (bundle.install "char" (unary Int Text)))))
-
-(def: bundle::frac
-  Bundle
-  (<| (bundle.prefix "frac")
-      (|> bundle.empty
-          (bundle.install "+" (binary Frac Frac Frac))
-          (bundle.install "-" (binary Frac Frac Frac))
-          (bundle.install "*" (binary Frac Frac Frac))
-          (bundle.install "/" (binary Frac Frac Frac))
-          (bundle.install "%" (binary Frac Frac Frac))
-          (bundle.install "=" (binary Frac Frac Bit))
-          (bundle.install "<" (binary Frac Frac Bit))
-          (bundle.install "smallest" (nullary Frac))
-          (bundle.install "min" (nullary Frac))
-          (bundle.install "max" (nullary Frac))
-          (bundle.install "to-rev" (unary Frac Rev))
-          (bundle.install "to-int" (unary Frac Int))
-          (bundle.install "encode" (unary Frac Text))
-          (bundle.install "decode" (unary Text (type (Maybe Frac)))))))
-
-(def: bundle::text
-  Bundle
-  (<| (bundle.prefix "text")
-      (|> bundle.empty
-          (bundle.install "=" (binary Text Text Bit))
-          (bundle.install "<" (binary Text Text Bit))
-          (bundle.install "concat" (binary Text Text Text))
-          (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat))))
-          (bundle.install "size" (unary Text Nat))
-          (bundle.install "char" (binary Text Nat (type (Maybe Nat))))
-          (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text))))
-          )))
-
-(def: array::get
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((binary (type (Array varT)) Nat (type (Maybe varT)) extension-name)
-       analyse args))))
-
-(def: array::put
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension-name)
-       analyse args))))
-
-(def: array::remove
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((binary (type (Array varT)) Nat (type (Array varT)) extension-name)
-       analyse args))))
-
-(def: bundle::array
-  Bundle
-  (<| (bundle.prefix "array")
-      (|> bundle.empty
-          (bundle.install "new" (unary Nat Array))
-          (bundle.install "get" array::get)
-          (bundle.install "put" array::put)
-          (bundle.install "remove" array::remove)
-          (bundle.install "size" (unary (type (Ex [a] (Array a))) Nat))
-          )))
-
-(def: bundle::math
-  Bundle
-  (<| (bundle.prefix "math")
-      (|> bundle.empty
-          (bundle.install "cos" (unary Frac Frac))
-          (bundle.install "sin" (unary Frac Frac))
-          (bundle.install "tan" (unary Frac Frac))
-          (bundle.install "acos" (unary Frac Frac))
-          (bundle.install "asin" (unary Frac Frac))
-          (bundle.install "atan" (unary Frac Frac))
-          (bundle.install "cosh" (unary Frac Frac))
-          (bundle.install "sinh" (unary Frac Frac))
-          (bundle.install "tanh" (unary Frac Frac))
-          (bundle.install "exp" (unary Frac Frac))
-          (bundle.install "log" (unary Frac Frac))
-          (bundle.install "ceil" (unary Frac Frac))
-          (bundle.install "floor" (unary Frac Frac))
-          (bundle.install "round" (unary Frac Frac))
-          (bundle.install "atan2" (binary Frac Frac Frac))
-          (bundle.install "pow" (binary Frac Frac Frac))
-          )))
-
-(def: atom::new
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list initC))
-      (do ////.Monad
-        [[var-id varT] (typeA.with-env check.var)
-         _ (typeA.infer (type (Atom varT)))
-         initA (typeA.with-type varT
-                 (analyse initC))]
-        (wrap (#analysis.Extension extension-name (list initA))))
-      
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: atom::read
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((unary (type (Atom varT)) varT extension-name)
-       analyse args))))
-
-(def: atom::compare-and-swap
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[var-id varT] (typeA.with-env check.var)]
-      ((trinary (type (Atom varT)) varT varT Bit extension-name)
-       analyse args))))
-
-(def: bundle::atom
-  Bundle
-  (<| (bundle.prefix "atom")
-      (|> bundle.empty
-          (bundle.install "new" atom::new)
-          (bundle.install "read" atom::read)
-          (bundle.install "compare-and-swap" atom::compare-and-swap)
-          )))
-
-(def: box::new
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list initC))
-      (do ////.Monad
-        [[var-id varT] (typeA.with-env check.var)
-         _ (typeA.infer (type (All [!] (Box ! varT))))
-         initA (typeA.with-type varT
-                 (analyse initC))]
-        (wrap (#analysis.Extension extension-name (list initA))))
-      
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: box::read
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[thread-id threadT] (typeA.with-env check.var)
-       [var-id varT] (typeA.with-env check.var)]
-      ((unary (type (Box threadT varT)) varT extension-name)
-       analyse args))))
-
-(def: box::write
-  Handler
-  (function (_ extension-name analyse args)
-    (do ////.Monad
-      [[thread-id threadT] (typeA.with-env check.var)
-       [var-id varT] (typeA.with-env check.var)]
-      ((binary varT (type (Box threadT varT)) Any extension-name)
-       analyse args))))
-
-(def: bundle::box
-  Bundle
-  (<| (bundle.prefix "box")
-      (|> bundle.empty
-          (bundle.install "new" box::new)
-          (bundle.install "read" box::read)
-          (bundle.install "write" box::write)
-          )))
-
-(def: bundle::process
-  Bundle
-  (<| (bundle.prefix "process")
-      (|> bundle.empty
-          (bundle.install "parallelism" (nullary Nat))
-          (bundle.install "schedule" (binary Nat (type (IO Any)) Any))
-          )))
-
-(def: #export bundle
-  Bundle
-  (<| (bundle.prefix "lux")
-      (|> bundle.empty
-          (dict.merge bundle::lux)
-          (dict.merge bundle::bit)
-          (dict.merge bundle::int)
-          (dict.merge bundle::frac)
-          (dict.merge bundle::text)
-          (dict.merge bundle::array)
-          (dict.merge bundle::math)
-          (dict.merge bundle::atom)
-          (dict.merge bundle::box)
-          (dict.merge bundle::process)
-          (dict.merge bundle::io))
-      ))
diff --git a/stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux b/stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux
deleted file mode 100644
index 0edd20d2b..000000000
--- a/stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux
+++ /dev/null
@@ -1,1271 +0,0 @@
-(.module:
-  [lux (#- char int)
-   [control
-    ["." monad (#+ do)]
-    ["p" parser]
-    ["ex" exception (#+ exception:)]
-    pipe]
-   [data
-    ["e" error]
-    ["." maybe]
-    ["." product]
-    ["." text ("text/." Equivalence)
-     format]
-    [collection
-     ["." list ("list/." Fold Functor Monoid)]
-     ["." array]
-     ["." dictionary (#+ Dictionary)]]]
-   ["." type
-    ["." check]]
-   ["." macro
-    ["s" syntax]]
-   ["." host]]
-  [//
-   ["." common]
-   ["/." //
-    ["." bundle]
-    ["//." // ("operation/." Monad)
-     ["." analysis (#+ Analysis Operation Handler Bundle)
-      [".A" type]
-      [".A" inference]]]]]
-  )
-
-(type: Method-Signature
-  {#method Type
-   #exceptions (List Type)})
-
-(host.import: #long java/lang/reflect/Type
-  (getTypeName [] String))
-
-(do-template []
-  [(exception: #export ( {jvm-type java/lang/reflect/Type})
-     (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName [] jvm-type)]))]
-
-  [jvm-type-is-not-a-class]
-  [cannot-convert-to-a-class]
-  [cannot-convert-to-a-parameter]
-  [cannot-convert-to-a-lux-type]
-  )
-
-(do-template []
-  [(exception: #export ( {type Type})
-     (%type type))]
-
-  [non-object]
-  [non-array]
-  [non-jvm-type]
-  )
-
-(do-template []
-  [(exception: #export ( {name Text})
-     name)]
-
-  [non-interface]
-  [non-throwable]
-  )
-
-(do-template []
-  [(exception: #export ( {message Text})
-     message)]
-
-  [unknown-class]
-  [primitives-cannot-have-type-parameters]
-  [primitives-are-not-objects]
-  [invalid-type-for-array-element]
-
-  [unknown-field]
-  [mistaken-field-owner]
-  [not-a-virtual-field]
-  [not-a-static-field]
-  [cannot-set-a-final-field]
-
-  [cannot-cast]
-
-  [cannot-possibly-be-an-instance]
-
-  [unknown-type-var]
-  [type-parameter-mismatch]
-  [cannot-correspond-type-with-a-class]
-  )
-
-(do-template []
-  [(exception: #export ( {class Text}
-                               {method Text}
-                               {hints (List Method-Signature)})
-     (ex.report ["Class" class]
-                ["Method" method]
-                ["Hints" (|> hints
-                             (list/map (|>> product.left %type (format "\n\t")))
-                             (text.join-with ""))]))]
-
-  [no-candidates]
-  [too-many-candidates]
-  )
-
-(do-template [ ]
-  [(def: #export  Type (#.Primitive  (list)))]
-
-  ## Boxes
-  [Boolean   "java.lang.Boolean"]
-  [Byte      "java.lang.Byte"]
-  [Short     "java.lang.Short"]
-  [Integer   "java.lang.Integer"]
-  [Long      "java.lang.Long"]
-  [Float     "java.lang.Float"]
-  [Double    "java.lang.Double"]
-  [Character "java.lang.Character"]
-  [String    "java.lang.String"]
-
-  ## Primitives
-  [boolean   "boolean"]
-  [byte      "byte"]
-  [short     "short"]
-  [int       "int"]
-  [long      "long"]
-  [float     "float"]
-  [double    "double"]
-  [char      "char"]
-  )
-
-(def: bundle::conversion
-  Bundle
-  (<| (bundle.prefix "convert")
-      (|> bundle.empty
-          (bundle.install "double-to-float" (common.unary Double Float))
-          (bundle.install "double-to-int" (common.unary Double Integer))
-          (bundle.install "double-to-long" (common.unary Double Long))
-          (bundle.install "float-to-double" (common.unary Float Double))
-          (bundle.install "float-to-int" (common.unary Float Integer))
-          (bundle.install "float-to-long" (common.unary Float Long))
-          (bundle.install "int-to-byte" (common.unary Integer Byte))
-          (bundle.install "int-to-char" (common.unary Integer Character))
-          (bundle.install "int-to-double" (common.unary Integer Double))
-          (bundle.install "int-to-float" (common.unary Integer Float))
-          (bundle.install "int-to-long" (common.unary Integer Long))
-          (bundle.install "int-to-short" (common.unary Integer Short))
-          (bundle.install "long-to-double" (common.unary Long Double))
-          (bundle.install "long-to-float" (common.unary Long Float))
-          (bundle.install "long-to-int" (common.unary Long Integer))
-          (bundle.install "long-to-short" (common.unary Long Short))
-          (bundle.install "long-to-byte" (common.unary Long Byte))
-          (bundle.install "char-to-byte" (common.unary Character Byte))
-          (bundle.install "char-to-short" (common.unary Character Short))
-          (bundle.install "char-to-int" (common.unary Character Integer))
-          (bundle.install "char-to-long" (common.unary Character Long))
-          (bundle.install "byte-to-long" (common.unary Byte Long))
-          (bundle.install "short-to-long" (common.unary Short Long))
-          )))
-
-(do-template [  ]
-  [(def: 
-     Bundle
-     (<| (bundle.prefix )
-         (|> bundle.empty
-             (bundle.install "+" (common.binary   ))
-             (bundle.install "-" (common.binary   ))
-             (bundle.install "*" (common.binary   ))
-             (bundle.install "/" (common.binary   ))
-             (bundle.install "%" (common.binary   ))
-             (bundle.install "=" (common.binary   Bit))
-             (bundle.install "<" (common.binary   Bit))
-             (bundle.install "and" (common.binary   ))
-             (bundle.install "or" (common.binary   ))
-             (bundle.install "xor" (common.binary   ))
-             (bundle.install "shl" (common.binary  Integer ))
-             (bundle.install "shr" (common.binary  Integer ))
-             (bundle.install "ushr" (common.binary  Integer ))
-             )))]
-
-  [bundle::int  "int"  Integer]
-  [bundle::long "long" Long]
-  )
-
-(do-template [  ]
-  [(def: 
-     Bundle
-     (<| (bundle.prefix )
-         (|> bundle.empty
-             (bundle.install "+" (common.binary   ))
-             (bundle.install "-" (common.binary   ))
-             (bundle.install "*" (common.binary   ))
-             (bundle.install "/" (common.binary   ))
-             (bundle.install "%" (common.binary   ))
-             (bundle.install "=" (common.binary   Bit))
-             (bundle.install "<" (common.binary   Bit))
-             )))]
-
-  [bundle::float  "float"  Float]
-  [bundle::double "double" Double]
-  )
-
-(def: bundle::char
-  Bundle
-  (<| (bundle.prefix "char")
-      (|> bundle.empty
-          (bundle.install "=" (common.binary Character Character Bit))
-          (bundle.install "<" (common.binary Character Character Bit))
-          )))
-
-(def: #export boxes
-  (Dictionary Text Text)
-  (|> (list ["boolean" "java.lang.Boolean"]
-            ["byte"    "java.lang.Byte"]
-            ["short"   "java.lang.Short"]
-            ["int"     "java.lang.Integer"]
-            ["long"    "java.lang.Long"]
-            ["float"   "java.lang.Float"]
-            ["double"  "java.lang.Double"]
-            ["char"    "java.lang.Character"])
-      (dictionary.from-list text.Hash)))
-
-(def: array::length
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list arrayC))
-      (do ////.Monad
-        [_ (typeA.infer Nat)
-         [var-id varT] (typeA.with-env check.var)
-         arrayA (typeA.with-type (type (Array varT))
-                  (analyse arrayC))]
-        (wrap (#analysis.Extension extension-name (list arrayA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: array::new
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list lengthC))
-      (do ////.Monad
-        [lengthA (typeA.with-type Nat
-                   (analyse lengthC))
-         expectedT (///.lift macro.expected-type)
-         [level elem-class] (: (Operation [Nat Text])
-                               (loop [analysisT expectedT
-                                      level +0]
-                                 (case analysisT
-                                   (#.Apply inputT funcT)
-                                   (case (type.apply (list inputT) funcT)
-                                     (#.Some outputT)
-                                     (recur outputT level)
-
-                                     #.None
-                                     (////.throw non-array expectedT))
-
-                                   (^ (#.Primitive "#Array" (list elemT)))
-                                   (recur elemT (inc level))
-
-                                   (#.Primitive class _)
-                                   (wrap [level class])
-                                   
-                                   _
-                                   (////.throw non-array expectedT))))
-         _ (if (n/> +0 level)
-             (wrap [])
-             (////.throw non-array expectedT))]
-        (wrap (#analysis.Extension extension-name (list (analysis.nat (dec level))
-                                                        (analysis.text elem-class)
-                                                        lengthA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: (check-jvm objectT)
-  (-> Type (Operation Text))
-  (case objectT
-    (#.Primitive name _)
-    (operation/wrap name)
-
-    (#.Named name unnamed)
-    (check-jvm unnamed)
-
-    (#.Var id)
-    (operation/wrap "java.lang.Object")
-
-    (^template []
-      ( env unquantified)
-      (check-jvm unquantified))
-    ([#.UnivQ]
-     [#.ExQ])
-
-    (#.Apply inputT funcT)
-    (case (type.apply (list inputT) funcT)
-      (#.Some outputT)
-      (check-jvm outputT)
-
-      #.None
-      (////.throw non-object objectT))
-
-    _
-    (////.throw non-object objectT)))
-
-(def: (check-object objectT)
-  (-> Type (Operation Text))
-  (do ////.Monad
-    [name (check-jvm objectT)]
-    (if (dictionary.contains? name boxes)
-      (////.throw primitives-are-not-objects name)
-      (operation/wrap name))))
-
-(def: (box-array-element-type elemT)
-  (-> Type (Operation [Type Text]))
-  (case elemT
-    (#.Primitive name #.Nil)
-    (let [boxed-name (|> (dictionary.get name boxes)
-                         (maybe.default name))]
-      (operation/wrap [(#.Primitive boxed-name #.Nil)
-                       boxed-name]))
-
-    (#.Primitive name _)
-    (if (dictionary.contains? name boxes)
-      (////.throw primitives-cannot-have-type-parameters name)
-      (operation/wrap [elemT name]))
-
-    _
-    (////.throw invalid-type-for-array-element (%type elemT))))
-
-(def: array::read
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list arrayC idxC))
-      (do ////.Monad
-        [[var-id varT] (typeA.with-env check.var)
-         _ (typeA.infer varT)
-         arrayA (typeA.with-type (type (Array varT))
-                  (analyse arrayC))
-         ?elemT (typeA.with-env
-                  (check.read var-id))
-         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
-         idxA (typeA.with-type Nat
-                (analyse idxC))]
-        (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA arrayA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))
-
-(def: array::write
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list arrayC idxC valueC))
-      (do ////.Monad
-        [[var-id varT] (typeA.with-env check.var)
-         _ (typeA.infer (type (Array varT)))
-         arrayA (typeA.with-type (type (Array varT))
-                  (analyse arrayC))
-         ?elemT (typeA.with-env
-                  (check.read var-id))
-         [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
-         idxA (typeA.with-type Nat
-                (analyse idxC))
-         valueA (typeA.with-type valueT
-                  (analyse valueC))]
-        (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA valueA arrayA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)]))))
-
-(def: bundle::array
-  Bundle
-  (<| (bundle.prefix "array")
-      (|> bundle.empty
-          (bundle.install "length" array::length)
-          (bundle.install "new" array::new)
-          (bundle.install "read" array::read)
-          (bundle.install "write" array::write)
-          )))
-
-(def: object::null
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list))
-      (do ////.Monad
-        [expectedT (///.lift macro.expected-type)
-         _ (check-object expectedT)]
-        (wrap (#analysis.Extension extension-name (list))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +0 (list.size args)]))))
-
-(def: object::null?
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list objectC))
-      (do ////.Monad
-        [_ (typeA.infer Bit)
-         [objectT objectA] (typeA.with-inference
-                             (analyse objectC))
-         _ (check-object objectT)]
-        (wrap (#analysis.Extension extension-name (list objectA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: object::synchronized
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list monitorC exprC))
-      (do ////.Monad
-        [[monitorT monitorA] (typeA.with-inference
-                               (analyse monitorC))
-         _ (check-object monitorT)
-         exprA (analyse exprC)]
-        (wrap (#analysis.Extension extension-name (list monitorA exprA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))
-
-(host.import: java/lang/Object
-  (equals [Object] boolean))
-
-(host.import: java/lang/ClassLoader)
-
-(host.import: java/lang/reflect/GenericArrayType
-  (getGenericComponentType [] java/lang/reflect/Type))
-
-(host.import: java/lang/reflect/ParameterizedType
-  (getRawType [] java/lang/reflect/Type)
-  (getActualTypeArguments [] (Array java/lang/reflect/Type)))
-
-(host.import: (java/lang/reflect/TypeVariable d)
-  (getName [] String)
-  (getBounds [] (Array java/lang/reflect/Type)))
-
-(host.import: (java/lang/reflect/WildcardType d)
-  (getLowerBounds [] (Array java/lang/reflect/Type))
-  (getUpperBounds [] (Array java/lang/reflect/Type)))
-
-(host.import: java/lang/reflect/Modifier
-  (#static isStatic [int] boolean)
-  (#static isFinal [int] boolean)
-  (#static isInterface [int] boolean)
-  (#static isAbstract [int] boolean))
-
-(host.import: java/lang/reflect/Field
-  (getDeclaringClass [] (java/lang/Class Object))
-  (getModifiers [] int)
-  (getGenericType [] java/lang/reflect/Type))
-
-(host.import: java/lang/reflect/Method
-  (getName [] String)
-  (getModifiers [] int)
-  (getDeclaringClass [] (Class Object))
-  (getTypeParameters [] (Array (TypeVariable Method)))
-  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
-  (getGenericReturnType [] java/lang/reflect/Type)
-  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-
-(host.import: (java/lang/reflect/Constructor c)
-  (getModifiers [] int)
-  (getDeclaringClass [] (Class c))
-  (getTypeParameters [] (Array (TypeVariable (Constructor c))))
-  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
-  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-
-(host.import: (java/lang/Class c)
-  (getName [] String)
-  (getModifiers [] int)
-  (#static forName [String] #try (Class Object))
-  (isAssignableFrom [(Class Object)] boolean)
-  (getTypeParameters [] (Array (TypeVariable (Class c))))
-  (getGenericInterfaces [] (Array java/lang/reflect/Type))
-  (getGenericSuperclass [] java/lang/reflect/Type)
-  (getDeclaredField [String] #try Field)
-  (getConstructors [] (Array (Constructor Object)))
-  (getDeclaredMethods [] (Array Method)))
-
-(def: (load-class name)
-  (-> Text (Operation (Class Object)))
-  (do ////.Monad
-    []
-    (case (Class::forName [name])
-      (#e.Success [class])
-      (wrap class)
-
-      (#e.Error error)
-      (////.throw unknown-class name))))
-
-(def: (sub-class? super sub)
-  (-> Text Text (Operation Bit))
-  (do ////.Monad
-    [super (load-class super)
-     sub (load-class sub)]
-    (wrap (Class::isAssignableFrom [sub] super))))
-
-(def: object::throw
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list exceptionC))
-      (do ////.Monad
-        [_ (typeA.infer Nothing)
-         [exceptionT exceptionA] (typeA.with-inference
-                                   (analyse exceptionC))
-         exception-class (check-object exceptionT)
-         ? (sub-class? "java.lang.Throwable" exception-class)
-         _ (: (Operation Any)
-              (if ?
-                (wrap [])
-                (////.throw non-throwable exception-class)))]
-        (wrap (#analysis.Extension extension-name (list exceptionA))))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: object::class
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC))
-      (case classC
-        [_ (#.Text class)]
-        (do ////.Monad
-          [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
-           _ (load-class class)]
-          (wrap (#analysis.Extension extension-name (list (analysis.text class)))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +1 (list.size args)]))))
-
-(def: object::instance?
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC objectC))
-      (case classC
-        [_ (#.Text class)]
-        (do ////.Monad
-          [_ (typeA.infer Bit)
-           [objectT objectA] (typeA.with-inference
-                               (analyse objectC))
-           object-class (check-object objectT)
-           ? (sub-class? class object-class)]
-          (if ?
-            (wrap (#analysis.Extension extension-name (list (analysis.text class))))
-            (////.throw cannot-possibly-be-an-instance (format object-class " !<= "  class))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))
-
-(def: (java-type-to-class jvm-type)
-  (-> java/lang/reflect/Type (Operation Text))
-  (cond (host.instance? Class jvm-type)
-        (operation/wrap (Class::getName [] (:coerce Class jvm-type)))
-
-        (host.instance? ParameterizedType jvm-type)
-        (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType jvm-type)))
-
-        ## else
-        (////.throw cannot-convert-to-a-class jvm-type)))
-
-(type: Mappings
-  (Dictionary Text Type))
-
-(def: fresh-mappings Mappings (dictionary.new text.Hash))
-
-(def: (java-type-to-lux-type mappings java-type)
-  (-> Mappings java/lang/reflect/Type (Operation Type))
-  (cond (host.instance? TypeVariable java-type)
-        (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))]
-          (case (dictionary.get var-name mappings)
-            (#.Some var-type)
-            (operation/wrap var-type)
-            
-            #.None
-            (////.throw unknown-type-var var-name)))
-
-        (host.instance? WildcardType java-type)
-        (let [java-type (:coerce WildcardType java-type)]
-          (case [(array.read +0 (WildcardType::getUpperBounds [] java-type))
-                 (array.read +0 (WildcardType::getLowerBounds [] java-type))]
-            (^or [(#.Some bound) _] [_ (#.Some bound)])
-            (java-type-to-lux-type mappings bound)
-            
-            _
-            (operation/wrap Any)))
-
-        (host.instance? Class java-type)
-        (let [java-type (:coerce (Class Object) java-type)
-              class-name (Class::getName [] java-type)]
-          (operation/wrap (case (array.size (Class::getTypeParameters [] java-type))
-                            +0
-                            (#.Primitive class-name (list))
-                            
-                            arity
-                            (|> (list.n/range +0 (dec arity))
-                                list.reverse
-                                (list/map (|>> (n/* +2) inc #.Parameter))
-                                (#.Primitive class-name)
-                                (type.univ-q arity)))))
-
-        (host.instance? ParameterizedType java-type)
-        (let [java-type (:coerce ParameterizedType java-type)
-              raw (ParameterizedType::getRawType [] java-type)]
-          (if (host.instance? Class raw)
-            (do ////.Monad
-              [paramsT (|> java-type
-                           (ParameterizedType::getActualTypeArguments [])
-                           array.to-list
-                           (monad.map @ (java-type-to-lux-type mappings)))]
-              (operation/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw))
-                                           paramsT)))
-            (////.throw jvm-type-is-not-a-class raw)))
-
-        (host.instance? GenericArrayType java-type)
-        (do ////.Monad
-          [innerT (|> (:coerce GenericArrayType java-type)
-                      (GenericArrayType::getGenericComponentType [])
-                      (java-type-to-lux-type mappings))]
-          (wrap (#.Primitive "#Array" (list innerT))))
-
-        ## else
-        (////.throw cannot-convert-to-a-lux-type java-type)))
-
-(def: (correspond-type-params class type)
-  (-> (Class Object) Type (Operation Mappings))
-  (case type
-    (#.Primitive name params)
-    (let [class-name (Class::getName [] class)
-          class-params (array.to-list (Class::getTypeParameters [] class))
-          num-class-params (list.size class-params)
-          num-type-params (list.size params)]
-      (cond (not (text/= class-name name))
-            (////.throw cannot-correspond-type-with-a-class
-                        (format "Class = " class-name "\n"
-                                "Type = " (%type type)))
-
-            (not (n/= num-class-params num-type-params))
-            (////.throw type-parameter-mismatch
-                        (format "Expected: " (%i (.int num-class-params)) "\n"
-                                "  Actual: " (%i (.int num-type-params)) "\n"
-                                "   Class: " class-name "\n"
-                                "    Type: " (%type type)))
-
-            ## else
-            (operation/wrap (|> params
-                                (list.zip2 (list/map (TypeVariable::getName []) class-params))
-                                (dictionary.from-list text.Hash)))
-            ))
-
-    _
-    (////.throw non-jvm-type type)))
-
-(def: object::cast
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list valueC))
-      (do ////.Monad
-        [toT (///.lift macro.expected-type)
-         to-name (check-jvm toT)
-         [valueT valueA] (typeA.with-inference
-                           (analyse valueC))
-         from-name (check-jvm valueT)
-         can-cast? (: (Operation Bit)
-                      (case [from-name to-name]
-                        (^template [ ]
-                          (^or [ ]
-                               [ ])
-                          (do @
-                            [_ (typeA.infer (#.Primitive to-name (list)))]
-                            (wrap #1)))
-                        (["boolean" "java.lang.Boolean"]
-                         ["byte"    "java.lang.Byte"]
-                         ["short"   "java.lang.Short"]
-                         ["int"     "java.lang.Integer"]
-                         ["long"    "java.lang.Long"]
-                         ["float"   "java.lang.Float"]
-                         ["double"  "java.lang.Double"]
-                         ["char"    "java.lang.Character"])
-
-                        _
-                        (do @
-                          [_ (////.assert primitives-are-not-objects from-name
-                                          (not (dictionary.contains? from-name boxes)))
-                           _ (////.assert primitives-are-not-objects to-name
-                                          (not (dictionary.contains? to-name boxes)))
-                           to-class (load-class to-name)]
-                          (loop [[current-name currentT] [from-name valueT]]
-                            (if (text/= to-name current-name)
-                              (do @
-                                [_ (typeA.infer toT)]
-                                (wrap #1))
-                              (do @
-                                [current-class (load-class current-name)
-                                 _ (////.assert cannot-cast (format "From class/primitive: " current-name "\n"
-                                                                    "  To class/primitive: " to-name "\n"
-                                                                    "           For value: " (%code valueC) "\n")
-                                                (Class::isAssignableFrom [current-class] to-class))
-                                 candiate-parents (monad.map @
-                                                             (function (_ java-type)
-                                                               (do @
-                                                                 [class-name (java-type-to-class java-type)
-                                                                  class (load-class class-name)]
-                                                                 (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)])))
-                                                             (list& (Class::getGenericSuperclass [] current-class)
-                                                                    (array.to-list (Class::getGenericInterfaces [] current-class))))]
-                                (case (|> candiate-parents
-                                          (list.filter product.right)
-                                          (list/map product.left))
-                                  (#.Cons [next-name nextJT] _)
-                                  (do @
-                                    [mapping (correspond-type-params current-class currentT)
-                                     nextT (java-type-to-lux-type mapping nextJT)]
-                                    (recur [next-name nextT]))
-
-                                  #.Nil
-                                  (////.throw cannot-cast (format "From class/primitive: " from-name "\n"
-                                                                  "  To class/primitive: " to-name "\n"
-                                                                  "           For value: " (%code valueC) "\n")))
-                                ))))))]
-        (if can-cast?
-          (wrap (#analysis.Extension extension-name (list (analysis.text from-name)
-                                                          (analysis.text to-name)
-                                                          valueA)))
-          (////.throw cannot-cast (format "From class/primitive: " from-name "\n"
-                                          "  To class/primitive: " to-name "\n"
-                                          "           For value: " (%code valueC) "\n"))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: bundle::object
-  Bundle
-  (<| (bundle.prefix "object")
-      (|> bundle.empty
-          (bundle.install "null" object::null)
-          (bundle.install "null?" object::null?)
-          (bundle.install "synchronized" object::synchronized)
-          (bundle.install "throw" object::throw)
-          (bundle.install "class" object::class)
-          (bundle.install "instance?" object::instance?)
-          (bundle.install "cast" object::cast)
-          )))
-
-(def: (find-field class-name field-name)
-  (-> Text Text (Operation [(Class Object) Field]))
-  (do ////.Monad
-    [class (load-class class-name)]
-    (case (Class::getDeclaredField [field-name] class)
-      (#e.Success field)
-      (let [owner (Field::getDeclaringClass [] field)]
-        (if (is? owner class)
-          (wrap [class field])
-          (////.throw mistaken-field-owner
-                      (format "       Field: " field-name "\n"
-                              " Owner Class: " (Class::getName [] owner) "\n"
-                              "Target Class: " class-name "\n"))))
-
-      (#e.Error _)
-      (////.throw unknown-field (format class-name "#" field-name)))))
-
-(def: (static-field class-name field-name)
-  (-> Text Text (Operation [Type Bit]))
-  (do ////.Monad
-    [[class fieldJ] (find-field class-name field-name)
-     #let [modifiers (Field::getModifiers [] fieldJ)]]
-    (if (Modifier::isStatic [modifiers])
-      (let [fieldJT (Field::getGenericType [] fieldJ)]
-        (do @
-          [fieldT (java-type-to-lux-type fresh-mappings fieldJT)]
-          (wrap [fieldT (Modifier::isFinal [modifiers])])))
-      (////.throw not-a-static-field (format class-name "#" field-name)))))
-
-(def: (virtual-field class-name field-name objectT)
-  (-> Text Text Type (Operation [Type Bit]))
-  (do ////.Monad
-    [[class fieldJ] (find-field class-name field-name)
-     #let [modifiers (Field::getModifiers [] fieldJ)]]
-    (if (not (Modifier::isStatic [modifiers]))
-      (do @
-        [#let [fieldJT (Field::getGenericType [] fieldJ)
-               var-names (|> class
-                             (Class::getTypeParameters [])
-                             array.to-list
-                             (list/map (TypeVariable::getName [])))]
-         mappings (: (Operation Mappings)
-                     (case objectT
-                       (#.Primitive _class-name _class-params)
-                       (do @
-                         [#let [num-params (list.size _class-params)
-                                num-vars (list.size var-names)]
-                          _ (////.assert type-parameter-mismatch
-                                         (format "Expected: " (%i (.int num-params)) "\n"
-                                                 "  Actual: " (%i (.int num-vars)) "\n"
-                                                 "   Class: " _class-name "\n"
-                                                 "    Type: " (%type objectT))
-                                         (n/= num-params num-vars))]
-                         (wrap (|> (list.zip2 var-names _class-params)
-                                   (dictionary.from-list text.Hash))))
-
-                       _
-                       (////.throw non-object objectT)))
-         fieldT (java-type-to-lux-type mappings fieldJT)]
-        (wrap [fieldT (Modifier::isFinal [modifiers])]))
-      (////.throw not-a-virtual-field (format class-name "#" field-name)))))
-
-(def: static::get
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.Monad
-          [[fieldT final?] (static-field class field)]
-          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field)))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +2 (list.size args)]))))
-
-(def: static::put
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC valueC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.Monad
-          [_ (typeA.infer Any)
-           [fieldT final?] (static-field class field)
-           _ (////.assert cannot-set-a-final-field (format class "#" field)
-                          (not final?))
-           valueA (typeA.with-type fieldT
-                    (analyse valueC))]
-          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)]))))
-
-(def: virtual::get
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC objectC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.Monad
-          [[objectT objectA] (typeA.with-inference
-                               (analyse objectC))
-           [fieldT final?] (virtual-field class field objectT)]
-          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) objectA))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +3 (list.size args)]))))
-
-(def: virtual::put
-  Handler
-  (function (_ extension-name analyse args)
-    (case args
-      (^ (list classC fieldC valueC objectC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do ////.Monad
-          [[objectT objectA] (typeA.with-inference
-                               (analyse objectC))
-           _ (typeA.infer objectT)
-           [fieldT final?] (virtual-field class field objectT)
-           _ (////.assert cannot-set-a-final-field (format class "#" field)
-                          (not final?))
-           valueA (typeA.with-type fieldT
-                    (analyse valueC))]
-          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA objectA))))
-
-        _
-        (////.throw bundle.invalid-syntax extension-name))
-
-      _
-      (////.throw bundle.incorrect-arity [extension-name +4 (list.size args)]))))
-
-(def: (java-type-to-parameter type)
-  (-> java/lang/reflect/Type (Operation Text))
-  (cond (host.instance? Class type)
-        (operation/wrap (Class::getName [] (:coerce Class type)))
-
-        (host.instance? ParameterizedType type)
-        (java-type-to-parameter (ParameterizedType::getRawType [] (:coerce ParameterizedType type)))
-
-        (or (host.instance? TypeVariable type)
-            (host.instance? WildcardType type))
-        (operation/wrap "java.lang.Object")
-
-        (host.instance? GenericArrayType type)
-        (do ////.Monad
-          [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))]
-          (wrap (format componentP "[]")))
-
-        ## else
-        (////.throw cannot-convert-to-a-parameter type)))
-
-(type: Method-Style
-  #Static
-  #Abstract
-  #Virtual
-  #Special
-  #Interface)
-
-(def: (check-method class method-name method-style arg-classes method)
-  (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit))
-  (do ////.Monad
-    [parameters (|> (Method::getGenericParameterTypes [] method)
-                    array.to-list
-                    (monad.map @ java-type-to-parameter))
-     #let [modifiers (Method::getModifiers [] method)]]
-    (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method))
-               (text/= method-name (Method::getName [] method))
-               (case #Static
-                 #Special
-                 (Modifier::isStatic [modifiers])
-
-                 _
-                 #1)
-               (case method-style
-                 #Special
-                 (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
-                          (Modifier::isAbstract [modifiers])))
-
-                 _
-                 #1)
-               (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function (_ [expectedJC actualJC] prev)
-                            (and prev
-                                 (text/= expectedJC actualJC)))
-                          #1
-                          (list.zip2 arg-classes parameters))))))
-
-(def: (check-constructor class arg-classes constructor)
-  (-> (Class Object) (List Text) (Constructor Object) (Operation Bit))
-  (do ////.Monad
-    [parameters (|> (Constructor::getGenericParameterTypes [] constructor)
-                    array.to-list
-                    (monad.map @ java-type-to-parameter))]
-    (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
-               (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function (_ [expectedJC actualJC] prev)
-                            (and prev
-                                 (text/= expectedJC actualJC)))
-                          #1
-                          (list.zip2 arg-classes parameters))))))
-
-(def: idx-to-parameter
-  (-> Nat Type)
-  (|>> (n/* +2) inc #.Parameter))
-
-(def: (type-vars amount offset)
-  (-> Nat Nat (List Type))
-  (if (n/= +0 amount)
-    (list)
-    (|> (list.n/range offset (|> amount dec (n/+ offset)))
-        (list/map idx-to-parameter))))
-
-(def: (method-signature method-style method)
-  (-> Method-Style Method (Operation Method-Signature))
-  (let [owner (Method::getDeclaringClass [] method)
-        owner-name (Class::getName [] owner)
-        owner-tvars (case method-style
-                      #Static
-                      (list)
-
-                      _
-                      (|> (Class::getTypeParameters [] owner)
-                          array.to-list
-                          (list/map (TypeVariable::getName []))))
-        method-tvars (|> (Method::getTypeParameters [] method)
-                         array.to-list
-                         (list/map (TypeVariable::getName [])))
-        num-owner-tvars (list.size owner-tvars)
-        num-method-tvars (list.size method-tvars)
-        all-tvars (list/compose owner-tvars method-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars +0)
-        method-tvarsT (type-vars num-method-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list/compose owner-tvarsT method-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dictionary.from-list text.Hash))))]
-    (do ////.Monad
-      [inputsT (|> (Method::getGenericParameterTypes [] method)
-                   array.to-list
-                   (monad.map @ (java-type-to-lux-type mappings)))
-       outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method))
-       exceptionsT (|> (Method::getGenericExceptionTypes [] method)
-                       array.to-list
-                       (monad.map @ (java-type-to-lux-type mappings)))
-       #let [methodT (<| (type.univ-q num-all-tvars)
-                         (type.function (case method-style
-                                          #Static
-                                          inputsT
-
-                                          _
-                                          (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
-                                                 inputsT)))
-                         outputT)]]
-      (wrap [methodT exceptionsT]))))
-
-(type: Evaluation
-  (#Pass Method-Signature)
-  (#Hint Method-Signature)
-  #Fail)
-
-(do-template [ ]
-  [(def: 
-     (-> Evaluation (Maybe Method-Signature))
-     (|>> (case> ( output)
-                 (#.Some output)
-
-                 _
-                 #.None)))]
-
-  [pass! #Pass]
-  [hint! #Hint]
-  )
-
-(def: (method-candidate class-name method-name method-style arg-classes)
-  (-> Text Text Method-Style (List Text) (Operation Method-Signature))
-  (do ////.Monad
-    [class (load-class class-name)
-     candidates (|> class
-                    (Class::getDeclaredMethods [])
-                    array.to-list
-                    (monad.map @ (: (-> Method (Operation Evaluation))
-                                    (function (_ method)
-                                      (do @
-                                        [passes? (check-method class method-name method-style arg-classes method)]
-                                        (cond passes?
-                                              (:: @ map (|>> #Pass) (method-signature method-style method))
-
-                                              (text/= method-name (Method::getName [] method))
-                                              (:: @ map (|>> #Hint) (method-signature method-style method))
-
-                                              ## else
-                                              (wrap #Fail)))))))]
-    (case (list.search-all pass! candidates)
-      #.Nil
-      (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
-      
-      (#.Cons method #.Nil)
-      (wrap method)
-
-      candidates
-      (////.throw too-many-candidates [class-name method-name candidates]))))
-
-(def: (constructor-signature constructor)
-  (-> (Constructor Object) (Operation Method-Signature))
-  (let [owner (Constructor::getDeclaringClass [] constructor)
-        owner-name (Class::getName [] owner)
-        owner-tvars (|> (Class::getTypeParameters [] owner)
-                        array.to-list
-                        (list/map (TypeVariable::getName [])))
-        constructor-tvars (|> (Constructor::getTypeParameters [] constructor)
-                              array.to-list
-                              (list/map (TypeVariable::getName [])))
-        num-owner-tvars (list.size owner-tvars)
-        all-tvars (list/compose owner-tvars constructor-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars +0)
-        constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list/compose owner-tvarsT constructor-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dictionary.from-list text.Hash))))]
-    (do ////.Monad
-      [inputsT (|> (Constructor::getGenericParameterTypes [] constructor)
-                   array.to-list
-                   (monad.map @ (java-type-to-lux-type mappings)))
-       exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor)
-                       array.to-list
-                       (monad.map @ (java-type-to-lux-type mappings)))
-       #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT))
-             constructorT (<| (type.univ-q num-all-tvars)
-                              (type.function inputsT)
-                              objectT)]]
-      (wrap [constructorT exceptionsT]))))
-
-(def: constructor-method "")
-
-(def: (constructor-candidate class-name arg-classes)
-  (-> Text (List Text) (Operation Method-Signature))
-  (do ////.Monad
-    [class (load-class class-name)
-     candidates (|> class
-                    (Class::getConstructors [])
-                    array.to-list
-                    (monad.map @ (function (_ constructor)
-                                   (do @
-                                     [passes? (check-constructor class arg-classes constructor)]
-                                     (:: @ map
-                                         (if passes? (|>> #Pass) (|>> #Hint))
-                                         (constructor-signature constructor))))))]
-    (case (list.search-all pass! candidates)
-      #.Nil
-      (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
-      
-      (#.Cons constructor #.Nil)
-      (wrap constructor)
-
-      candidates
-      (////.throw too-many-candidates [class-name ..constructor-method candidates]))))
-
-(def: (decorate-inputs typesT inputsA)
-  (-> (List Text) (List Analysis) (List Analysis))
-  (|> inputsA
-      (list.zip2 (list/map analysis.text typesT))
-      (list/map (function (_ [type value])
-                  (analysis.product-analysis (list type value))))))
-
-(def: invoke::static
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (e.Error [Text Text (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class method argsTC])
-      (do ////.Monad
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Static argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))
-         outputJC (check-jvm outputT)]
-        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
-                                                         (analysis.text outputJC) (decorate-inputs argsT argsA)))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: invoke::virtual
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (e.Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class method objectC argsTC])
-      (do ////.Monad
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Virtual argsT)
-         [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
-         #let [[objectA argsA] (case allA
-                                 (#.Cons objectA argsA)
-                                 [objectA argsA]
-
-                                 _
-                                 (undefined))]
-         outputJC (check-jvm outputT)]
-        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
-                                                         (analysis.text outputJC) objectA (decorate-inputs argsT argsA)))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: invoke::special
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Any]])
-             (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
-      (#e.Success [_ [class method objectC argsTC _]])
-      (do ////.Monad
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (method-candidate class method #Special argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
-         outputJC (check-jvm outputT)]
-        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
-                                                         (analysis.text outputJC) (decorate-inputs argsT argsA)))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: invoke::interface
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (e.Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class-name method objectC argsTC])
-      (do ////.Monad
-        [#let [argsT (list/map product.left argsTC)]
-         class (load-class class-name)
-         _ (////.assert non-interface class-name
-                        (Modifier::isInterface [(Class::getModifiers [] class)]))
-         [methodT exceptionsT] (method-candidate class-name method #Interface argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
-         outputJC (check-jvm outputT)]
-        (wrap (#analysis.Extension extension-name
-                                   (list& (analysis.text class-name) (analysis.text method) (analysis.text outputJC)
-                                          (decorate-inputs argsT argsA)))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: invoke::constructor
-  Handler
-  (function (_ extension-name analyse args)
-    (case (: (e.Error [Text (List [Text Code])])
-             (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class argsTC])
-      (do ////.Monad
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (constructor-candidate class argsT)
-         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))]
-        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (decorate-inputs argsT argsA)))))
-
-      _
-      (////.throw bundle.invalid-syntax extension-name))))
-
-(def: bundle::member
-  Bundle
-  (<| (bundle.prefix "member")
-      (|> bundle.empty
-          (dictionary.merge (<| (bundle.prefix "static")
-                                (|> bundle.empty
-                                    (bundle.install "get" static::get)
-                                    (bundle.install "put" static::put))))
-          (dictionary.merge (<| (bundle.prefix "virtual")
-                                (|> bundle.empty
-                                    (bundle.install "get" virtual::get)
-                                    (bundle.install "put" virtual::put))))
-          (dictionary.merge (<| (bundle.prefix "invoke")
-                                (|> 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: #export bundle
-  Bundle
-  (<| (bundle.prefix "jvm")
-      (|> bundle.empty
-          (dictionary.merge bundle::conversion)
-          (dictionary.merge bundle::int)
-          (dictionary.merge bundle::long)
-          (dictionary.merge bundle::float)
-          (dictionary.merge bundle::double)
-          (dictionary.merge bundle::char)
-          (dictionary.merge bundle::array)
-          (dictionary.merge bundle::object)
-          (dictionary.merge bundle::member)
-          )))
diff --git a/stdlib/source/lux/language/compiler/extension/bundle.lux b/stdlib/source/lux/language/compiler/extension/bundle.lux
deleted file mode 100644
index e2d36fa73..000000000
--- a/stdlib/source/lux/language/compiler/extension/bundle.lux
+++ /dev/null
@@ -1,38 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." text
-     format]
-    [collection
-     [list ("list/." Functor)]
-     ["dict" dictionary (#+ Dictionary)]]]]
-  [// (#+ Handler Bundle)])
-
-(exception: #export (incorrect-arity {name Text} {arity Nat} {args Nat})
-  (ex.report ["Extension" (%t name)]
-             ["Expected arity" (|> arity .int %i)]
-             ["Actual arity" (|> args .int %i)]))
-
-(exception: #export (invalid-syntax {name Text})
-  (ex.report ["Extension" name]))
-
-## [Utils]
-(def: #export empty
-  Bundle
-  (dict.new text.Hash))
-
-(def: #export (install name anonymous)
-  (All [s i o]
-    (-> Text (Handler s i o)
-        (-> (Bundle s i o) (Bundle s i o))))
-  (dict.put name anonymous))
-
-(def: #export (prefix prefix)
-  (All [s i o]
-    (-> Text (-> (Bundle s i o) (Bundle s i o))))
-  (|>> dict.entries
-       (list/map (function (_ [key val]) [(format prefix " " key) val]))
-       (dict.from-list text.Hash)))
diff --git a/stdlib/source/lux/language/compiler/extension/synthesis.lux b/stdlib/source/lux/language/compiler/extension/synthesis.lux
deleted file mode 100644
index d907808a8..000000000
--- a/stdlib/source/lux/language/compiler/extension/synthesis.lux
+++ /dev/null
@@ -1,10 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [text]
-    [collection ["dict" dictionary (#+ Dictionary)]]]]
-  [//])
-
-(def: #export defaults
-  (Dictionary Text //.Synthesis)
-  (dict.new text.Hash))
diff --git a/stdlib/source/lux/language/compiler/extension/translation.lux b/stdlib/source/lux/language/compiler/extension/translation.lux
deleted file mode 100644
index 3a43e0dcb..000000000
--- a/stdlib/source/lux/language/compiler/extension/translation.lux
+++ /dev/null
@@ -1,10 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [text]
-    [collection ["dict" dictionary (#+ Dictionary)]]]]
-  [//])
-
-(def: #export defaults
-  (Dictionary Text //.Translation)
-  (dict.new text.Hash))
diff --git a/stdlib/source/lux/language/compiler/init.lux b/stdlib/source/lux/language/compiler/init.lux
deleted file mode 100644
index 648211ca7..000000000
--- a/stdlib/source/lux/language/compiler/init.lux
+++ /dev/null
@@ -1,51 +0,0 @@
-(.module:
-  lux
-  ["." ///
-   ["." host]])
-
-(def: #export (cursor file)
-  (-> Text Cursor)
-  [file +1 +0])
-
-(def: #export (source file code)
-  (-> Text Text Source)
-  [(cursor file) +0 code])
-
-(def: dummy-source
-  Source
-  [.dummy-cursor +0 ""])
-
-(def: #export type-context
-  Type-Context
-  {#.ex-counter +0
-   #.var-counter +0
-   #.var-bindings (list)})
-
-(`` (def: #export info
-      Info
-      {#.target  (for {(~~ (static host.common-lisp)) host.common-lisp
-                       (~~ (static host.js))          host.js
-                       (~~ (static host.jvm))         host.jvm
-                       (~~ (static host.lua))         host.lua
-                       (~~ (static host.php))         host.php
-                       (~~ (static host.python))      host.python
-                       (~~ (static host.r))           host.r
-                       (~~ (static host.ruby))        host.ruby
-                       (~~ (static host.scheme))      host.scheme})
-       #.version ///.version
-       #.mode    #.Build}))
-
-(def: #export (compiler host)
-  (-> Any Lux)
-  {#.info            ..info
-   #.source          dummy-source
-   #.cursor          .dummy-cursor
-   #.current-module  #.None
-   #.modules         (list)
-   #.scopes          (list)
-   #.type-context    ..type-context
-   #.expected        #.None
-   #.seed            +0
-   #.scope-type-vars (list)
-   #.extensions      []
-   #.host            host})
diff --git a/stdlib/source/lux/language/compiler/meta/archive.lux b/stdlib/source/lux/language/compiler/meta/archive.lux
deleted file mode 100644
index 9feaf523f..000000000
--- a/stdlib/source/lux/language/compiler/meta/archive.lux
+++ /dev/null
@@ -1,121 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["ex" exception (#+ exception:)]
-    ["." equivalence (#+ Equivalence)]
-    ["." monad (#+ do)]]
-   [data
-    ["." error (#+ Error)]
-    ["." ident]
-    ["." text
-     format]
-    [collection
-     ["dict" dictionary (#+ Dictionary)]]]
-   [type (#+ :share)
-    abstract]
-   [world
-    [file (#+ File)]]]
-  ["." //// (#+ Version)])
-
-## Key
-(type: #export Signature
-  {#name Ident
-   #version Version})
-
-(def: Equivalence
-  (Equivalence Signature)
-  (equivalence.product ident.Equivalence text.Equivalence))
-
-(def: (describe signature)
-  (-> Signature Text)
-  (format (%ident (get@ #name signature)) " " (get@ #version signature)))
-
-(abstract: #export (Key k)
-  {}
-
-  Signature
-
-  (structure: #export Equivalence
-    (All [k] (Equivalence (Key k)))
-    (def: (= reference sample)
-      (:: Equivalence = (:representation reference) (:representation sample))))
-
-  (def: #export default
-    (Key Nothing)
-    (:abstraction {#name ["" ""]
-                   #version ////.version}))
-
-  (def: #export signature
-    (-> (Key Any) Signature)
-    (|>> :representation))
-  )
-
-## Document
-(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)})
-  (ex.report ["Expected" (describe (..signature expected))]
-             ["Actual" (describe (..signature actual))]))
-
-(exception: #export (signature-does-not-match-key {key (Key Any)} {signature Signature})
-  (ex.report ["Key" (describe (..signature key))]
-             ["Signature" (describe signature)]))
-
-(type: #export Reference Text)
-
-(type: #export Descriptor
-  {#hash Nat
-   #file File
-   #references (List Reference)
-   #state Module-State})
-
-(type: #export (Document d)
-  {#key (Key d)
-   #descriptor Descriptor
-   #content d})
-
-(def: #export (open expected [actual _descriptor content])
-  (All [d] (-> (Key d) (Document Any) (Error d)))
-  (if (:: Equivalence = expected actual)
-    (#error.Success (:share [e]
-                            {(Key e)
-                             expected}
-                            {e
-                             content}))
-    (ex.throw invalid-key-for-document [expected actual])))
-
-(def: #export (close key signature descriptor content)
-  (All [d] (-> (Key d) Signature Descriptor d (Error (Document d))))
-  (if (:: Equivalence = (..signature key) signature)
-    (#error.Success {#key key
-                     #descriptor descriptor
-                     #content content})
-    (ex.throw signature-does-not-match-key [key signature])))
-
-## Archive
-(exception: #export (cannot-replace-document-in-archive {name Text} {old (Document Any)} {new (Document Any)})
-  (ex.report ["Module's name" name]
-             ["Old document's key" (describe (..signature (get@ #key old)))]
-             ["New document's key" (describe (..signature (get@ #key new)))]))
-
-(type: #export Archive
-  (Dictionary Text (Ex [d] (Document d))))
-
-(def: #export empty Archive (dict.new text.Hash))
-
-(def: #export (add name document archive)
-  (-> Text (Ex [d] (Document d)) Archive (Error Archive))
-  (case (dict.get name archive)
-    (#.Some existing)
-    (if (is? document existing)
-      (#error.Success archive)
-      (ex.throw cannot-replace-document-in-archive [name existing document]))
-    
-    #.None
-    (#error.Success (dict.put name document archive))))
-
-(def: #export (merge additions archive)
-  (-> Archive Archive (Error Archive))
-  (monad.fold error.Monad
-              (function (_ [name' document'] archive')
-                (..add name' document' archive'))
-              archive
-              (dict.entries additions)))
diff --git a/stdlib/source/lux/language/compiler/meta/cache.lux b/stdlib/source/lux/language/compiler/meta/cache.lux
deleted file mode 100644
index eb702c0da..000000000
--- a/stdlib/source/lux/language/compiler/meta/cache.lux
+++ /dev/null
@@ -1,167 +0,0 @@
-(.module:
-  [lux (#- Module)
-   [control
-    ["." monad (#+ Monad do)]
-    ["ex" exception (#+ exception:)]
-    pipe]
-   [data
-    ["." bit ("bit/." Equivalence)]
-    ["." maybe]
-    ["." error]
-    ["." product]
-    [format
-     ["." binary (#+ Format)]]
-    ["." text
-     [format (#- Format)]]
-    [collection
-     ["." list ("list/." Functor Fold)]
-     ["dict" dictionary (#+ Dictionary)]
-     ["." set (#+ Set)]]]
-   [world
-    [file (#+ File System)]]]
-  [//io (#+ Context Module)]
-  ["." //io/context]
-  ["." //io/archive]
-  ["." //archive (#+ Signature Key Descriptor Document Archive)]
-  ["." /dependency (#+ Dependency Graph)])
-
-(exception: #export (cannot-delete-cached-file {file File})
-  (ex.report ["File" file]))
-
-(exception: #export (stale-document {module Text} {current-hash Nat} {stale-hash Nat})
-  (ex.report ["Module" module]
-             ["Current hash" (%n current-hash)]
-             ["Stale hash" (%n stale-hash)]))
-
-(do-template []
-  [(exception: #export ( {message Text})
-     message)]
-
-  [cannot-load-definition]
-  )
-
-## General
-(def: #export (cached System root)
-  (All [m] (-> (System m) File (m (List File))))
-  (|> root
-      (//io/archive.archive System)
-      (do> (:: System &monad)
-           [(:: System files)]
-           [(monad.map @ (function (recur file)
-                           (do @
-                             [is-dir? (:: System directory? file)]
-                             (if is-dir?
-                               (|> file
-                                   (do> @
-                                        [(:: System files)]
-                                        [(monad.map @ recur)]
-                                        [list.concat
-                                         (list& (maybe.assume (//io/archive.module System root file)))
-                                         wrap]))
-                               (wrap (list))))))]
-           [list.concat wrap])))
-
-## Clean
-(def: (delete System document)
-  (All [m] (-> (System m) File (m Any)))
-  (do (:: System &monad)
-    [deleted? (:: System delete document)]
-    (if deleted?
-      (wrap [])
-      (:: System throw cannot-delete-cached-file document))))
-
-(def: (un-install System root module)
-  (All [m] (-> (System m) File Module (m Any)))
-  (let [document (//io/archive.document System root module)]
-    (|> document
-        (do> (:: System &monad)
-             [(:: System files)]
-             [(monad.map @ (function (_ file)
-                             (do @
-                               [? (:: System directory? file)]
-                               (if ?
-                                 (wrap #0)
-                                 (do @
-                                   [_ (..delete System file)]
-                                   (wrap #1))))))]
-             [(list.every? (bit/= #1))
-              (if> [(..delete System document)]
-                   [(wrap [])])]))))
-
-(def: #export (clean System root wanted-modules)
-  (All [m] (-> (System m) File (Set Module) (m Any)))
-  (|> root
-      (do> (:: System &monad)
-           [(..cached System)]
-           [(list.filter (bit.complement (set.member? wanted-modules)))
-            (monad.map @ (un-install System root))])))
-
-## Load
-(def: signature
-  (Format Signature)
-  ($_ binary.seq binary.ident binary.text))
-
-(def: descriptor
-  (Format Descriptor)
-  ($_ binary.seq binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))
-
-(def: document
-  (All [a] (-> (Format a) (Format [Signature Descriptor a])))
-  (|>> ($_ binary.seq ..signature ..descriptor)))
-
-(def: (load-document System contexts root key binary module)
-  (All [m d] (-> (System m) (List File) File (Key d) (Format d) Module
-                 (m (Maybe [Dependency (Document d)]))))
-  (do (:: System &monad)
-    [document' (:: System read (//io/archive.document System root module))
-     [module' source-code] (//io/context.read System contexts module)
-     #let [current-hash (:: text.Hash hash source-code)]]
-    (case (do error.Monad
-            [[signature descriptor content] (binary.read (..document binary) document')
-             #let [[document-hash _file references _state] descriptor]
-             _ (ex.assert stale-document [module current-hash document-hash]
-                          (n/= current-hash document-hash))
-             document (//archive.close key signature descriptor content)]
-            (wrap [[module references] document]))
-      (#error.Success [dependency document])
-      (wrap (#.Some [dependency document]))
-      
-      (#error.Error error)
-      (do @
-        [_ (un-install System root module)]
-        (wrap #.None)))))
-
-(def: #export (load-archive System contexts root key binary)
-  (All [m d] (-> (System m) (List Context) File (Key d) (Format d) (m Archive)))
-  (do (:: System &monad)
-    [candidate (|> root
-                   (do> @
-                        [(..cached System)]
-                        [(monad.map @ (load-document System contexts root key binary))
-                         (:: @ map (list/fold (function (_ full-document archive)
-                                                (case full-document
-                                                  (#.Some [[module references] document])
-                                                  (dict.put module [references document] archive)
-                                                  
-                                                  #.None
-                                                  archive))
-                                              (: (Dictionary Text [(List Module) (Ex [d] (Document d))])
-                                                 (dict.new text.Hash))))]))
-     #let [candidate-entries (dict.entries candidate)
-           candidate-dependencies (list/map (product.both id product.left)
-                                            candidate-entries)
-           candidate-archive (|> candidate-entries
-                                 (list/map (product.both id product.right))
-                                 (dict.from-list text.Hash))
-           graph (|> candidate
-                     dict.entries
-                     (list/map (product.both id product.left))
-                     /dependency.graph
-                     (/dependency.prune candidate-archive))
-           archive (list/fold (function (_ module archive)
-                                (if (dict.contains? module graph)
-                                  archive
-                                  (dict.remove module archive)))
-                              candidate-archive
-                              (dict.keys candidate))]]
-    (wrap archive)))
diff --git a/stdlib/source/lux/language/compiler/meta/cache/dependency.lux b/stdlib/source/lux/language/compiler/meta/cache/dependency.lux
deleted file mode 100644
index e63fa192b..000000000
--- a/stdlib/source/lux/language/compiler/meta/cache/dependency.lux
+++ /dev/null
@@ -1,53 +0,0 @@
-(.module:
-  [lux (#- Module)
-   [data
-    ["." text]
-    [collection
-     [list ("list/." Functor Fold)]
-     ["dict" dictionary (#+ Dictionary)]]]]
-  [///io (#+ Module)]
-  [///archive (#+ Archive)])
-
-(type: #export Graph (Dictionary Module (List Module)))
-
-(def: #export empty Graph (dict.new text.Hash))
-
-(def: #export (add to from)
-  (-> Module Module Graph Graph)
-  (|>> (dict.update~ from (list) (|>> (#.Cons to)))
-       (dict.update~ to (list) id)))
-
-(def: dependents
-  (-> Module Graph (Maybe (List Text)))
-  dict.get)
-
-(def: #export (remove module dependency)
-  (-> Module Graph Graph)
-  (case (dependents module dependency)
-    (#.Some dependents)
-    (list/fold remove (dict.remove module dependency) dependents)
-
-    #.None
-    dependency))
-
-(type: #export Dependency
-  {#module Module
-   #imports (List Module)})
-
-(def: #export (dependency [module imports])
-  (-> Dependency Graph)
-  (list/fold (..add module) ..empty imports))
-
-(def: #export graph
-  (-> (List Dependency) Graph)
-  (|>> (list/map ..dependency)
-       (list/fold dict.merge empty)))
-
-(def: #export (prune archive graph)
-  (-> Archive Graph Graph)
-  (list/fold (function (_ module graph)
-               (if (dict.contains? module archive)
-                 graph
-                 (..remove module graph)))
-             graph
-             (dict.keys graph)))
diff --git a/stdlib/source/lux/language/compiler/meta/io.lux b/stdlib/source/lux/language/compiler/meta/io.lux
deleted file mode 100644
index a46f78d5a..000000000
--- a/stdlib/source/lux/language/compiler/meta/io.lux
+++ /dev/null
@@ -1,14 +0,0 @@
-(.module:
-  [lux (#- Module)
-   [data
-    ["." text]]
-   [world
-    [file (#+ File System)]]])
-
-(type: #export Context File)
-
-(type: #export Module Text)
-
-(def: #export (sanitize system)
-  (All [m] (-> (System m) Text Text))
-  (text.replace-all "/" (:: system separator)))
diff --git a/stdlib/source/lux/language/compiler/meta/io/archive.lux b/stdlib/source/lux/language/compiler/meta/io/archive.lux
deleted file mode 100644
index 5a7789a95..000000000
--- a/stdlib/source/lux/language/compiler/meta/io/archive.lux
+++ /dev/null
@@ -1,73 +0,0 @@
-(.module:
-  [lux (#- Module)
-   [control
-    monad
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." error]
-    ["." text
-     format]]
-   [world
-    ["." file (#+ File System)]
-    [binary (#+ Binary)]]]
-  ["." /////host]
-  ["." // (#+ Module)])
-
-(type: #export Document File)
-
-(exception: #export (cannot-prepare {archive File} {module Module})
-  (ex.report ["Archive" archive]
-             ["Module" module]))
-
-(def: #export (archive System root)
-  (All [m] (-> (System m) File File))
-  (<| (format root (:: System separator))
-      (`` (for {(~~ (static /////host.common-lisp)) /////host.common-lisp
-                (~~ (static /////host.js))          /////host.js
-                (~~ (static /////host.jvm))         /////host.jvm
-                (~~ (static /////host.lua))         /////host.lua
-                (~~ (static /////host.php))         /////host.php
-                (~~ (static /////host.python))      /////host.python
-                (~~ (static /////host.r))           /////host.r
-                (~~ (static /////host.ruby))        /////host.ruby
-                (~~ (static /////host.scheme))      /////host.scheme}))))
-
-(def: #export (document System root module)
-  (All [m] (-> (System m) File Module Document))
-  (let [archive (..archive System root)]
-    (|> module
-        (//.sanitize System)
-        (format archive (:: System separator)))))
-
-(def: #export (prepare System root module)
-  (All [m] (-> (System m) File Module (m Any)))
-  (do (:: System &monad)
-    [#let [archive (..archive System root)
-           document (..document System root module)]
-     document-exists? (file.exists? System document)]
-    (if document-exists?
-      (wrap [])
-      (do @
-        [outcome (:: System try (:: System make-directory document))]
-        (case outcome
-          (#error.Success output)
-          (wrap output)
-
-          (#error.Error _)
-          (:: System throw cannot-prepare [archive module]))))))
-
-(def: #export (write System root content name)
-  (All [m] (-> (System m) File Binary Text (m Any)))
-  (:: System write content (..document System root name)))
-
-(def: #export (module System root document)
-  (All [m] (-> (System m) File Document (Maybe Module)))
-  (case (text.split-with (..archive System root) document)
-    (#.Some ["" post])
-    (let [raw (text.replace-all (:: System separator) "/" post)]
-      (if (text.starts-with? "/" raw)
-        (text.clip' +1 raw)
-        (#.Some raw)))
-
-    _
-    #.None))
diff --git a/stdlib/source/lux/language/compiler/meta/io/context.lux b/stdlib/source/lux/language/compiler/meta/io/context.lux
deleted file mode 100644
index 8288718aa..000000000
--- a/stdlib/source/lux/language/compiler/meta/io/context.lux
+++ /dev/null
@@ -1,94 +0,0 @@
-(.module:
-  [lux (#- Module Code)
-   [control
-    monad
-    ["ex" exception (#+ Exception exception:)]]
-   [data
-    ["." error]
-    [text
-     format
-     ["." encoding]]]
-   [world
-    ["." file (#+ File System)]
-    [binary (#+ Binary)]]]
-  ["." // (#+ Context Module)
-   [////
-    ["." host]]])
-
-(type: #export Extension Text)
-
-(def: #export (file System context module)
-  (All [m] (-> (System m) Context Module File))
-  (|> module
-      (//.sanitize System)
-      (format context (:: System separator))))
-
-(def: host-extension
-  Extension
-  (`` (for {(~~ (static host.common-lisp)) ".cl"
-            (~~ (static host.js))          ".js"
-            (~~ (static host.jvm))         ".jvm"
-            (~~ (static host.lua))         ".lua"
-            (~~ (static host.php))         ".php"
-            (~~ (static host.python))      ".py"
-            (~~ (static host.r))           ".r"
-            (~~ (static host.ruby))        ".rb"
-            (~~ (static host.scheme))      ".scm"})))
-
-(def: lux-extension Extension ".lux")
-
-(do-template []
-  [(exception: #export ( {module Module})
-     (ex.report ["Module" module]))]
-
-  [module-not-found]
-  [cannot-read-module]
-  )
-
-(def: (find-source System contexts module extension)
-  (All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File]))))
-  (case contexts
-    #.Nil
-    (:: (:: System &monad) wrap #.None)
-
-    (#.Cons context contexts')
-    (do (:: System &monad)
-      [#let [file (format (..file System context module) extension)]
-       ? (file.exists? System file)]
-      (if ?
-        (wrap (#.Some [module file]))
-        (find-source System contexts' module)))))
-
-(def: (try System computations exception message)
-  (All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a)))
-  (case computations
-    #.Nil
-    (:: System throw exception message)
-
-    (#.Cons computation computations')
-    (do (:: System &monad)
-      [outcome computation]
-      (case outcome
-        (#.Some output)
-        (wrap output)
-
-        #.None
-        (try System computations' exception message)))))
-
-(type: #export Code Text)
-
-(def: #export (read System contexts name)
-  (All [m] (-> (System m) (List Context) Module (m [Text Code])))
-  (let [find-source' (find-source System contexts name)]
-    (do (:: System &monad)
-      [[path file] (try System
-                        (list (find-source' (format host-extension lux-extension))
-                              (find-source' lux-extension))
-                        module-not-found [name])
-       binary (:: System read file)]
-      (case (encoding.from-utf8 binary)
-        (#error.Success code)
-        (wrap [path code])
-        
-        (#error.Error _)
-        (:: System throw cannot-read-module [name])))))
diff --git a/stdlib/source/lux/language/compiler/synthesis.lux b/stdlib/source/lux/language/compiler/synthesis.lux
deleted file mode 100644
index 8dd99986b..000000000
--- a/stdlib/source/lux/language/compiler/synthesis.lux
+++ /dev/null
@@ -1,264 +0,0 @@
-(.module:
-  [lux (#- i64 Scope)
-   [control [monad (#+ do)]]
-   [data
-    [error (#+ Error)]
-    [collection
-     ["dict" dictionary (#+ Dictionary)]]]]
-  ["." //
-   ["." analysis (#+ Environment Arity Analysis)]
-   ["." extension (#+ Extension)]
-   [//
-    ["." reference (#+ Register Variable Reference)]]])
-
-(type: #export Resolver (Dictionary Variable Variable))
-
-(type: #export State
-  {#scope-arity Arity
-   #resolver Resolver
-   #direct? Bit
-   #locals Nat})
-
-(def: #export fresh-resolver
-  Resolver
-  (dict.new reference.Hash))
-
-(def: #export init
-  State
-  {#scope-arity +0
-   #resolver fresh-resolver
-   #direct? #0
-   #locals +0})
-
-(type: #export Primitive
-  (#Bit Bit)
-  (#I64 I64)
-  (#F64 Frac)
-  (#Text Text))
-
-(type: #export (Structure a)
-  (#Variant (analysis.Variant a))
-  (#Tuple (analysis.Tuple a)))
-
-(type: #export Side
-  (Either Nat Nat))
-
-(type: #export Member
-  (Either Nat Nat))
-
-(type: #export Access
-  (#Side Side)
-  (#Member Member))
-
-(type: #export (Path' s)
-  #Pop
-  (#Test Primitive)
-  (#Access Access)
-  (#Bind Register)
-  (#Alt (Path' s) (Path' s))
-  (#Seq (Path' s) (Path' s))
-  (#Then s))
-
-(type: #export (Abstraction' s)
-  {#environment Environment
-   #arity Arity
-   #body s})
-
-(type: #export (Apply' s)
-  {#function s
-   #arguments (List s)})
-
-(type: #export (Branch s)
-  (#Let s Register s)
-  (#If s s s)
-  (#Case s (Path' s)))
-
-(type: #export (Scope s)
-  {#start Register
-   #inits (List s)
-   #iteration s})
-
-(type: #export (Loop s)
-  (#Scope (Scope s))
-  (#Recur (List s)))
-
-(type: #export (Function s)
-  (#Abstraction (Abstraction' s))
-  (#Apply s (List s)))
-
-(type: #export (Control s)
-  (#Branch (Branch s))
-  (#Loop (Loop s))
-  (#Function (Function s)))
-
-(type: #export #rec Synthesis
-  (#Primitive Primitive)
-  (#Structure (Structure Synthesis))
-  (#Reference Reference)
-  (#Control (Control Synthesis))
-  (#Extension (Extension Synthesis)))
-
-(type: #export Operation
-  (extension.Operation ..State Analysis Synthesis))
-
-(type: #export Compiler
-  (extension.Compiler ..State Analysis Synthesis))
-
-(type: #export Path
-  (Path' Synthesis))
-
-(def: #export path/pop
-  Path
-  #Pop)
-
-(do-template [ ]
-  [(template: #export ( content)
-     (#..Test ( content)))]
-
-  [path/bit  #..Bit]
-  [path/i64  #..I64]
-  [path/f64  #..F64]
-  [path/text #..Text]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     (.<| #..Access
-          
-          content))]
-
-  [path/side   #..Side]
-  [path/member #..Member]
-  )
-
-(do-template [  ]
-  [(template: #export ( content)
-     (.<| #..Access
-          
-          
-          content))]
-
-  [side/left    #..Side   #.Left]
-  [side/right   #..Side   #.Right]
-  [member/left  #..Member #.Left]
-  [member/right #..Member #.Right]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     ( content))]
-
-  [path/alt  #..Alt]
-  [path/seq  #..Seq]
-  [path/then #..Then]
-  )
-
-(type: #export Abstraction
-  (Abstraction' Synthesis))
-
-(type: #export Apply
-  (Apply' Synthesis))
-
-(def: #export unit Text "")
-
-(do-template [ ]
-  [(def: #export 
-     (All [a] (-> (Operation a) (Operation a)))
-     (extension.temporary (set@ #direct? )))]
-
-  [indirectly #0]
-  [directly   #1]
-  )
-
-(do-template [  ]
-  [(def: #export ( value)
-     (->  (All [a] (-> (Operation a) (Operation a))))
-     (extension.temporary (set@  value)))]
-
-  [with-scope-arity Arity    #scope-arity]
-  [with-resolver    Resolver #resolver]
-  [with-locals      Nat      #locals]
-  )
-
-(def: #export (with-abstraction arity resolver)
-  (-> Arity Resolver
-      (All [a] (-> (Operation a) (Operation a))))
-  (extension.with-state {#scope-arity arity
-                         #resolver resolver
-                         #direct? #1
-                         #locals arity}))
-
-(do-template [  ]
-  [(def: #export 
-     (Operation )
-     (extension.read (get@ )))]
-
-  [scope-arity #scope-arity Arity]
-  [resolver    #resolver    Resolver]
-  [direct?     #direct?     Bit]
-  [locals      #locals      Nat]
-  )
-
-(def: #export with-new-local
-  (All [a] (-> (Operation a) (Operation a)))
-  (<<| (do //.Monad
-         [locals ..locals])
-       (..with-locals (inc locals))))
-
-(do-template [ ]
-  [(template: #export ( content)
-     (#..Primitive ( content)))]
-
-  [bit  #..Bit]
-  [i64  #..I64]
-  [f64  #..F64]
-  [text #..Text]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     (<| #..Structure
-         
-         content))]
-
-  [variant #..Variant]
-  [tuple   #..Tuple]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     (.<| #..Reference
-          
-          content))]
-
-  [variable/local   reference.local]
-  [variable/foreign reference.foreign]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     (.<| #..Reference
-          
-          content))]
-
-  [variable reference.variable]
-  [constant reference.constant]
-  )
-
-(do-template [  ]
-  [(template: #export ( content)
-     (.<| #..Control
-          
-          
-          content))]
-
-  [branch/case          #..Branch   #..Case]
-  [branch/let           #..Branch   #..Let]
-  [branch/if            #..Branch   #..If]
-
-  [loop/recur           #..Loop     #..Recur]
-  [loop/scope           #..Loop     #..Scope]
-
-  [function/abstraction #..Function #..Abstraction]
-  [function/apply       #..Function #..Apply]
-  )
diff --git a/stdlib/source/lux/language/compiler/synthesis/case.lux b/stdlib/source/lux/language/compiler/synthesis/case.lux
deleted file mode 100644
index 2ef9b735e..000000000
--- a/stdlib/source/lux/language/compiler/synthesis/case.lux
+++ /dev/null
@@ -1,181 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [equivalence (#+ Equivalence)]
-    pipe
-    ["." monad (#+ do)]]
-   [data
-    ["." product]
-    [bit ("bit/." Equivalence)]
-    [text ("text/." Equivalence)
-     format]
-    [number ("frac/." Equivalence)]
-    [collection
-     ["." list ("list/." Fold Monoid)]]]]
-  ["." // (#+ Path Synthesis Operation Compiler)
-   ["." function]
-   ["/." // ("operation/." Monad)
-    ["." analysis (#+ Pattern Match Analysis)]
-    [//
-     ["." reference]]]])
-
-(def: (path' pattern bodyC)
-  (-> Pattern (Operation Path) (Operation Path))
-  (case pattern
-    (#analysis.Simple simple)
-    (case simple
-      #analysis.Unit
-      bodyC
-      
-      (^template [ ]
-        ( value)
-        (operation/map (|>> (#//.Seq (#//.Test (|> value ))))
-                       bodyC))
-      ([#analysis.Bit  #//.Bit]
-       [#analysis.Nat  (<| #//.I64 .i64)]
-       [#analysis.Int  (<| #//.I64 .i64)]
-       [#analysis.Rev  (<| #//.I64 .i64)]
-       [#analysis.Frac #//.F64]
-       [#analysis.Text #//.Text]))
-    
-    (#analysis.Bind register)
-    (<| (do ///.Monad
-          [arity //.scope-arity])
-        (:: @ map (|>> (#//.Seq (#//.Bind (if (function.nested? arity)
-                                            (n/+ (dec arity) register)
-                                            register)))))
-        //.with-new-local
-        bodyC)
-
-    (#analysis.Complex _)
-    (case (analysis.variant-pattern pattern)
-      (#.Some [lefts right? value-pattern])
-      (operation/map (|>> (#//.Seq (#//.Access (#//.Side (if right?
-                                                           (#.Right lefts)
-                                                           (#.Left lefts))))))
-                     (path' value-pattern bodyC))
-      
-      #.None
-      (let [tuple (analysis.tuple-pattern pattern)
-            tuple/last (dec (list.size tuple))]
-        (list/fold (function (_ [tuple/idx tuple/member] thenC)
-                     (case tuple/member
-                       (#analysis.Simple #analysis.Unit)
-                       thenC
-
-                       _
-                       (let [last? (n/= tuple/last tuple/idx)]
-                         (|> (if (or last?
-                                     (is? bodyC thenC))
-                               thenC
-                               (operation/map (|>> (#//.Seq #//.Pop)) thenC))
-                             (path' tuple/member)
-                             (operation/map (|>> (#//.Seq (#//.Access (#//.Member (if last?
-                                                                                    (#.Right (dec tuple/idx))
-                                                                                    (#.Left tuple/idx)))))))))))
-                   bodyC
-                   (list.reverse (list.enumerate tuple)))))))
-
-(def: #export (path synthesize pattern bodyA)
-  (-> Compiler Pattern Analysis (Operation Path))
-  (path' pattern (operation/map (|>> #//.Then) (synthesize bodyA))))
-
-(def: #export (weave leftP rightP)
-  (-> Path Path Path)
-  (with-expansions [ (as-is (#//.Alt leftP rightP))]
-    (case [leftP rightP]
-      [(#//.Seq preL postL)
-       (#//.Seq preR postR)]
-      (case (weave preL preR)
-        (#//.Alt _)
-        
-
-        weavedP
-        (#//.Seq weavedP (weave postL postR)))
-
-      [#//.Pop #//.Pop]
-      rightP
-
-      (^template [ ]
-        [(#//.Test ( leftV))
-         (#//.Test ( rightV))]
-        (if ( leftV rightV)
-          rightP
-          ))
-      ([#//.Bit bit/=]
-       [#//.I64 (:coerce (Equivalence I64) i/=)]
-       [#//.F64 frac/=]
-       [#//.Text text/=])
-
-      (^template [ ]
-        [(#//.Access ( ( leftL)))
-         (#//.Access ( ( rightL)))]
-        (if (n/= leftL rightL)
-          rightP
-          ))
-      ([#//.Side #.Left]
-       [#//.Side #.Right]
-       [#//.Member #.Left]
-       [#//.Member #.Right])
-
-      [(#//.Bind leftR) (#//.Bind rightR)]
-      (if (n/= leftR rightR)
-        rightP
-        )
-
-      _
-      )))
-
-(def: #export (synthesize synthesize^ inputA [headB tailB+])
-  (-> Compiler Analysis Match (Operation Synthesis))
-  (do ///.Monad
-    [inputS (synthesize^ inputA)]
-    (with-expansions [
-                      (as-is (^multi (^ (#analysis.Reference (reference.local outputR)))
-                                     (n/= inputR outputR))
-                             (wrap inputS))
-
-                      
-                      (as-is [[(#analysis.Bind inputR) headB/bodyA]
-                              #.Nil]
-                             (case headB/bodyA
-                               
-
-                               _
-                               (do @
-                                 [arity //.scope-arity
-                                  headB/bodyS (//.with-new-local
-                                                (synthesize^ headB/bodyA))]
-                                 (wrap (//.branch/let [inputS
-                                                       (if (function.nested? arity)
-                                                         (n/+ (dec arity) inputR)
-                                                         inputR)
-                                                       headB/bodyS])))))
-
-                      
-                      (as-is (^or (^ [[(analysis.pattern/bit #1) thenA]
-                                      (list [(analysis.pattern/bit #0) elseA])])
-                                  (^ [[(analysis.pattern/bit #0) elseA]
-                                      (list [(analysis.pattern/bit #1) thenA])]))
-                             (do @
-                               [thenS (synthesize^ thenA)
-                                elseS (synthesize^ elseA)]
-                               (wrap (//.branch/if [inputS thenS elseS]))))
-
-                      
-                      (as-is _
-                             (let [[[lastP lastA] prevsPA] (|> (#.Cons headB tailB+)
-                                                               list.reverse
-                                                               (case> (#.Cons [lastP lastA] prevsPA)
-                                                                      [[lastP lastA] prevsPA]
-
-                                                                      _
-                                                                      (undefined)))]
-                               (do @
-                                 [lastSP (path synthesize^ lastP lastA)
-                                  prevsSP+ (monad.map @ (product.uncurry (path synthesize^)) prevsPA)]
-                                 (wrap (//.branch/case [inputS (list/fold weave lastSP prevsSP+)])))))]
-      (case [headB tailB+]
-        
-        
-        ))))
diff --git a/stdlib/source/lux/language/compiler/synthesis/expression.lux b/stdlib/source/lux/language/compiler/synthesis/expression.lux
deleted file mode 100644
index 64f802089..000000000
--- a/stdlib/source/lux/language/compiler/synthesis/expression.lux
+++ /dev/null
@@ -1,94 +0,0 @@
-(.module:
-  [lux (#- primitive)
-   [control
-    ["." monad (#+ do)]]
-   [data
-    ["." maybe]
-    [collection
-     ["." list ("list/." Functor)]
-     ["dict" dictionary (#+ Dictionary)]]]]
-  ["." // (#+ Synthesis Compiler)
-   ["." function]
-   ["." case]
-   ["/." // ("operation/." Monad)
-    ["." analysis (#+ Analysis)]
-    ["." extension]
-    [//
-     ["." reference]]]])
-
-(def: (primitive analysis)
-  (-> analysis.Primitive //.Primitive)
-  (case analysis
-    #analysis.Unit
-    (#//.Text //.unit)
-    
-    (^template [ ]
-      ( value)
-      ( value))
-    ([#analysis.Bit  #//.Bit]
-     [#analysis.Frac #//.F64]
-     [#analysis.Text #//.Text])
-
-    (^template [ ]
-      ( value)
-      ( (.i64 value)))
-    ([#analysis.Nat #//.I64]
-     [#analysis.Int #//.I64]
-     [#analysis.Rev #//.I64])))
-
-(def: #export (synthesize analysis)
-  Compiler
-  (case analysis
-    (#analysis.Primitive analysis')
-    (operation/wrap (#//.Primitive (..primitive analysis')))
-
-    (#analysis.Structure composite)
-    (case (analysis.variant analysis)
-      (#.Some variant)
-      (do ///.Monad
-        [valueS (synthesize (get@ #analysis.value variant))]
-        (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant)))))
-
-      _
-      (do ///.Monad
-        [tupleS (monad.map @ synthesize (analysis.tuple analysis))]
-        (wrap (#//.Structure (#//.Tuple tupleS)))))
-
-    (#analysis.Reference reference)
-    (case reference
-      (#reference.Constant constant)
-      (operation/wrap (#//.Reference reference))
-
-      (#reference.Variable var)
-      (do ///.Monad
-        [resolver //.resolver]
-        (case var
-          (#reference.Local register)
-          (do @
-            [arity //.scope-arity]
-            (wrap (if (function.nested? arity)
-                    (if (n/= +0 register)
-                      (|> (dec arity)
-                          (list.n/range +1)
-                          (list/map (|>> //.variable/local))
-                          [(//.variable/local +0)]
-                          //.function/apply)
-                      (#//.Reference (#reference.Variable (function.adjust arity #0 var))))
-                    (#//.Reference (#reference.Variable var)))))
-          
-          (#reference.Foreign register)
-          (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference)))))
-
-    (#analysis.Case inputA branchesAB+)
-    (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+)
-
-    (#analysis.Apply _)
-    (function.apply (|>> synthesize //.indirectly) analysis)
-
-    (#analysis.Function environmentA bodyA)
-    (function.function synthesize environmentA bodyA)
-
-    (#analysis.Extension name args)
-    (extension.apply (|>> synthesize //.indirectly)
-                     [name args])
-    ))
diff --git a/stdlib/source/lux/language/compiler/synthesis/function.lux b/stdlib/source/lux/language/compiler/synthesis/function.lux
deleted file mode 100644
index 4e72c022f..000000000
--- a/stdlib/source/lux/language/compiler/synthesis/function.lux
+++ /dev/null
@@ -1,134 +0,0 @@
-(.module:
-  [lux (#- function)
-   [control
-    ["." monad (#+ do)]
-    ["." state]
-    pipe
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." maybe ("maybe/." Monad)]
-    ["." error]
-    [collection
-     ["." list ("list/." Functor Monoid Fold)]
-     ["dict" dictionary (#+ Dictionary)]]]]
-  ["." // (#+ Synthesis Operation Compiler)
-   ["." loop (#+ Transform)]
-   [///
-    ["." reference (#+ Variable)]
-    ["." compiler
-     ["." analysis (#+ Environment Arity Analysis)]]]])
-
-(def: #export nested?
-  (-> Arity Bit)
-  (n/> +1))
-
-(def: #export (adjust up-arity after? var)
-  (-> Arity Bit Variable Variable)
-  (case var
-    (#reference.Local register)
-    (if (and after? (n/>= up-arity register))
-      (#reference.Local (n/+ (dec up-arity) register))
-      var)
-
-    _
-    var))
-
-(def: (unfold apply)
-  (-> Analysis [Analysis (List Analysis)])
-  (loop [apply apply
-         args (list)]
-    (case apply
-      (#analysis.Apply arg func)
-      (recur func (#.Cons arg args))
-
-      _
-      [apply args])))
-
-(def: #export (apply synthesize)
-  (-> Compiler Compiler)
-  (.function (_ exprA)
-    (let [[funcA argsA] (unfold exprA)]
-      (do (state.Monad error.Monad)
-        [funcS (synthesize funcA)
-         argsS (monad.map @ synthesize argsA)
-         locals //.locals]
-        (case funcS
-          (^ (//.function/abstraction functionS))
-          (wrap (|> functionS
-                    (loop.loop (get@ #//.environment functionS) locals argsS)
-                    (maybe.default (//.function/apply [funcS argsS]))))
-
-          (^ (//.function/apply [funcS' argsS']))
-          (wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
-
-          _
-          (wrap (//.function/apply [funcS argsS])))))))
-
-(def: (prepare up down)
-  (-> Arity Arity (Transform Synthesis))
-  (.function (_ body)
-    (if (nested? up)
-      (#.Some body)
-      (loop.recursion down body))))
-
-(exception: #export (cannot-prepare-function-body {_ []})
-  "")
-
-(def: return
-  (All [a] (-> (Maybe a) (Operation a)))
-  (|>> (case> (#.Some output)
-              (:: compiler.Monad wrap output)
-
-              #.None
-              (compiler.throw cannot-prepare-function-body []))))
-
-(def: #export (function synthesize environment body)
-  (-> Compiler Environment Analysis (Operation Synthesis))
-  (do compiler.Monad
-    [direct? //.direct?
-     arity //.scope-arity
-     resolver //.resolver
-     #let [function-arity (if direct?
-                            (inc arity)
-                            +1)
-           up-environment (if (nested? arity)
-                            (list/map (.function (_ closure)
-                                        (case (dict.get closure resolver)
-                                          (#.Some resolved)
-                                          (adjust arity #1 resolved)
-
-                                          #.None
-                                          (adjust arity #0 closure)))
-                                      environment)
-                            environment)
-           down-environment (: (List Variable)
-                               (case environment
-                                 #.Nil
-                                 (list)
-                                 
-                                 _
-                                 (|> (list.size environment) dec (list.n/range +0)
-                                     (list/map (|>> #reference.Foreign)))))
-           resolver' (if (and (nested? function-arity)
-                              direct?)
-                       (list/fold (.function (_ [from to] resolver')
-                                    (dict.put from to resolver'))
-                                  //.fresh-resolver
-                                  (list.zip2 down-environment up-environment))
-                       (list/fold (.function (_ var resolver')
-                                    (dict.put var var resolver'))
-                                  //.fresh-resolver
-                                  down-environment))]
-     bodyS (//.with-abstraction function-arity resolver'
-             (synthesize body))]
-    (case bodyS
-      (^ (//.function/abstraction [env' down-arity' bodyS']))
-      (let [arity' (inc down-arity')]
-        (|> (prepare function-arity arity' bodyS')
-            (maybe/map (|>> [up-environment arity'] //.function/abstraction))
-            ..return))
-
-      _
-      (|> (prepare function-arity +1 bodyS)
-          (maybe/map (|>> [up-environment +1] //.function/abstraction))
-          ..return))))
diff --git a/stdlib/source/lux/language/compiler/synthesis/loop.lux b/stdlib/source/lux/language/compiler/synthesis/loop.lux
deleted file mode 100644
index 661d29a83..000000000
--- a/stdlib/source/lux/language/compiler/synthesis/loop.lux
+++ /dev/null
@@ -1,291 +0,0 @@
-(.module:
-  [lux (#- loop)
-   [control
-    ["." monad (#+ do)]
-    ["p" parser]]
-   [data
-    ["." maybe ("maybe/." Monad)]
-    [collection
-     ["." list ("list/." Functor)]]]
-   [macro
-    ["." code]
-    ["." syntax]]]
-  ["." // (#+ Path Abstraction Synthesis)
-   [///
-    ["." reference (#+ Register Variable)]
-    [compiler
-     ["." analysis (#+ Environment)]
-     ["." extension]]]])
-
-(type: #export (Transform a)
-  (-> a (Maybe a)))
-
-(def: (some? maybe)
-  (All [a] (-> (Maybe a) Bit))
-  (case maybe
-    (#.Some _) #1
-    #.None     #0))
-
-(template: #export (self)
-  (#//.Reference (reference.local +0)))
-
-(template: (recursive-apply args)
-  (#//.Apply (self) args))
-
-(def: improper #0)
-(def: proper #1)
-
-(def: (proper? exprS)
-  (-> Synthesis Bit)
-  (case exprS
-    (^ (self))
-    improper
-
-    (#//.Structure structure)
-    (case structure
-      (#//.Variant variantS)
-      (proper? (get@ #analysis.value variantS))
-      
-      (#//.Tuple membersS+)
-      (list.every? proper? membersS+))
-
-    (#//.Control controlS)
-    (case controlS
-      (#//.Branch branchS)
-      (case branchS
-        (#//.Case inputS pathS)
-        (and (proper? inputS)
-             (.loop [pathS pathS]
-               (case pathS
-                 (^or (#//.Alt leftS rightS) (#//.Seq leftS rightS))
-                 (and (recur leftS) (recur rightS))
-
-                 (#//.Then bodyS)
-                 (proper? bodyS)
-                 
-                 _
-                 proper)))
-
-        (#//.Let inputS register bodyS)
-        (and (proper? inputS)
-             (proper? bodyS))
-
-        (#//.If inputS thenS elseS)
-        (and (proper? inputS)
-             (proper? thenS)
-             (proper? elseS)))
-
-      (#//.Loop loopS)
-      (case loopS
-        (#//.Scope scopeS)
-        (and (list.every? proper? (get@ #//.inits scopeS))
-             (proper? (get@ #//.iteration scopeS)))
-
-        (#//.Recur argsS)
-        (list.every? proper? argsS))
-
-      (#//.Function functionS)
-      (case functionS
-        (#//.Abstraction environment arity bodyS)
-        (list.every? reference.self? environment)
-
-        (#//.Apply funcS argsS)
-        (and (proper? funcS)
-             (list.every? proper? argsS))))
-
-    (#//.Extension [name argsS])
-    (list.every? proper? argsS)
-
-    _
-    proper))
-
-(def: (path-recursion synthesis-recursion)
-  (-> (Transform Synthesis) (Transform Path))
-  (function (recur pathS)
-    (case pathS
-      (#//.Alt leftS rightS)
-      (let [leftS' (recur leftS)
-            rightS' (recur rightS)]
-        (if (or (some? leftS')
-                (some? rightS'))
-          (#.Some (#//.Alt (maybe.default leftS leftS')
-                           (maybe.default rightS rightS')))
-          #.None))
-      
-      (#//.Seq leftS rightS)
-      (maybe/map (|>> (#//.Seq leftS)) (recur rightS))
-
-      (#//.Then bodyS)
-      (maybe/map (|>> #//.Then) (synthesis-recursion bodyS))
-      
-      _
-      #.None)))
-
-(def: #export (recursion arity)
-  (-> Nat (Transform Synthesis))
-  (function (recur exprS)
-    (case exprS
-      (#//.Control controlS)
-      (case controlS
-        (#//.Branch branchS)
-        (case branchS
-          (#//.Case inputS pathS)
-          (|> pathS
-              (path-recursion recur)
-              (maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control)))
-
-          (#//.Let inputS register bodyS)
-          (maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control)
-                     (recur bodyS))
-
-          (#//.If inputS thenS elseS)
-          (let [thenS' (recur thenS)
-                elseS' (recur elseS)]
-            (if (or (some? thenS')
-                    (some? elseS'))
-              (#.Some (|> (#//.If inputS
-                                  (maybe.default thenS thenS')
-                                  (maybe.default elseS elseS'))
-                          #//.Branch #//.Control))
-              #.None)))
-
-        (^ (#//.Function (recursive-apply argsS)))
-        (if (n/= arity (list.size argsS))
-          (#.Some (|> argsS #//.Recur #//.Loop #//.Control))
-          #.None)
-
-        _
-        #.None)
-
-      _
-      #.None)))
-
-(def: (resolve environment)
-  (-> Environment (Transform Variable))
-  (function (_ variable)
-    (case variable
-      (#reference.Foreign register)
-      (list.nth register environment)
-
-      _
-      (#.Some variable))))
-
-(def: (adjust-path adjust-synthesis offset)
-  (-> (Transform Synthesis) Register (Transform Path))
-  (function (recur pathS)
-    (case pathS
-      (#//.Bind register)
-      (#.Some (#//.Bind (n/+ offset register)))
-
-      (^template []
-        ( leftS rightS)
-        (do maybe.Monad
-          [leftS' (recur leftS)
-           rightS' (recur rightS)]
-          (wrap ( leftS' rightS'))))
-      ([#//.Alt] [#//.Seq])
-      
-      (#//.Then bodyS)
-      (|> bodyS adjust-synthesis (maybe/map (|>> #//.Then)))
-
-      _
-      (#.Some pathS))))
-
-(def: (adjust scope-environment offset)
-  (-> Environment Register (Transform Synthesis))
-  (function (recur exprS)
-    (case exprS
-      (#//.Structure structureS)
-      (case structureS
-        (#//.Variant variantS)
-        (do maybe.Monad
-          [valueS' (|> variantS (get@ #analysis.value) recur)]
-          (wrap (|> variantS
-                    (set@ #analysis.value valueS')
-                    #//.Variant
-                    #//.Structure)))
-        
-        (#//.Tuple membersS+)
-        (|> membersS+
-            (monad.map maybe.Monad recur)
-            (maybe/map (|>> #//.Tuple #//.Structure))))
-
-      (#//.Reference reference)
-      (case reference
-        (^ (reference.constant constant))
-        (#.Some exprS)
-
-        (^ (reference.local register))
-        (#.Some (#//.Reference (reference.local (n/+ offset register))))
-
-        (^ (reference.foreign register))
-        (|> scope-environment
-            (list.nth register)
-            (maybe/map (|>> #reference.Variable #//.Reference))))
-
-      (^ (//.branch/case [inputS pathS]))
-      (do maybe.Monad
-        [inputS' (recur inputS)
-         pathS' (adjust-path recur offset pathS)]
-        (wrap (|> pathS' [inputS'] //.branch/case)))
-
-      (^ (//.branch/let [inputS register bodyS]))
-      (do maybe.Monad
-        [inputS' (recur inputS)
-         bodyS' (recur bodyS)]
-        (wrap (//.branch/let [inputS' register bodyS'])))
-
-      (^ (//.branch/if [inputS thenS elseS]))
-      (do maybe.Monad
-        [inputS' (recur inputS)
-         thenS' (recur thenS)
-         elseS' (recur elseS)]
-        (wrap (//.branch/if [inputS' thenS' elseS'])))
-
-      (^ (//.loop/scope scopeS))
-      (do maybe.Monad
-        [inits' (|> scopeS
-                    (get@ #//.inits)
-                    (monad.map maybe.Monad recur))
-         iteration' (recur (get@ #//.iteration scopeS))]
-        (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset))
-                              #//.inits inits'
-                              #//.iteration iteration'})))
-
-      (^ (//.loop/recur argsS))
-      (|> argsS
-          (monad.map maybe.Monad recur)
-          (maybe/map (|>> //.loop/recur)))
-      
-
-      (^ (//.function/abstraction [environment arity bodyS]))
-      (do maybe.Monad
-        [environment' (monad.map maybe.Monad
-                                 (resolve scope-environment)
-                                 environment)]
-        (wrap (//.function/abstraction [environment' arity bodyS])))
-      
-      (^ (//.function/apply [function arguments]))
-      (do maybe.Monad
-        [function' (recur function)
-         arguments' (monad.map maybe.Monad recur arguments)]
-        (wrap (//.function/apply [function' arguments'])))
-
-      (#//.Extension [name argsS])
-      (|> argsS
-          (monad.map maybe.Monad recur)
-          (maybe/map (|>> [name] #//.Extension)))
-
-      _
-      (#.Some exprS))))
-
-(def: #export (loop environment num-locals inits functionS)
-  (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis))
-  (let [bodyS (get@ #//.body functionS)]
-    (if (and (n/= (list.size inits)
-                  (get@ #//.arity functionS))
-             (proper? bodyS))
-      (|> bodyS
-          (adjust environment num-locals)
-          (maybe/map (|>> [(inc num-locals) inits] //.loop/scope)))
-      #.None)))
diff --git a/stdlib/source/lux/language/compiler/translation.lux b/stdlib/source/lux/language/compiler/translation.lux
deleted file mode 100644
index 32c8fb601..000000000
--- a/stdlib/source/lux/language/compiler/translation.lux
+++ /dev/null
@@ -1,196 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["ex" exception (#+ exception:)]
-    [monad (#+ do)]]
-   [data
-    ["." product]
-    ["." error (#+ Error)]
-    [ident ("ident/." Equivalence Codec)]
-    ["." text
-     format]
-    [collection
-     ["." row (#+ Row)]
-     ["dict" dictionary (#+ Dictionary)]]]
-   [world
-    [file (#+ File)]]]
-  ["." //
-   ["." extension]]
-  [//synthesis (#+ Synthesis)])
-
-(do-template []
-  [(exception: #export ()
-     "")]
-
-  [no-active-buffer]
-  [no-anchor]
-  )
-
-(exception: #export (cannot-interpret {message Text})
-  message)
-
-(do-template []
-  [(exception: #export ( {name Ident})
-     (ex.report ["Artifact" (ident/encode name)]))]
-
-  [cannot-overwrite-artifact]
-  [no-buffer-for-saving-code]
-  )
-
-(type: #export Context
-  {#scope-name Text
-   #inner-functions Nat})
-
-(signature: #export (Host expression statement)
-  (: (-> expression (Error Any))
-     evaluate!)
-  (: (-> statement (Error Any))
-     execute!))
-
-(type: #export (Buffer statement) (Row [Ident statement]))
-
-(type: #export (Artifacts statement) (Dictionary File (Buffer statement)))
-
-(type: #export (State anchor expression statement)
-  {#context Context
-   #anchor (Maybe anchor)
-   #host (Host expression statement)
-   #buffer (Maybe (Buffer statement))
-   #artifacts (Artifacts statement)
-   #counter Nat})
-
-(type: #export (Operation anchor expression statement)
-  (extension.Operation (State anchor expression statement) Synthesis expression))
-
-(type: #export (Compiler anchor expression statement)
-  (extension.Compiler (State anchor expression statement) Synthesis expression))
-
-(type: #export (Handler anchor expression statement)
-  (extension.Handler (State anchor expression statement) Synthesis expression))
-
-(type: #export (Bundle anchor expression statement)
-  (extension.Bundle (State anchor expression statement) Synthesis expression))
-
-(def: #export (init host)
-  (All [anchor expression statement]
-    (-> (Host expression statement)
-        (..State anchor expression statement)))
-  {#context {#scope-name ""
-             #inner-functions +0}
-   #anchor #.None
-   #host host
-   #buffer #.None
-   #artifacts (dict.new text.Hash)
-   #counter +0})
-
-(def: #export (with-context expr)
-  (All [anchor expression statement output]
-    (-> (Operation anchor expression statement output)
-        (Operation anchor expression statement [Text output])))
-  (function (_ [bundle state])
-    (let [[old-scope old-inner] (get@ #context state)
-          new-scope (format old-scope "c___" (%i (.int old-inner)))]
-      (case (expr [bundle (set@ #context [new-scope +0] state)])
-        (#error.Success [[bundle' state'] output])
-        (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')]
-                         [new-scope output]])
-
-        (#error.Error error)
-        (#error.Error error)))))
-
-(def: #export context
-  (All [anchor expression statement]
-    (Operation anchor expression statement Text))
-  (extension.read (|>> (get@ #context)
-                       (get@ #scope-name))))
-
-(do-template [
-                
-                ]
-  [(def: #export 
-     (All [anchor expression statement output] )
-     (function (_ body)
-       (function (_ [bundle state])
-         (case (body [bundle (set@  (#.Some ) state)])
-           (#error.Success [[bundle' state'] output])
-           (#error.Success [[bundle' (set@  (get@  state) state')]
-                            output])
-
-           (#error.Error error)
-           (#error.Error error)))))
-
-   (def: #export 
-     (All [anchor expression statement]
-       (Operation anchor expression statement ))
-     (function (_ (^@ stateE [bundle state]))
-       (case (get@  state)
-         (#.Some output)
-         (#error.Success [stateE output])
-
-         #.None
-         (ex.throw  []))))]
-
-  [#anchor
-   (with-anchor anchor)
-   (-> anchor (Operation anchor expression statement output)
-       (Operation anchor expression statement output))
-   anchor
-   anchor anchor no-anchor]
-
-  [#buffer
-   with-buffer
-   (-> (Operation anchor expression statement output)
-       (Operation anchor expression statement output))
-   row.empty
-   buffer (Buffer statement) no-active-buffer]
-  )
-
-(def: #export artifacts
-  (All [anchor expression statement]
-    (Operation anchor expression statement (Artifacts statement)))
-  (extension.read (get@ #artifacts)))
-
-(def: #export next
-  (All [anchor expression statement]
-    (Operation anchor expression statement Nat))
-  (do //.Monad
-    [_ (extension.update (update@ #counter inc))]
-    (extension.read (get@ #counter))))
-
-(do-template [ ]
-  [(def: #export ( code)
-     (All [anchor expression statement]
-       (->  (Operation anchor expression statement Any)))
-     (function (_ (^@ stateE [bundle state]))
-       (case (:: (get@ #host state)  code)
-         (#error.Error error)
-         (ex.throw cannot-interpret error)
-         
-         (#error.Success output)
-         (#error.Success [stateE output]))))]
-
-  [evaluate! expression]
-  [execute!  statement]
-  )
-
-(def: #export (save! name code)
-  (All [anchor expression statement]
-    (-> Ident statement (Operation anchor expression statement Any)))
-  (do //.Monad
-    [_ (execute! code)
-     ?buffer (extension.read (get@ #buffer))]
-    (case ?buffer
-      (#.Some buffer)
-      (if (row.any? (|>> product.left (ident/= name)) buffer)
-        (//.throw cannot-overwrite-artifact name)
-        (extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
-      
-      #.None
-      (//.throw no-buffer-for-saving-code name))))
-
-(def: #export (save-buffer! target)
-  (All [anchor expression statement]
-    (-> File (Operation anchor expression statement Any)))
-  (do //.Monad
-    [buffer ..buffer]
-    (extension.update (update@ #artifacts (dict.put target buffer)))))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux
deleted file mode 100644
index 11c6f3e3d..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux
+++ /dev/null
@@ -1,176 +0,0 @@
-(.module:
-  [lux (#- case let if)
-   [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["." number]
-    ["." text
-     format]
-    [collection
-     [list ("list/." Functor Fold)]
-     [set (#+ Set)]]]]
-  [//
-   ["." runtime (#+ Operation Compiler)]
-   ["." reference]
-   ["/." /// ("operation/." Monad)
-    ["." synthesis (#+ Synthesis Path)]
-    [//
-     [reference (#+ Register)]
-     [host
-      ["_" scheme (#+ Expression Computation Var)]]]]])
-
-(def: #export (let translate [valueS register bodyS])
-  (-> Compiler [Synthesis Register Synthesis]
-      (Operation Computation))
-  (do ////.Monad
-    [valueO (translate valueS)
-     bodyO (translate bodyS)]
-    (wrap (_.let (list [(reference.local' register) valueO])
-            bodyO))))
-
-(def: #export (record-get translate valueS pathP)
-  (-> Compiler Synthesis (List [Nat Bit])
-      (Operation Expression))
-  (do ////.Monad
-    [valueO (translate valueS)]
-    (wrap (list/fold (function (_ [idx tail?] source)
-                       (.let [method (.if tail?
-                                       runtime.product//right
-                                       runtime.product//left)]
-                         (method source (_.int (:coerce Int idx)))))
-                     valueO
-                     pathP))))
-
-(def: #export (if translate [testS thenS elseS])
-  (-> Compiler [Synthesis Synthesis Synthesis]
-      (Operation Computation))
-  (do ////.Monad
-    [testO (translate testS)
-     thenO (translate thenS)
-     elseO (translate elseS)]
-    (wrap (_.if testO thenO elseO))))
-
-(def: @savepoint (_.var "lux_pm_cursor_savepoint"))
-
-(def: @cursor (_.var "lux_pm_cursor"))
-
-(def: top _.length/1)
-
-(def: (push! value var)
-  (-> Expression Var Computation)
-  (_.set! var (_.cons/2 value var)))
-
-(def: (pop! var)
-  (-> Var Computation)
-  (_.set! var var))
-
-(def: (push-cursor! value)
-  (-> Expression Computation)
-  (push! value @cursor))
-
-(def: save-cursor!
-  Computation
-  (push! @cursor @savepoint))
-
-(def: restore-cursor!
-  Computation
-  (_.set! @cursor (_.car/1 @savepoint)))
-
-(def: cursor-top
-  Computation
-  (_.car/1 @cursor))
-
-(def: pop-cursor!
-  Computation
-  (pop! @cursor))
-
-(def: pm-error (_.string "PM-ERROR"))
-
-(def: fail-pm! (_.raise/1 pm-error))
-
-(def: @temp (_.var "lux_pm_temp"))
-
-(exception: #export (unrecognized-path)
-  "")
-
-(def: $alt_error (_.var "alt_error"))
-
-(def: (pm-catch handler)
-  (-> Expression Computation)
-  (_.lambda [(list $alt_error) #.None]
-       (_.if (|> $alt_error (_.eqv?/2 pm-error))
-         handler
-         (_.raise/1 $alt_error))))
-
-(def: (pattern-matching' translate pathP)
-  (-> Compiler Path (Operation Expression))
-  (.case pathP
-    (^ (synthesis.path/then bodyS))
-    (translate bodyS)
-
-    #synthesis.Pop
-    (operation/wrap pop-cursor!)
-
-    (#synthesis.Bind register)
-    (operation/wrap (_.define (reference.local' register) [(list) #.None]
-                              cursor-top))
-
-    (^template [  <=>]
-      (^ ( value))
-      (operation/wrap (_.when (|> value  (<=> cursor-top) _.not/1)
-                              fail-pm!)))
-    ([synthesis.path/bit  _.bool   _.eqv?/2]
-     [synthesis.path/i64  _.int    _.=/2]
-     [synthesis.path/f64  _.float  _.=/2]
-     [synthesis.path/text _.string _.eqv?/2])
-
-    (^template [  ]
-      (^ ( idx))
-      (operation/wrap (_.let (list [@temp (|> idx  .int _.int (runtime.sum//get cursor-top ))])
-                        (_.if (_.null?/1 @temp)
-                          fail-pm!
-                          (push-cursor! @temp)))))
-    ([synthesis.side/left  _.nil         (<|)]
-     [synthesis.side/right (_.string "") inc])
-
-    (^template [  ]
-      (^ ( idx))
-      (operation/wrap (|> idx  .int _.int ( cursor-top) push-cursor!)))
-    ([synthesis.member/left  runtime.product//left  (<|)]
-     [synthesis.member/right runtime.product//right inc])
-
-    (^template [ ]
-      (^ ( [leftP rightP]))
-      (do ////.Monad
-        [leftO (pattern-matching' translate leftP)
-         rightO (pattern-matching' translate rightP)]
-        (wrap )))
-    ([synthesis.path/seq (_.begin (list leftO
-                                        rightO))]
-     [synthesis.path/alt (_.with-exception-handler
-                           (pm-catch (_.begin (list restore-cursor!
-                                                    rightO)))
-                           (_.lambda [(list) #.None]
-                                (_.begin (list save-cursor!
-                                               leftO))))])
-    
-    _
-    (////.throw unrecognized-path [])))
-
-(def: (pattern-matching translate pathP)
-  (-> Compiler Path (Operation Computation))
-  (do ////.Monad
-    [pattern-matching! (pattern-matching' translate pathP)]
-    (wrap (_.with-exception-handler
-            (pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
-            (_.lambda [(list) #.None]
-                 pattern-matching!)))))
-
-(def: #export (case translate [valueS pathP])
-  (-> Compiler [Synthesis Path] (Operation Computation))
-  (do ////.Monad
-    [valueO (translate valueS)]
-    (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))]
-                               [@savepoint (_.list/* (list))])))
-        (pattern-matching translate pathP))))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux
deleted file mode 100644
index 7ff3770ae..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux
+++ /dev/null
@@ -1,59 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]]]
-  [//
-   [runtime (#+ Compiler)]
-   ["." primitive]
-   ["." structure]
-   ["." reference]
-   ["." function]
-   ["." case]
-   ["." loop]
-   ["." ///
-    ["." synthesis]
-    ["." extension]]])
-
-(def: #export (translate synthesis)
-  Compiler
-  (case synthesis
-    (^template [ ]
-      (^ ( value))
-      ( value))
-    ([synthesis.bit  primitive.bit]
-     [synthesis.i64  primitive.i64]
-     [synthesis.f64  primitive.f64]
-     [synthesis.text primitive.text])
-
-    (^ (synthesis.variant variantS))
-    (structure.variant translate variantS)
-
-    (^ (synthesis.tuple members))
-    (structure.tuple translate members)
-
-    (#synthesis.Reference reference)
-    (reference.reference reference)
-
-    (^ (synthesis.branch/case case))
-    (case.case translate case)
-
-    (^ (synthesis.branch/let let))
-    (case.let translate let)
-
-    (^ (synthesis.branch/if if))
-    (case.if translate if)
-
-    (^ (synthesis.loop/scope scope))
-    (loop.scope translate scope)
-
-    (^ (synthesis.loop/recur updates))
-    (loop.recur translate updates)
-
-    (^ (synthesis.function/abstraction abstraction))
-    (function.function translate abstraction)
-
-    (^ (synthesis.function/apply application))
-    (function.apply translate application)
-
-    (#synthesis.Extension extension)
-    (extension.apply translate extension)))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux
deleted file mode 100644
index a40b4953f..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux
+++ /dev/null
@@ -1,15 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [collection
-     ["." dictionary]]]]
-  [//
-   [runtime (#+ Bundle)]]
-  [/
-   ["." common]
-   ["." host]])
-
-(def: #export bundle
-  Bundle
-  (|> common.bundle
-      (dictionary.merge host.bundle)))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux
deleted file mode 100644
index 786b82280..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux
+++ /dev/null
@@ -1,360 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["e" error]
-    ["." product]
-    ["." text
-     format]
-    [number (#+ hex)]
-    [collection
-     ["." list ("list/." Functor)]
-     ["dict" dictionary (#+ Dictionary)]]]
-   ["." macro (#+ with-gensyms)
-    ["." code]
-    ["s" syntax (#+ syntax:)]]
-   [host (#+ import:)]]
-  [///
-   ["." runtime (#+ Operation Compiler Handler Bundle)]
-   ["//." ///
-    ["." synthesis (#+ Synthesis)]
-    [extension
-     ["." bundle]]
-    [//
-     [host
-      ["_" scheme (#+ Expression Computation)]]]]])
-
-## [Types]
-(syntax: (Vector {size s.nat} elemT)
-  (wrap (list (` [(~+ (list.repeat size elemT))]))))
-
-(type: #export Nullary (-> (Vector +0 Expression) Computation))
-(type: #export Unary   (-> (Vector +1 Expression) Computation))
-(type: #export Binary  (-> (Vector +2 Expression) Computation))
-(type: #export Trinary (-> (Vector +3 Expression) Computation))
-(type: #export Variadic (-> (List Expression) Computation))
-
-## [Utils]
-(syntax: (arity: {name s.local-symbol} {arity s.nat})
-  (with-gensyms [g!_ g!extension g!name g!translate g!inputs]
-    (do @
-      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
-      (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!extension))
-                       (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation)
-                           Handler)
-                       (function ((~ g!_) (~ g!name) (~ g!translate) (~ g!inputs))
-                         (case (~ g!inputs)
-                           (^ (list (~+ g!input+)))
-                           (do /////.Monad
-                             [(~+ (|> g!input+
-                                      (list/map (function (_ g!input)
-                                                  (list g!input (` ((~ g!translate) (~ g!input))))))
-                                      list.concat))]
-                             ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
-
-                           (~' _)
-                           (/////.throw bundle.incorrect-arity [(~ g!name) +1 (list.size (~ g!inputs))]))))))))))
-
-(arity: nullary +0)
-(arity: unary +1)
-(arity: binary +2)
-(arity: trinary +3)
-
-(def: #export (variadic extension)
-  (-> Variadic Handler)
-  (function (_ extension-name)
-    (function (_ translate inputsS)
-      (do /////.Monad
-        [inputsI (monad.map @ translate inputsS)]
-        (wrap (extension inputsI))))))
-
-## [Bundle]
-## [[Lux]]
-(def: bundle::lux
-  Bundle
-  (|> bundle.empty
-      (bundle.install "is?" (binary (product.uncurry _.eq?/2)))
-      (bundle.install "try" (unary runtime.lux//try))))
-
-## [[Bits]]
-(do-template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-  
-  [bit::and _.bit-and/2]
-  [bit::or  _.bit-or/2]
-  [bit::xor _.bit-xor/2]
-  )
-
-(def: (bit::left-shift [subjectO paramO])
-  Binary
-  (_.arithmetic-shift/2 (_.remainder/2 (_.int 64) paramO)
-                        subjectO))
-
-(def: (bit::arithmetic-right-shift [subjectO paramO])
-  Binary
-  (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int 64)) (_.*/2 (_.int -1)))
-                        subjectO))
-
-(def: (bit::logical-right-shift [subjectO paramO])
-  Binary
-  (runtime.bit//logical-right-shift (_.remainder/2 (_.int 64) paramO) subjectO))
-
-(def: bundle::bit
-  Bundle
-  (<| (bundle.prefix "bit")
-      (|> bundle.empty
-          (bundle.install "and" (binary bit::and))
-          (bundle.install "or" (binary bit::or))
-          (bundle.install "xor" (binary bit::xor))
-          (bundle.install "left-shift" (binary bit::left-shift))
-          (bundle.install "logical-right-shift" (binary bit::logical-right-shift))
-          (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
-          )))
-
-## [[Arrays]]
-(def: (array::new size0)
-  Unary
-  (_.make-vector/2 size0 _.nil))
-
-(def: (array::get [arrayO idxO])
-  Binary
-  (runtime.array//get arrayO idxO))
-
-(def: (array::put [arrayO idxO elemO])
-  Trinary
-  (runtime.array//put arrayO idxO elemO))
-
-(def: (array::remove [arrayO idxO])
-  Binary
-  (runtime.array//put arrayO idxO _.nil))
-
-(def: bundle::array
-  Bundle
-  (<| (bundle.prefix "array")
-      (|> bundle.empty
-          (bundle.install "new" (unary array::new))
-          (bundle.install "get" (binary array::get))
-          (bundle.install "put" (trinary array::put))
-          (bundle.install "remove" (binary array::remove))
-          (bundle.install "size" (unary _.vector-length/1))
-          )))
-
-## [[Numbers]]
-(import: java/lang/Double
-  (#static MIN_VALUE Double)
-  (#static MAX_VALUE Double))
-
-(do-template [  ]
-  [(def: ( _)
-     Nullary
-     ( ))]
-
-  [frac::smallest Double::MIN_VALUE            _.float]
-  [frac::min      (f/* -1.0 Double::MAX_VALUE) _.float]
-  [frac::max      Double::MAX_VALUE            _.float]
-  )
-
-(do-template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     (|> subjectO ( paramO)))]
-
-  [int::+ _.+/2]
-  [int::- _.-/2]
-  [int::* _.*/2]
-  [int::/ _.quotient/2]
-  [int::% _.remainder/2]
-  )
-
-(do-template [ ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-
-  [frac::+ _.+/2]
-  [frac::- _.-/2]
-  [frac::* _.*/2]
-  [frac::/ _.//2]
-  [frac::% _.mod/2]
-  [frac::= _.=/2]
-  [frac::< _. ]
-  [(def: ( [subjectO paramO])
-     Binary
-     ( paramO subjectO))]
-
-  [int::= _.=/2]
-  [int::< _.> _.integer->char/1 _.string/1))
-
-(def: bundle::int
-  Bundle
-  (<| (bundle.prefix "int")
-      (|> 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 "to-frac" (unary (|>> (_.//2 (_.float 1.0)))))
-          (bundle.install "char" (unary int::char)))))
-
-(def: bundle::frac
-  Bundle
-  (<| (bundle.prefix "frac")
-      (|> bundle.empty
-          (bundle.install "+" (binary frac::+))
-          (bundle.install "-" (binary frac::-))
-          (bundle.install "*" (binary frac::*))
-          (bundle.install "/" (binary frac::/))
-          (bundle.install "%" (binary frac::%))
-          (bundle.install "=" (binary frac::=))
-          (bundle.install "<" (binary frac::<))
-          (bundle.install "smallest" (nullary frac::smallest))
-          (bundle.install "min" (nullary frac::min))
-          (bundle.install "max" (nullary frac::max))
-          (bundle.install "to-int" (unary _.exact/1))
-          (bundle.install "encode" (unary _.number->string/1))
-          (bundle.install "decode" (unary runtime.frac//decode)))))
-
-## [[Text]]
-(def: (text::char [subjectO paramO])
-  Binary
-  (_.string/1 (_.string-ref/2 subjectO paramO)))
-
-(def: (text::clip [subjectO startO endO])
-  Trinary
-  (_.substring/3 subjectO startO endO))
-
-(def: bundle::text
-  Bundle
-  (<| (bundle.prefix "text")
-      (|> bundle.empty
-          (bundle.install "=" (binary text::=))
-          (bundle.install "<" (binary text::<))
-          (bundle.install "concat" (binary (product.uncurry _.string-append/2)))
-          (bundle.install "size" (unary _.string-length/1))
-          (bundle.install "char" (binary text::char))
-          (bundle.install "clip" (trinary text::clip)))))
-
-## [[Math]]
-(def: (math::pow [subject param])
-  Binary
-  (_.expt/2 param subject))
-
-(def: math-func
-  (-> Text Unary)
-  (|>> _.global _.apply/1))
-
-(def: bundle::math
-  Bundle
-  (<| (bundle.prefix "math")
-      (|> bundle.empty
-          (bundle.install "cos" (unary (math-func "cos")))
-          (bundle.install "sin" (unary (math-func "sin")))
-          (bundle.install "tan" (unary (math-func "tan")))
-          (bundle.install "acos" (unary (math-func "acos")))
-          (bundle.install "asin" (unary (math-func "asin")))
-          (bundle.install "atan" (unary (math-func "atan")))
-          (bundle.install "exp" (unary (math-func "exp")))
-          (bundle.install "log" (unary (math-func "log")))
-          (bundle.install "ceil" (unary (math-func "ceiling")))
-          (bundle.install "floor" (unary (math-func "floor")))
-          (bundle.install "pow" (binary math::pow))
-          )))
-
-## [[IO]]
-(def: (io::log input)
-  Unary
-  (_.begin (list (_.display/1 input)
-                 _.newline/0)))
-
-(def: (void code)
-  (-> Expression Computation)
-  (_.begin (list code (_.string synthesis.unit))))
-
-(def: bundle::io
-  Bundle
-  (<| (bundle.prefix "io")
-      (|> bundle.empty
-          (bundle.install "log" (unary (|>> io::log ..void)))
-          (bundle.install "error" (unary _.raise/1))
-          (bundle.install "exit" (unary _.exit/1))
-          (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit))))))))
-
-## [[Atoms]]
-(def: atom::new
-  Unary
-  (|>> (list) _.vector/*))
-
-(def: (atom::read atom)
-  Unary
-  (_.vector-ref/2 atom (_.int 0)))
-
-(def: (atom::compare-and-swap [atomO oldO newO])
-  Trinary
-  (runtime.atom//compare-and-swap atomO oldO newO))
-
-(def: bundle::atom
-  Bundle
-  (<| (bundle.prefix "atom")
-      (|> bundle.empty
-          (bundle.install "new" (unary atom::new))
-          (bundle.install "read" (unary atom::read))
-          (bundle.install "compare-and-swap" (trinary atom::compare-and-swap)))))
-
-## [[Box]]
-(def: (box::write [valueO boxO])
-  Binary
-  (runtime.box//write valueO boxO))
-
-(def: bundle::box
-  Bundle
-  (<| (bundle.prefix "box")
-      (|> bundle.empty
-          (bundle.install "new" (unary atom::new))
-          (bundle.install "read" (unary atom::read))
-          (bundle.install "write" (binary box::write)))))
-
-## [[Processes]]
-(def: (process::parallelism-level [])
-  Nullary
-  (_.int 1))
-
-(def: bundle::process
-  Bundle
-  (<| (bundle.prefix "process")
-      (|> bundle.empty
-          (bundle.install "parallelism-level" (nullary process::parallelism-level))
-          (bundle.install "schedule" (binary (product.uncurry runtime.process//schedule)))
-          )))
-
-## [Bundles]
-(def: #export bundle
-  Bundle
-  (<| (bundle.prefix "lux")
-      (|> bundle::lux
-          (dict.merge bundle::bit)
-          (dict.merge bundle::int)
-          (dict.merge bundle::frac)
-          (dict.merge bundle::text)
-          (dict.merge bundle::array)
-          (dict.merge bundle::math)
-          (dict.merge bundle::io)
-          (dict.merge bundle::atom)
-          (dict.merge bundle::box)
-          (dict.merge bundle::process)
-          )))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/extension/host.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/extension/host.jvm.lux
deleted file mode 100644
index b8b2b7612..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/extension/host.jvm.lux
+++ /dev/null
@@ -1,11 +0,0 @@
-(.module:
-  [lux #*]
-  [///
-   [runtime (#+ Bundle)]
-   [///
-    [extension
-     ["." bundle]]]])
-
-(def: #export bundle
-  Bundle
-  bundle.empty)
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux
deleted file mode 100644
index 17022587c..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux
+++ /dev/null
@@ -1,91 +0,0 @@
-(.module:
-  [lux (#- function)
-   [control
-    ["." monad (#+ do)]
-    pipe]
-   [data
-    ["." product]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Functor)]]]]
-  [//
-   ["." runtime (#+ Operation Compiler)]
-   ["." reference]
-   ["/." //
-    ["//." // ("operation/." Monad)
-     [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
-     [synthesis (#+ Synthesis)]
-     [//
-      [reference (#+ Register Variable)]
-      ["." name]
-      [host
-       ["_" scheme (#+ Expression Computation Var)]]]]]])
-
-(def: #export (apply translate [functionS argsS+])
-  (-> Compiler (Application Synthesis) (Operation Computation))
-  (do ////.Monad
-    [functionO (translate functionS)
-     argsO+ (monad.map @ translate argsS+)]
-    (wrap (_.apply/* functionO argsO+))))
-
-(def: (with-closure function-name inits function-definition)
-  (-> Text (List Expression) Computation (Operation Computation))
-  (let [@closure (_.var (format function-name "___CLOSURE"))]
-    (operation/wrap
-     (case inits
-       #.Nil
-       function-definition
-
-       _
-       (_.letrec (list [@closure
-                        (_.lambda [(|> (list.enumerate inits)
-                                  (list/map (|>> product.left reference.foreign')))
-                              #.None]
-                             function-definition)])
-                 (_.apply/* @closure inits))))))
-
-(def: @curried (_.var "curried"))
-(def: @missing (_.var "missing"))
-
-(def: input
-  (|>> inc reference.local'))
-
-(def: #export (function translate [environment arity bodyS])
-  (-> Compiler (Abstraction Synthesis) (Operation Computation))
-  (do ////.Monad
-    [[function-name bodyO] (///.with-context
-                             (do @
-                               [function-name ///.context]
-                               (///.with-anchor (_.var function-name)
-                                 (translate bodyS))))
-     closureO+ (monad.map @ reference.variable environment)
-     #let [arityO (|> arity .int _.int)
-           @num-args (_.var "num_args")
-           @function (_.var function-name)
-           apply-poly (.function (_ args func)
-                        (_.apply/2 (_.global "apply") func args))]]
-    (with-closure function-name closureO+
-      (_.letrec (list [@function (_.lambda [(list) (#.Some @curried)]
-                                      (_.let (list [@num-args (_.length/1 @curried)])
-                                        (<| (_.if (|> @num-args (_.=/2 arityO))
-                                              (<| (_.let (list [(reference.local' +0) @function]))
-                                                  (_.let-values (list [[(|> (list.n/range +0 (dec arity))
-                                                                            (list/map ..input))
-                                                                        #.None]
-                                                                       (_.apply/2 (_.global "apply") (_.global "values") @curried)]))
-                                                  bodyO))
-                                            (_.if (|> @num-args (_.>/2 arityO))
-                                              (let [arity-args (runtime.slice (_.int 0) arityO @curried)
-                                                    output-func-args (runtime.slice arityO
-                                                                                    (|> @num-args (_.-/2 arityO))
-                                                                                    @curried)]
-                                                (|> @function
-                                                    (apply-poly arity-args)
-                                                    (apply-poly output-func-args))))
-                                            ## (|> @num-args (_. @function
-                                                     (apply-poly (_.append/2 @curried @missing)))))))])
-                @function))
-    ))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux
deleted file mode 100644
index 8c73f77e4..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux
+++ /dev/null
@@ -1,41 +0,0 @@
-(.module:
-  [lux (#- Scope)
-   [control
-    ["." monad (#+ do)]]
-   [data
-    ["." product]
-    ["." text
-     format]
-    [collection
-     ["." list ("list/." Functor)]]]]
-  [//
-   [runtime (#+ Operation Compiler)]
-   ["." reference]
-   ["/." //
-    ["//." //
-     [synthesis (#+ Scope Synthesis)]
-     [//
-      [host
-       ["_" scheme (#+ Computation Var)]]]]]])
-
-(def: @scope (_.var "scope"))
-
-(def: #export (scope translate [start initsS+ bodyS])
-  (-> Compiler (Scope Synthesis) (Operation Computation))
-  (do ////.Monad
-    [initsO+ (monad.map @ translate initsS+)
-     bodyO (///.with-anchor @scope
-             (translate bodyS))]
-    (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
-                                            list.enumerate
-                                            (list/map (|>> product.left (n/+ start) reference.local')))
-                                        #.None]
-                                       bodyO)])
-                    (_.apply/* @scope initsO+)))))
-
-(def: #export (recur translate argsS+)
-  (-> Compiler (List Synthesis) (Operation Computation))
-  (do ////.Monad
-    [@scope ///.anchor
-     argsO+ (monad.map @ translate argsS+)]
-    (wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux
deleted file mode 100644
index a8fa6326f..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux
+++ /dev/null
@@ -1,24 +0,0 @@
-(.module:
-  [lux (#- i64)]
-  [/// (#+ State)]
-  [/////
-   [host
-    ["_" scheme (#+ Expression)]]
-   [compiler ("operation/." Monad)]]
-  [//runtime (#+ Operation)])
-
-(def: #export bit
-  (-> Bit (Operation Expression))
-  (|>> _.bool operation/wrap))
-
-(def: #export i64
-  (-> (I64 Any) (Operation Expression))
-  (|>> .int _.int operation/wrap))
-
-(def: #export f64
-  (-> Frac (Operation Expression))
-  (|>> _.float operation/wrap))
-
-(def: #export text
-  (-> Text (Operation Expression))
-  (|>> _.string operation/wrap))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux
deleted file mode 100644
index db56d8937..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux
+++ /dev/null
@@ -1,58 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    pipe]
-   [data
-    [text
-     format]]]
-  [//
-   [runtime (#+ Operation)]
-   [/// ("operation/." Monad)
-    [analysis (#+ Variant Tuple)]
-    [synthesis (#+ Synthesis)]
-    [//
-     ["." reference (#+ Register Variable Reference)]
-     ["." name]
-     [host ["_" scheme (#+ Expression Var)]]]]])
-
-(do-template [ ]
-  [(def: #export 
-     (-> Register Var)
-     (|>> .int %i (format ) _.var))]
-
-  [local'   "l"]
-  [foreign' "f"]
-  )
-
-(def: #export variable'
-  (-> Variable Var)
-  (|>> (case> (#reference.Local register)
-              (local' register)
-              
-              (#reference.Foreign register)
-              (foreign' register))))
-
-(def: #export variable
-  (-> Variable (Operation Var))
-  (|>> ..variable'
-       operation/wrap))
-
-(def: #export constant'
-  (-> Ident Var)
-  (|>> name.definition _.var))
-
-(def: #export constant
-  (-> Ident (Operation Var))
-  (|>> constant' operation/wrap))
-
-(def: #export reference'
-  (-> Reference Expression)
-  (|>> (case> (#reference.Constant value)
-              (..constant' value)
-              
-              (#reference.Variable value)
-              (..variable' value))))
-
-(def: #export reference
-  (-> Reference (Operation Expression))
-  (|>> reference' operation/wrap))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux
deleted file mode 100644
index 565cbeabd..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux
+++ /dev/null
@@ -1,372 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["p" parser ("parser/." Monad)]
-    [monad (#+ do)]]
-   [data
-    [number (#+ hex)]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Monad)]]]
-   ["." function]
-   [macro
-    ["." code]
-    ["s" syntax (#+ syntax:)]]]
-  ["." ///
-   ["//." //
-    [analysis (#+ Variant)]
-    ["." synthesis]
-    [//
-     ["." name]
-     [host ["_" scheme (#+ Expression Computation Var)]]]]])
-
-(do-template [ ]
-  [(type: #export 
-     ( Var Expression Expression))]
-
-  [Operation ///.Operation]
-  [Compiler ///.Compiler]
-  [Handler ///.Handler]
-  [Bundle ///.Bundle]
-  )
-
-(def: prefix Text "LuxRuntime")
-
-(def: unit (_.string synthesis.unit))
-
-(def: #export variant-tag "lux-variant")
-
-(def: (flag value)
-  (-> Bit Computation)
-  (if value
-    (_.string "")
-    _.nil))
-
-(def: (variant' tag last? value)
-  (-> Expression Expression Expression Computation)
-  (<| (_.cons/2 (_.symbol ..variant-tag))
-      (_.cons/2 tag)
-      (_.cons/2 last?)
-      value))
-
-(def: #export (variant [lefts right? value])
-  (-> (Variant Expression) Computation)
-  (variant' (_.int (.int lefts)) (flag right?) value))
-
-(def: #export none
-  Computation
-  (variant [+0 #0 ..unit]))
-
-(def: #export some
-  (-> Expression Computation)
-  (|>> [+0 #1] ..variant))
-
-(def: #export left
-  (-> Expression Computation)
-  (|>> [+0 #0] ..variant))
-
-(def: #export right
-  (-> Expression Computation)
-  (|>> [+0 #1] ..variant))
-
-(def: declaration
-  (s.Syntax [Text (List Text)])
-  (p.either (p.seq s.local-symbol (parser/wrap (list)))
-            (s.form (p.seq s.local-symbol (p.some s.local-symbol)))))
-
-(syntax: (runtime: {[name args] declaration}
-           definition)
-  (let [implementation (code.local-symbol (format "@@" name))
-        runtime (format prefix "__" (name.normalize name))
-        @runtime (` (_.var (~ (code.text runtime))))
-        argsC+ (list/map code.local-symbol args)
-        argsLC+ (list/map (|>> name.normalize (format "LRV__") code.text (~) (_.var) (`))
-                          args)
-        declaration (` ((~ (code.local-symbol name))
-                        (~+ argsC+)))
-        type (` (-> (~+ (list.repeat (list.size argsC+) (` _.Expression)))
-                    _.Computation))]
-    (wrap (list (` (def: (~' #export) (~ declaration)
-                     (~ type)
-                     (~ (case argsC+
-                          #.Nil
-                          @runtime
-
-                          _
-                          (` (_.apply/* (~ @runtime) (list (~+ argsC+))))))))
-                (` (def: (~ implementation)
-                     _.Computation
-                     (~ (case argsC+
-                          #.Nil
-                          (` (_.define (~ @runtime) [(list) #.None] (~ definition)))
-
-                          _
-                          (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
-                                           (list/map (function (_ [left right])
-                                                       (list left right)))
-                                           list/join))]
-                               (_.define (~ @runtime) [(list (~+ argsLC+)) #.None]
-                                         (~ definition))))))))))))
-
-(runtime: (slice offset length list)
-  (<| (_.if (_.null?/1 list)
-        list)
-      (_.if (|> offset (_.>/2 (_.int 0)))
-        (slice (|> offset (_.-/2 (_.int 1)))
-               length
-               (_.cdr/1 list)))
-      (_.if (|> length (_.>/2 (_.int 0)))
-        (_.cons/2 (_.car/1 list)
-                  (slice offset
-                         (|> length (_.-/2 (_.int 1)))
-                         (_.cdr/1 list))))
-      _.nil))
-
-(syntax: #export (with-vars {vars (s.tuple (p.many s.local-symbol))}
-                   body)
-  (wrap (list (` (let [(~+ (|> vars
-                               (list/map (function (_ var)
-                                           (list (code.local-symbol var)
-                                                 (` (_.var (~ (code.text (format "LRV__" (name.normalize var)))))))))
-                               list/join))]
-                   (~ body))))))
-
-(runtime: (lux//try op)
-  (with-vars [error]
-    (_.with-exception-handler
-      (_.lambda [(list error) #.None]
-           (..left error))
-      (_.lambda [(list) #.None]
-           (..right (_.apply/* op (list ..unit)))))))
-
-(runtime: (lux//program-args program-args)
-  (with-vars [@loop @input @output]
-    (_.letrec (list [@loop (_.lambda [(list @input @output) #.None]
-                                (_.if (_.eqv?/2 _.nil @input)
-                                  @output
-                                  (_.apply/2 @loop (_.cdr/1 @input) (..some (_.vector/* (list (_.car/1 @input) @output))))))])
-              (_.apply/2 @loop (_.reverse/1 program-args) ..none))))
-
-(def: runtime//lux
-  Computation
-  (_.begin (list @@lux//try
-                 @@lux//program-args)))
-
-(def: minimum-index-length
-  (-> Expression Computation)
-  (|>> (_.+/2 (_.int 1))))
-
-(def: product-element
-  (-> Expression Expression Computation)
-  (function.flip _.vector-ref/2))
-
-(def: (product-tail product)
-  (-> Expression Computation)
-  (_.vector-ref/2 product (|> (_.length/1 product) (_.-/2 (_.int 1)))))
-
-(def: (updated-index min-length product)
-  (-> Expression Expression Computation)
-  (|> min-length (_.-/2 (_.length/1 product))))
-
-(runtime: (product//left product index)
-  (let [@index_min_length (_.var "index_min_length")]
-    (_.begin
-     (list (_.define @index_min_length [(list) #.None]
-                     (minimum-index-length index))
-           (_.if (|> product _.length/1 (_.>/2 @index_min_length))
-             ## No need for recursion
-             (product-element index product)
-             ## Needs recursion
-             (product//left (product-tail product)
-                            (updated-index @index_min_length product)))))))
-
-(runtime: (product//right product index)
-  (let [@index_min_length (_.var "index_min_length")
-        @product_length (_.var "product_length")
-        @slice (_.var "slice")
-        last-element? (|> @product_length (_.=/2 @index_min_length))
-        needs-recursion? (|> @product_length (_. @product_length (_.-/2 index))))
-                 (_.vector-copy!/5 @slice (_.int 0) product index @product_length)
-                 @slice)))))))
-
-(runtime: (sum//get sum last? wanted-tag)
-  (with-vars [variant-tag sum-tag sum-flag sum-value]
-    (let [no-match _.nil
-          is-last? (|> sum-flag (_.eqv?/2 (_.string "")))
-          test-recursion (_.if is-last?
-                           ## Must recurse.
-                           (sum//get sum-value
-                                     (|> wanted-tag (_.-/2 sum-tag))
-                                     last?)
-                           no-match)]
-      (<| (_.let-values (list [[(list variant-tag sum-tag sum-flag sum-value) #.None]
-                               (_.apply/* (_.global "apply") (list (_.global "values") sum))]))
-          (_.if (|> wanted-tag (_.=/2 sum-tag))
-            (_.if (|> sum-flag (_.eqv?/2 last?))
-              sum-value
-              test-recursion))
-          (_.if (|> wanted-tag (_.>/2 sum-tag))
-            test-recursion)
-          (_.if (_.and (list (|> last? (_.eqv?/2 (_.string "")))
-                             (|> wanted-tag (_. sum-tag (_.-/2 wanted-tag)) sum-flag sum-value))
-          no-match))))
-
-(def: runtime//adt
-  Computation
-  (_.begin (list @@product//left
-                 @@product//right
-                 @@sum//get)))
-
-(runtime: (bit//logical-right-shift shift input)
-  (_.if (_.=/2 (_.int 0) shift)
-    input
-    (|> input
-        (_.arithmetic-shift/2 (_.*/2 (_.int -1) shift))
-        (_.bit-and/2 (_.int (hex "7FFFFFFFFFFFFFFF"))))))
-
-(def: runtime//bit
-  Computation
-  (_.begin (list @@bit//logical-right-shift)))
-
-(runtime: (frac//decode input)
-  (with-vars [@output]
-    (_.let (list [@output ((_.apply/1 (_.global "string->number")) input)])
-      (_.if (_.and (list (_.not/1 (_.=/2 @output @output))
-                         (_.not/1 (_.eqv?/2 (_.string "+nan.0") input))))
-        ..none
-        (..some @output)))))
-
-(def: runtime//frac
-  Computation
-  (_.begin
-   (list @@frac//decode)))
-
-(def: (check-index-out-of-bounds array idx body)
-  (-> Expression Expression Expression Computation)
-  (_.if (|> idx (_.<=/2 (_.length/1 array)))
-    body
-    (_.raise/1 (_.string "Array index out of bounds!"))))
-
-(runtime: (array//get array idx)
-  (with-vars [@temp]
-    (<| (check-index-out-of-bounds array idx)
-        (_.let (list [@temp (_.vector-ref/2 array idx)])
-          (_.if (|> @temp (_.eqv?/2 _.nil))
-            ..none
-            (..some @temp))))))
-
-(runtime: (array//put array idx value)
-  (<| (check-index-out-of-bounds array idx)
-      (_.begin
-       (list (_.vector-set!/3 array idx value)
-             array))))
-
-(def: runtime//array
-  Computation
-  (_.begin
-   (list @@array//get
-         @@array//put)))
-
-(runtime: (atom//compare-and-swap atom old new)
-  (with-vars [@temp]
-    (_.let (list [@temp (_.vector-ref/2 atom (_.int 0))])
-      (_.if (_.eq?/2 old @temp)
-        (_.begin
-         (list (_.vector-set!/3 atom (_.int 0) new)
-               (_.bool #1)))
-        (_.bool #0)))))
-
-(def: runtime//atom
-  Computation
-  @@atom//compare-and-swap)
-
-(runtime: (box//write value box)
-  (_.begin
-   (list
-    (_.vector-set!/3 box (_.int 0) value)
-    ..unit)))
-
-(def: runtime//box
-  Computation
-  (_.begin (list @@box//write)))
-
-(runtime: (io//current-time _)
-  (|> (_.apply/* (_.global "current-second") (list))
-      (_.*/2 (_.int 1_000))
-      _.exact/1))
-
-(def: runtime//io
-  (_.begin (list @@io//current-time)))
-
-(def: process//incoming
-  Var
-  (_.var (name.normalize "process//incoming")))
-
-(runtime: (process//loop _)
-  (_.when (_.not/1 (_.null?/1 process//incoming))
-          (with-vars [queue process]
-            (_.let (list [queue process//incoming])
-              (_.begin (list (_.set! process//incoming (_.list/* (list)))
-                             (_.map/2 (_.lambda [(list process) #.None]
-                                           (_.apply/1 process ..unit))
-                                      queue)
-                             (process//loop ..unit)))))))
-
-(runtime: (process//schedule milli-seconds procedure)
-  (let [process//future (function (_ process)
-                          (_.set! process//incoming (_.cons/2 process process//incoming)))]
-    (_.begin
-     (list
-      (_.if (_.=/2 (_.int 0) milli-seconds)
-        (process//future procedure)
-        (with-vars [@start @process @now @ignored]
-          (_.let (list [@start (io//current-time ..unit)])
-            (_.letrec (list [@process (_.lambda [(list) (#.Some @ignored)]
-                                           (_.let (list [@now (io//current-time ..unit)])
-                                             (_.if (|> @now (_.-/2 @start) (_.>=/2 milli-seconds))
-                                               (_.apply/1 procedure ..unit)
-                                               (process//future @process))))])
-                      (process//future @process)))))
-      ..unit))))
-
-(def: runtime//process
-  Computation
-  (_.begin (list (_.define process//incoming [(list) #.None] (_.list/* (list)))
-                 @@process//loop
-                 @@process//schedule)))
-
-(def: runtime
-  Computation
-  (_.begin (list @@slice
-                 runtime//lux
-                 runtime//bit
-                 runtime//adt
-                 runtime//frac
-                 runtime//array
-                 runtime//atom
-                 runtime//box
-                 runtime//io
-                 runtime//process
-                 )))
-
-(def: #export translate
-  (Operation Any)
-  (///.with-buffer
-    (do ////.Monad
-      [_ (///.save! ["" ..prefix] ..runtime)]
-      (///.save-buffer! ""))))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux
deleted file mode 100644
index 1f7f2cf27..000000000
--- a/stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux
+++ /dev/null
@@ -1,33 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]]]
-  [//
-   ["." runtime (#+ Operation Compiler)]
-   ["." primitive]
-   ["." ///
-    [analysis (#+ Variant Tuple)]
-    ["." synthesis (#+ Synthesis)]
-    [//
-     [host
-      ["_" scheme (#+ Expression)]]]]])
-
-(def: #export (tuple translate elemsS+)
-  (-> Compiler (Tuple Synthesis) (Operation Expression))
-  (case elemsS+
-    #.Nil
-    (primitive.text synthesis.unit)
-
-    (#.Cons singletonS #.Nil)
-    (translate singletonS)
-
-    _
-    (do ///.Monad
-      [elemsT+ (monad.map @ translate elemsS+)]
-      (wrap (_.vector/* elemsT+)))))
-
-(def: #export (variant translate [lefts right? valueS])
-  (-> Compiler (Variant Synthesis) (Operation Expression))
-  (do ///.Monad
-    [valueT (translate valueS)]
-    (wrap (runtime.variant [lefts right? valueT]))))
diff --git a/stdlib/source/lux/language/host.lux b/stdlib/source/lux/language/host.lux
deleted file mode 100644
index 218de67a4..000000000
--- a/stdlib/source/lux/language/host.lux
+++ /dev/null
@@ -1,18 +0,0 @@
-(.module:
-  lux)
-
-(type: #export Host Text)
-
-(do-template [ ]
-  [(def: #export  Host )]
-
-  [common-lisp "Common Lisp"]
-  [js          "JavaScript"]
-  [jvm         "JVM"]
-  [lua         "Lua"]
-  [php         "PHP"]
-  [python      "Python"]
-  [r           "R"]
-  [ruby        "Ruby"]
-  [scheme      "Scheme"]
-  )
diff --git a/stdlib/source/lux/language/host/scheme.lux b/stdlib/source/lux/language/host/scheme.lux
deleted file mode 100644
index 8d5cbdbcd..000000000
--- a/stdlib/source/lux/language/host/scheme.lux
+++ /dev/null
@@ -1,306 +0,0 @@
-(.module:
-  [lux (#- Code' Code int or and if function cond when let)
-   [control
-    pipe]
-   [data
-    ["." number]
-    ["." text
-     format]
-    [collection
-     ["." list ("list/." Functor Fold)]]]
-   [type
-    abstract]])
-
-(abstract: Global' {} Any)
-(abstract: Var' {} Any)
-(abstract: Computation' {} Any)
-(abstract: (Expression' k) {} Any)
-
-(abstract: (Code' k)
-  {}
-  
-  Text
-
-  (type: #export Code (Ex [k] (Code' k)))
-  (type: #export Expression (Code' (Ex [k] (Expression' k))))
-  (type: #export Global (Code' (Expression' Global')))
-  (type: #export Computation (Code' (Expression' Computation')))
-  (type: #export Var (Code' (Expression' Var')))
-
-  (type: #export Arguments
-    {#mandatory (List Var)
-     #rest (Maybe Var)})
-
-  (def: #export code (-> Code Text) (|>> :representation))
-
-  (def: #export var (-> Text Var) (|>> :abstraction))
-
-  (def: (arguments [vars rest])
-    (-> Arguments Code)
-    (case rest
-      (#.Some rest)
-      (case vars
-        #.Nil
-        rest
-
-        _
-        (|> (format " . " (:representation rest))
-            (format (|> vars
-                        (list/map ..code)
-                        (text.join-with " ")))
-            (text.enclose ["(" ")"])
-            :abstraction))
-      
-      #.None
-      (|> vars
-          (list/map ..code)
-          (text.join-with " ")
-          (text.enclose ["(" ")"])
-          :abstraction)))
-
-  (def: #export nil
-    Computation
-    (:abstraction "'()"))
-
-  (def: #export bool
-    (-> Bit Computation)
-    (|>> (case> #0 "#f"
-                #1 "#t")
-         :abstraction))
-
-  (def: #export int
-    (-> Int Computation)
-    (|>> %i :abstraction))
-
-  (def: #export float
-    (-> Frac Computation)
-    (|>> (cond> [(f/= number.positive-infinity)]
-                [(new> "+inf.0")]
-                
-                [(f/= number.negative-infinity)]
-                [(new> "-inf.0")]
-                
-                [number.not-a-number?]
-                [(new> "+nan.0")]
-                
-                ## else
-                [%f])
-         :abstraction))
-
-  (def: #export positive-infinity Computation (..float number.positive-infinity))
-  (def: #export negative-infinity Computation (..float number.negative-infinity))
-  (def: #export not-a-number Computation (..float number.not-a-number))
-
-  (def: #export string
-    (-> Text Computation)
-    (|>> %t :abstraction))
-
-  (def: #export symbol
-    (-> Text Computation)
-    (|>> (format "'") :abstraction))
-
-  (def: #export global
-    (-> Text Global)
-    (|>> :abstraction))
-
-  (def: form
-    (-> (List Code) Text)
-    (|>> (list/map ..code)
-         (text.join-with " ")
-         (text.enclose ["(" ")"])))
-  
-  (def: #export (apply/* func args)
-    (-> Expression (List Expression) Computation)
-    (:abstraction (..form (#.Cons func args))))
-  
-  (do-template [ ]
-    [(def: #export 
-       (-> (List Expression) Computation)
-       (apply/* (..global )))]
-
-    [vector/* "vector"]
-    [list/*   "list"]
-    )
-
-  (def: #export (apply/0 func)
-    (-> Expression Computation)
-    (..apply/* func (list)))
-
-  (do-template [ ]
-    [(def: #export  (apply/0 (..global )))]
-
-    [newline/0 "newline"]
-    )
-
-  (def: #export (apply/1 func)
-    (-> Expression (-> Expression Computation))
-    (|>> (list) (..apply/* func)))
-
-  (do-template [ ]
-    [(def: #export  (apply/1 (..global )))]
-
-    [exact/1 "exact"]
-    [integer->char/1 "integer->char"]
-    [number->string/1 "number->string"]
-    [string/1 "string"]
-    [length/1 "length"]
-    [values/1 "values"]
-    [null?/1 "null?"]
-    [car/1 "car"]
-    [cdr/1 "cdr"]
-    [raise/1 "raise"]
-    [error-object-message/1 "error-object-message"]
-    [make-vector/1 "make-vector"]
-    [vector-length/1 "vector-length"]
-    [not/1 "not"]
-    [string-length/1 "string-length"]
-    [string-hash/1 "string-hash"]
-    [reverse/1 "reverse"]
-    [display/1 "display"]
-    [exit/1 "exit"]
-    )
-  
-  (def: #export (apply/2 func)
-    (-> Expression (-> Expression Expression Computation))
-    (.function (_ _0 _1)
-      (..apply/* func (list _0 _1))))
-
-  (do-template [ ]
-    [(def: #export  (apply/2 (..global )))]
-
-    [append/2 "append"]
-    [cons/2 "cons"]
-    [make-vector/2 "make-vector"]
-    [vector-ref/2 "vector-ref"]
-    [list-tail/2 "list-tail"]
-    [map/2 "map"]
-    [string-ref/2 "string-ref"]
-    [string-append/2 "string-append"]
-    )
-
-  (do-template [ ]
-    [(def: #export ( param subject)
-       (-> Expression Expression Computation)
-       (..apply/2 (..global ) subject param))]
-
-    [=/2   "="]
-    [eq?/2 "eq?"]
-    [eqv?/2 "eqv?"]
-    [/2   ">"]
-    [>=/2  ">="]
-    [string=?/2 "string=?"]
-    [string Expression (-> Expression Expression Expression Computation))
-    (.function (_ _0 _1 _2)
-      (..apply/* func (list _0 _1 _2))))
-
-  (do-template [ ]
-    [(def: #export  (apply/3 (..global )))]
-
-    [substring/3 "substring"]
-    [vector-set!/3 "vector-set!"]
-    )
-
-  (def: #export (vector-copy!/5 _0 _1 _2 _3 _4)
-    (-> Expression Expression Expression Expression Expression
-        Computation)
-    (..apply/* (..global "vector-copy!")
-               (list _0 _1 _2 _3 _4)))
-  
-  (do-template [ ]
-    [(def: #export 
-       (-> (List Expression) Computation)
-       (|>> (list& (..global )) ..form :abstraction))]
-
-    [or "or"]
-    [and "and"]
-    )
-
-  (do-template [   
]
-    [(def: #export ( bindings body)
-       (-> (List [ Expression]) Expression Computation)
-       (:abstraction
-        (..form (list (..global )
-                      (|> bindings
-                          (list/map (.function (_ [binding/name binding/value])
-                                      (:abstraction
-                                       (..form (list (
 binding/name)
-                                                     binding/value)))))
-                          ..form
-                          :abstraction)
-                      body))))]
-
-    [let           "let"           Var       .id]
-    [let*          "let*"          Var       .id]
-    [letrec        "letrec"        Var       .id]
-    [let-values    "let-values"    Arguments ..arguments]
-    [let*-values   "let*-values"   Arguments ..arguments]
-    [letrec-values "letrec-values" Arguments ..arguments]
-    )
-
-  (def: #export (if test then else)
-    (-> Expression Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "if") test then else))))
-
-  (def: #export (when test then)
-    (-> Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "when") test then))))
-
-  (def: #export (cond clauses else)
-    (-> (List [Expression Expression]) Expression Computation)
-    (|> (list/fold (.function (_ [test then] next)
-                     (if test then next))
-                   else
-                   (list.reverse clauses))
-        :representation
-        :abstraction))
-
-  (def: #export (lambda arguments body)
-    (-> Arguments Expression Computation)
-    (:abstraction
-     (..form (list (..global "lambda")
-                   (..arguments arguments)
-                   body))))
-
-  (def: #export (define name arguments body)
-    (-> Var Arguments Expression Computation)
-    (:abstraction
-     (..form (list (..global "define")
-                   (|> arguments
-                       (update@ #mandatory (|>> (#.Cons name)))
-                       ..arguments)
-                   body))))
-
-  (def: #export begin
-    (-> (List Expression) Computation)
-    (|>> (#.Cons (..global "begin")) ..form :abstraction))
-
-  (def: #export (set! name value)
-    (-> Var Expression Computation)
-    (:abstraction
-     (..form (list (..global "set!") name value))))
-
-  (def: #export (with-exception-handler handler body)
-    (-> Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "with-exception-handler") handler body))))
-  )
diff --git a/stdlib/source/lux/language/name.lux b/stdlib/source/lux/language/name.lux
deleted file mode 100644
index f6489b89c..000000000
--- a/stdlib/source/lux/language/name.lux
+++ /dev/null
@@ -1,48 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    ["." maybe]
-    ["." text
-     format]]])
-
-(def: (sanitize char)
-  (-> Nat Text)
-  (case char
-    (^ (char "*")) "_ASTER_"
-    (^ (char "+")) "_PLUS_"
-    (^ (char "-")) "_DASH_"
-    (^ (char "/")) "_SLASH_"
-    (^ (char "\\")) "_BSLASH_"
-    (^ (char "_")) "_UNDERS_"
-    (^ (char "%")) "_PERCENT_"
-    (^ (char "$")) "_DOLLAR_"
-    (^ (char "'")) "_QUOTE_"
-    (^ (char "`")) "_BQUOTE_"
-    (^ (char "@")) "_AT_"
-    (^ (char "^")) "_CARET_"
-    (^ (char "&")) "_AMPERS_"
-    (^ (char "=")) "_EQ_"
-    (^ (char "!")) "_BANG_"
-    (^ (char "?")) "_QM_"
-    (^ (char ":")) "_COLON_"
-    (^ (char ".")) "_PERIOD_"
-    (^ (char ",")) "_COMMA_"
-    (^ (char "<")) "_LT_"
-    (^ (char ">")) "_GT_"
-    (^ (char "~")) "_TILDE_"
-    (^ (char "|")) "_PIPE_"
-    _              (text.from-code char)))
-
-(def: #export (normalize name)
-  (-> Text Text)
-  (let [name/size (text.size name)]
-    (loop [idx +0
-           output ""]
-      (if (n/< name/size idx)
-        (recur (inc idx)
-               (|> (text.nth idx name) maybe.assume sanitize (format output)))
-        output))))
-
-(def: #export (definition [module name])
-  (-> Ident Text)
-  (format (normalize module) "___" (normalize name)))
diff --git a/stdlib/source/lux/language/reference.lux b/stdlib/source/lux/language/reference.lux
deleted file mode 100644
index 84b838b3d..000000000
--- a/stdlib/source/lux/language/reference.lux
+++ /dev/null
@@ -1,67 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [equivalence (#+ Equivalence)]
-    [hash (#+ Hash)]
-    pipe]])
-
-(type: #export Register Nat)
-
-(type: #export Variable
-  (#Local Register)
-  (#Foreign Register))
-
-(type: #export Reference
-  (#Variable Variable)
-  (#Constant Ident))
-
-(structure: #export _ (Equivalence Variable)
-  (def: (= reference sample)
-    (case [reference sample]
-      (^template []
-        [( reference') ( sample')]
-        (n/= reference' sample'))
-      ([#Local] [#Foreign])
-
-      _
-      #0)))
-
-(structure: #export _ (Hash Variable)
-  (def: eq Equivalence)
-  (def: (hash var)
-    (case var
-      (#Local register)
-      (n/* +1 register)
-      
-      (#Foreign register)
-      (n/* +2 register))))
-
-(do-template [  ]
-  [(template: #export ( content)
-     (<| 
-         
-         content))]
-
-  [local   #..Variable #..Local]
-  [foreign #..Variable #..Foreign]
-  )
-
-(do-template [ ]
-  [(template: #export ( content)
-     (<| 
-         content))]
-
-  [variable #..Variable]
-  [constant #..Constant]
-  )
-
-(def: #export self Reference (..local +0))
-
-(def: #export self?
-  (-> Variable Bit)
-  (|>> ..variable
-       (case> (^ (..local +0))
-              #1
-
-              _
-              #0)))
diff --git a/stdlib/source/lux/language/syntax.lux b/stdlib/source/lux/language/syntax.lux
deleted file mode 100644
index 41c11ee2d..000000000
--- a/stdlib/source/lux/language/syntax.lux
+++ /dev/null
@@ -1,629 +0,0 @@
-## This is LuxC's parser.
-## It takes the source code of a Lux file in raw text form and
-## extracts the syntactic structure of the code from it.
-## It only produces Lux Code nodes, and thus removes any white-space
-## and comments while processing its inputs.
-
-## Another important aspect of the parser is that it keeps track of
-## its position within the input data.
-## That is, the parser takes into account the line and column
-## information in the input text (it doesn't really touch the
-## file-name aspect of the cursor, leaving it intact in whatever
-## base-line cursor it is given).
-
-## This particular piece of functionality is not located in one
-## function, but it is instead scattered throughout several parsers,
-## since the logic for how to update the cursor varies, depending on
-## what is being parsed, and the rules involved.
-
-## You will notice that several parsers have a "where" parameter, that
-## tells them the cursor position prior to the parser being run.
-## They are supposed to produce some parsed output, alongside an
-## updated cursor pointing to the end position, after the parser was run.
-
-## Lux Code nodes/tokens are annotated with cursor meta-data
-## (file-name, line, column) to keep track of their provenance and
-## location, which is helpful for documentation and debugging.
-(.module:
-  [lux (#- nat int rev)
-   [control
-    monad
-    ["p" parser ("parser/." Monad)]
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["e" error]
-    ["." number]
-    ["." product]
-    ["." maybe]
-    ["." text
-     ["l" lexer]
-     format]
-    [collection
-     ["." row (#+ Row)]
-     ["dict" dictionary (#+ Dictionary)]]]])
-
-(type: #export Aliases (Dictionary Text Text))
-
-(def: white-space Text "\t\v \r\f")
-(def: new-line Text "\n")
-
-## This is the parser for white-space.
-## Whenever a new-line is encountered, the column gets reset to 0, and
-## the line gets incremented.
-## It operates recursively in order to produce the longest continuous
-## chunk of white-space.
-(def: (space^ where)
-  (-> Cursor (l.Lexer [Cursor Text]))
-  (p.either (do p.Monad
-              [content (l.many (l.one-of white-space))]
-              (wrap [(update@ #.column (n/+ (text.size content)) where)
-                     content]))
-            ## New-lines must be handled as a separate case to ensure line
-            ## information is handled properly.
-            (do p.Monad
-              [content (l.many (l.one-of new-line))]
-              (wrap [(|> where
-                         (update@ #.line (n/+ (text.size content)))
-                         (set@ #.column +0))
-                     content]))
-            ))
-
-## Single-line comments can start anywhere, but only go up to the
-## next new-line.
-(def: (single-line-comment^ where)
-  (-> Cursor (l.Lexer [Cursor Text]))
-  (do p.Monad
-    [_ (l.this "##")
-     comment (l.some (l.none-of new-line))
-     _ (l.this new-line)]
-    (wrap [(|> where
-               (update@ #.line inc)
-               (set@ #.column +0))
-           comment])))
-
-## This is just a helper parser to find text which doesn't run into
-## any special character sequences for multi-line comments.
-(def: comment-bound^
-  (l.Lexer Any)
-  ($_ p.either
-      (l.this new-line)
-      (l.this ")#")
-      (l.this "#(")))
-
-## Multi-line comments are bounded by #( these delimiters, #(and, they may
-## also be nested)# )#.
-## Multi-line comment syntax must be balanced.
-## That is, any nested comment must have matched delimiters.
-## Unbalanced comments ought to be rejected as invalid code.
-(def: (multi-line-comment^ where)
-  (-> Cursor (l.Lexer [Cursor Text]))
-  (do p.Monad
-    [_ (l.this "#(")]
-    (loop [comment ""
-           where (update@ #.column (n/+ +2) where)]
-      ($_ p.either
-          ## These are normal chunks of commented text.
-          (do @
-            [chunk (l.many (l.not comment-bound^))]
-            (recur (format comment chunk)
-                   (|> where
-                       (update@ #.column (n/+ (text.size chunk))))))
-          ## This is a special rule to handle new-lines within
-          ## comments properly.
-          (do @
-            [_ (l.this new-line)]
-            (recur (format comment new-line)
-                   (|> where
-                       (update@ #.line inc)
-                       (set@ #.column +0))))
-          ## This is the rule for handling nested sub-comments.
-          ## Ultimately, the whole comment is just treated as text
-          ## (the comment must respect the syntax structure, but the
-          ## output produced is just a block of text).
-          ## That is why the sub-comment is covered in delimiters
-          ## and then appended to the rest of the comment text.
-          (do @
-            [[sub-where sub-comment] (multi-line-comment^ where)]
-            (recur (format comment "#(" sub-comment ")#")
-                   sub-where))
-          ## Finally, this is the rule for closing the comment.
-          (do @
-            [_ (l.this ")#")]
-            (wrap [(update@ #.column (n/+ +2) where)
-                   comment]))
-          ))))
-
-## This is the only parser that should be used directly by other
-## parsers, since all comments must be treated as either being
-## single-line or multi-line.
-## That is, there is no syntactic rule prohibiting one type of comment
-## from being used in any situation (alternatively, forcing one type
-## of comment to be the only usable one).
-(def: (comment^ where)
-  (-> Cursor (l.Lexer [Cursor Text]))
-  (p.either (single-line-comment^ where)
-            (multi-line-comment^ where)))
-
-## To simplify parsing, I remove any left-padding that an Code token
-## may have prior to parsing the token itself.
-## Left-padding is assumed to be either white-space or a comment.
-## The cursor gets updated, but the padding gets ignored.
-(def: (left-padding^ where)
-  (-> Cursor (l.Lexer Cursor))
-  ($_ p.either
-      (do p.Monad
-        [[where comment] (comment^ where)]
-        (left-padding^ where))
-      (do p.Monad
-        [[where white-space] (space^ where)]
-        (left-padding^ where))
-      (:: p.Monad wrap where)))
-
-## Escaped character sequences follow the usual syntax of
-## back-slash followed by a letter (e.g. \n).
-## Unicode escapes are possible, with hexadecimal sequences between 1
-## and 4 characters long (e.g. \u12aB).
-## Escaped characters may show up in Char and Text literals.
-(def: escaped-char^
-  (l.Lexer [Nat Text])
-  (p.after (l.this "\\")
-           (do p.Monad
-             [code l.any]
-             (case code
-               ## Handle special cases.
-               "t"  (wrap [+2 "\t"])
-               "v"  (wrap [+2 "\v"])
-               "b"  (wrap [+2 "\b"])
-               "n"  (wrap [+2 "\n"])
-               "r"  (wrap [+2 "\r"])
-               "f"  (wrap [+2 "\f"])
-               "\"" (wrap [+2 "\""])
-               "\\" (wrap [+2 "\\"])
-
-               ## Handle unicode escapes.
-               "u"
-               (do p.Monad
-                 [code (l.between +1 +4 l.hexadecimal)]
-                 (wrap (case (|> code (format "+") (:: number.Hex@Codec decode))
-                         (#.Right value)
-                         [(n/+ +2 (text.size code)) (text.from-code value)]
-
-                         _
-                         (undefined))))
-
-               _
-               (p.fail (format "Invalid escaping syntax: " (%t code)))))))
-
-## These are very simple parsers that just cut chunks of text in
-## specific shapes and then use decoders already present in the
-## standard library to actually produce the values from the literals.
-(def: rich-digit
-  (l.Lexer Text)
-  (p.either l.decimal
-            (p.after (l.this "_") (parser/wrap ""))))
-
-(def: rich-digits^
-  (l.Lexer Text)
-  (l.seq l.decimal
-         (l.some rich-digit)))
-
-(do-template [   ]
-  [(def: #export ( where)
-     (-> Cursor (l.Lexer [Cursor Code]))
-     (do p.Monad
-       [chunk ]
-       (case (::  decode chunk)
-         (#.Left error)
-         (p.fail error)
-
-         (#.Right value)
-         (wrap [(update@ #.column (n/+ (text.size chunk)) where)
-                [where ( value)]]))))]
-
-  [int #.Int
-   (l.seq (p.default "" (l.one-of "-"))
-          rich-digits^)
-   number.Codec]
-  
-  [rev #.Rev
-   (l.seq (l.one-of ".")
-          rich-digits^)
-   number.Codec]
-  )
-
-(def: (nat-char where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [_ (l.this "#\"")
-     [where' char] (: (l.Lexer [Cursor Text])
-                      ($_ p.either
-                          ## Normal text characters.
-                          (do @
-                            [normal (l.none-of "\\\"\n")]
-                            (wrap [(|> where
-                                       (update@ #.column inc))
-                                   normal]))
-                          ## Must handle escaped
-                          ## chars separately.
-                          (do @
-                            [[chars-consumed char] escaped-char^]
-                            (wrap [(|> where
-                                       (update@ #.column (n/+ chars-consumed)))
-                                   char]))))
-     _ (l.this "\"")
-     #let [char (maybe.assume (text.nth +0 char))]]
-    (wrap [(|> where'
-               (update@ #.column inc))
-           [where (#.Nat char)]])))
-
-(def: (normal-nat where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [chunk (l.seq (l.one-of "+")
-                  rich-digits^)]
-    (case (:: number.Codec decode chunk)
-      (#.Left error)
-      (p.fail error)
-
-      (#.Right value)
-      (wrap [(update@ #.column (n/+ (text.size chunk)) where)
-             [where (#.Nat value)]]))))
-
-(def: #export (nat where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (p.either (normal-nat where)
-            (nat-char where)))
-
-(def: (normal-frac where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [chunk ($_ l.seq
-               (p.default "" (l.one-of "-"))
-               rich-digits^
-               (l.one-of ".")
-               rich-digits^
-               (p.default ""
-                          ($_ l.seq
-                              (l.one-of "eE")
-                              (p.default "" (l.one-of "+-"))
-                              rich-digits^)))]
-    (case (:: number.Codec decode chunk)
-      (#.Left error)
-      (p.fail error)
-
-      (#.Right value)
-      (wrap [(update@ #.column (n/+ (text.size chunk)) where)
-             [where (#.Frac value)]]))))
-
-(def: frac-ratio-fragment
-  (l.Lexer Frac)
-  (<| (p.codec number.Codec)
-      (:: p.Monad map (function (_ digits)
-                                (format digits ".0")))
-      rich-digits^))
-
-(def: (ratio-frac where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [chunk ($_ l.seq
-               (p.default "" (l.one-of "-"))
-               rich-digits^
-               (l.one-of "/")
-               rich-digits^)
-     value (l.local chunk
-                    (do @
-                      [signed? (l.this? "-")
-                       numerator frac-ratio-fragment
-                       _ (l.this? "/")
-                       denominator frac-ratio-fragment
-                       _ (p.assert "Denominator cannot be 0."
-                                   (not (f/= 0.0 denominator)))]
-                      (wrap (|> numerator
-                                (f/* (if signed? -1.0 1.0))
-                                (f// denominator)))))]
-    (wrap [(update@ #.column (n/+ (text.size chunk)) where)
-           [where (#.Frac value)]])))
-
-(def: #export (frac where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (p.either (normal-frac where)
-            (ratio-frac where)))
-
-## This parser looks so complex because text in Lux can be multi-line
-## and there are rules regarding how this is handled.
-(def: #export (text where)
-  (-> Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [## Lux text "is delimited by double-quotes", as usual in most
-     ## programming languages.
-     _ (l.this "\"")
-     ## I must know what column the text body starts at (which is
-     ## always 1 column after the left-delimiting quote).
-     ## This is important because, when procesing subsequent lines,
-     ## they must all start at the same column, being left-padded with
-     ## as many spaces as necessary to be column-aligned.
-     ## This helps ensure that the formatting on the text in the
-     ## source-code matches the formatting of the Text value.
-     #let [offset-column (inc (get@ #.column where))]
-     [where' text-read] (: (l.Lexer [Cursor Text])
-                           ## I must keep track of how much of the
-                           ## text body has been read, how far the
-                           ## cursor has progressed, and whether I'm
-                           ## processing a subsequent line, or just
-                           ## processing normal text body.
-                           (loop [text-read ""
-                                  where (|> where
-                                            (update@ #.column inc))
-                                  must-have-offset? #0]
-                             (p.either (if must-have-offset?
-                                         ## If I'm at the start of a
-                                         ## new line, I must ensure the
-                                         ## space-offset is at least
-                                         ## as great as the column of
-                                         ## the text's body's column,
-                                         ## to ensure they are aligned.
-                                         (do @
-                                           [offset (l.many (l.one-of " "))
-                                            #let [offset-size (text.size offset)]]
-                                           (if (n/>= offset-column offset-size)
-                                             ## Any extra offset
-                                             ## becomes part of the
-                                             ## text's body.
-                                             (recur (|> offset
-                                                        (text.split offset-column)
-                                                        (maybe.default (undefined))
-                                                        product.right
-                                                        (format text-read))
-                                                    (|> where
-                                                        (update@ #.column (n/+ offset-size)))
-                                                    #0)
-                                             (p.fail (format "Each line of a multi-line text must have an appropriate offset!\n"
-                                                             "Expected: " (%i (.int offset-column)) " columns.\n"
-                                                             "  Actual: " (%i (.int offset-size)) " columns.\n"))))
-                                         ($_ p.either
-                                             ## Normal text characters.
-                                             (do @
-                                               [normal (l.many (l.none-of "\\\"\n"))]
-                                               (recur (format text-read normal)
-                                                      (|> where
-                                                          (update@ #.column (n/+ (text.size normal))))
-                                                      #0))
-                                             ## Must handle escaped
-                                             ## chars separately.
-                                             (do @
-                                               [[chars-consumed char] escaped-char^]
-                                               (recur (format text-read char)
-                                                      (|> where
-                                                          (update@ #.column (n/+ chars-consumed)))
-                                                      #0))
-                                             ## The text ends when it
-                                             ## reaches the right-delimiter.
-                                             (do @
-                                               [_ (l.this "\"")]
-                                               (wrap [(update@ #.column inc where)
-                                                      text-read]))))
-                                       ## If a new-line is
-                                       ## encountered, it gets
-                                       ## appended to the value and
-                                       ## the loop is alerted that the
-                                       ## next line must have an offset.
-                                       (do @
-                                         [_ (l.this new-line)]
-                                         (recur (format text-read new-line)
-                                                (|> where
-                                                    (update@ #.line inc)
-                                                    (set@ #.column +0))
-                                                #1)))))]
-    (wrap [where'
-           [where (#.Text text-read)]])))
-
-## Form and tuple syntax is mostly the same, differing only in the
-## delimiters involved.
-## They may have an arbitrary number of arbitrary Code nodes as elements.
-(do-template [   ]
-  [(def: ( where ast)
-     (-> Cursor
-         (-> Cursor (l.Lexer [Cursor Code]))
-         (l.Lexer [Cursor Code]))
-     (do p.Monad
-       [_ (l.this )
-        [where' elems] (loop [elems (: (Row Code)
-                                       row.empty)
-                              where where]
-                         (p.either (do @
-                                     [## Must update the cursor as I
-                                      ## go along, to keep things accurate.
-                                      [where' elem] (ast where)]
-                                     (recur (row.add elem elems)
-                                            where'))
-                                   (do @
-                                     [## Must take into account any
-                                      ## padding present before the
-                                      ## end-delimiter.
-                                      where' (left-padding^ where)
-                                      _ (l.this )]
-                                     (wrap [(update@ #.column inc where')
-                                            (row.to-list elems)]))))]
-       (wrap [where'
-              [where ( elems)]])))]
-
-  [form   #.Form   "(" ")"]
-  [tuple  #.Tuple  "[" "]"]
-  )
-
-## Records are almost (syntactically) the same as forms and tuples,
-## with the exception that their elements must come in pairs (as in
-## key-value pairs).
-## Semantically, though, records and tuples are just 2 different
-## representations for the same thing (a tuple).
-## In normal Lux syntax, the key position in the pair will be a tag
-## Code node, however, record Code nodes allow any Code node to occupy
-## this position, since it may be useful when processing Code syntax in
-## macros.
-(def: (record where ast)
-  (-> Cursor
-      (-> Cursor (l.Lexer [Cursor Code]))
-      (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [_ (l.this "{")
-     [where' elems] (loop [elems (: (Row [Code Code])
-                                    row.empty)
-                           where where]
-                      (p.either (do @
-                                  [[where' key] (ast where)
-                                   [where' val] (ast where')]
-                                  (recur (row.add [key val] elems)
-                                         where'))
-                                (do @
-                                  [where' (left-padding^ where)
-                                   _ (l.this "}")]
-                                  (wrap [(update@ #.column inc where')
-                                         (row.to-list elems)]))))]
-    (wrap [where'
-           [where (#.Record elems)]])))
-
-## The parts of an identifier are separated by a single mark.
-## E.g. module.name.
-## Only one such mark may be used in an identifier, since there
-## can only be 2 parts to an identifier (the module [before the
-## mark], and the name [after the mark]).
-## There are also some extra rules regarding identifier syntax,
-## encoded on the parser.
-(def: identifier-separator Text ".")
-
-## A Lux identifier is a pair of chunks of text, where the first-part
-## refers to the module that gives context to the identifier, and the
-## second part corresponds to the name of the identifier itself.
-## The module part may be absent (by being the empty text ""), but the
-## name part must always be present.
-## The rules for which characters you may use are specified in terms
-## of which characters you must avoid (to keep things as open-ended as
-## possible).
-## In particular, no white-space can be used, and neither can other
-## characters which are already used by Lux as delimiters for other
-## Code nodes (thereby reducing ambiguity while parsing).
-## Additionally, the first character in an identifier's part cannot be
-## a digit, to avoid confusion with regards to numbers.
-(def: ident-part^
-  (l.Lexer Text)
-  (do p.Monad
-    [#let [digits "0123456789"
-           delimiters (format "()[]{}#\"" identifier-separator)
-           space (format white-space new-line)
-           head-lexer (l.none-of (format digits delimiters space))
-           tail-lexer (l.some (l.none-of (format delimiters space)))]
-     head head-lexer
-     tail tail-lexer]
-    (wrap (format head tail))))
-
-(def: current-module-mark Text (format identifier-separator identifier-separator))
-
-(def: (ident^ current-module aliases)
-  (-> Text Aliases (l.Lexer [Ident Nat]))
-  ($_ p.either
-      ## When an identifier starts with 2 marks, its module is
-      ## taken to be the current-module being compiled at the moment.
-      ## This can be useful when mentioning identifiers and tags
-      ## inside quoted/templated code in macros.
-      (do p.Monad
-        [_ (l.this current-module-mark)
-         def-name ident-part^]
-        (wrap [[current-module def-name]
-               (n/+ +2 (text.size def-name))]))
-      ## If the identifier is prefixed by the mark, but no module
-      ## part, the module is assumed to be "lux" (otherwise known as
-      ## the 'prelude').
-      ## This makes it easy to refer to definitions in that module,
-      ## since it is the most fundamental module in the entire
-      ## standard library.
-      (do p.Monad
-        [_ (l.this identifier-separator)
-         def-name ident-part^]
-        (wrap [["lux" def-name]
-               (inc (text.size def-name))]))
-      ## Not all identifiers must be specified with a module part.
-      ## If that part is not provided, the identifier will be created
-      ## with the empty "" text as the module.
-      ## During program analysis, such identifiers tend to be treated
-      ## as if their context is the current-module, but this only
-      ## applies to identifiers for tags and module definitions.
-      ## Function arguments and local-variables may not be referred-to
-      ## using identifiers with module parts, so being able to specify
-      ## identifiers with empty modules helps with those use-cases.
-      (do p.Monad
-        [first-part ident-part^]
-        (p.either (do @
-                    [_ (l.this identifier-separator)
-                     second-part ident-part^]
-                    (wrap [[(|> aliases (dict.get first-part) (maybe.default first-part))
-                            second-part]
-                           ($_ n/+
-                               (text.size first-part)
-                               +1
-                               (text.size second-part))]))
-                  (wrap [["" first-part]
-                         (text.size first-part)])))))
-
-(def: #export (tag current-module aliases where)
-  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [[value length] (p.after (l.this "#")
-                             (ident^ current-module aliases))]
-    (wrap [(update@ #.column (|>> ($_ n/+ +1 length)) where)
-           [where (#.Tag value)]])))
-
-(def: #export (symbol current-module aliases where)
-  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
-  (do p.Monad
-    [[value length] (ident^ current-module aliases)]
-    (wrap [(update@ #.column (|>> (n/+ length)) where)
-           [where (case value
-                    (^template [ ]
-                      ["" ]
-                      (#.Bit ))
-                    (["#0" #0]
-                     ["#1" #1])
-                    
-                    _
-                    (#.Symbol value))]])))
-
-(exception: #export (end-of-file {module Text})
-  module)
-
-(exception: #export (unrecognized-input {[file line column] Cursor})
-  (ex.report ["File" file]
-             ["Line" (%n line)]
-             ["Column" (%n column)]))
-
-(def: (ast current-module aliases)
-  (-> Text Aliases Cursor (l.Lexer [Cursor Code]))
-  (: (-> Cursor (l.Lexer [Cursor Code]))
-     (function (ast' where)
-       (do p.Monad
-         [where (left-padding^ where)]
-         ($_ p.either
-             (form where ast')
-             (tuple where ast')
-             (record where ast')
-             (nat where)
-             (frac where)
-             (int where)
-             (rev where)
-             (symbol current-module aliases where)
-             (tag current-module aliases where)
-             (text where)
-             (do @
-               [end? l.end?]
-               (if end?
-                 (p.fail (ex.construct end-of-file current-module))
-                 (p.fail (ex.construct unrecognized-input where))))
-             )))))
-
-(def: #export (read current-module aliases [where offset source])
-  (-> Text Aliases Source (e.Error [Source Code]))
-  (case (p.run [offset source] (ast current-module aliases where))
-    (#e.Error error)
-    (#e.Error error)
-
-    (#e.Success [[offset' remaining] [where' output]])
-    (#e.Success [[where' offset' remaining] output])))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 5c359f26b..50d9ec2bc 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -17,7 +17,8 @@
     ["." binary (#+ Binary)]]
    ["." io (#+ Process)]
    [host (#+ import:)]
-   ["." language/host]])
+   [compiler
+    ["." host]]])
 
 (type: #export File Text)
 
@@ -101,7 +102,7 @@
   (ex.report ["Instant" (%instant instant)]
              ["File" file]))
 
-(`` (for {(~~ (static language/host.jvm))
+(`` (for {(~~ (static host.jvm))
           (as-is (import: #long java/io/File
                    (new [String])
                    (exists [] #io #try boolean)
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux
new file mode 100644
index 000000000..fd516d048
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux
@@ -0,0 +1,198 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." text ("text/." Equivalence)]
+    [collection
+     ["." list ("list/." Monad)]
+     ["." set]]]
+   [math
+    ["r" random ("random/." Monad)]]
+   ["." type
+    ["." check]]
+   [macro
+    ["." code]]
+   [compiler
+    [default
+     ["." phase
+      ["." analysis
+       ["." module]
+       [".A" type]
+       ["/" case]]]]]
+   test]
+  [//
+   ["_." primitive]
+   ["_." structure]])
+
+(def: (exhaustive-weaving branchings)
+  (-> (List (List Code)) (List (List Code)))
+  (case branchings
+    #.Nil
+    #.Nil
+
+    (#.Cons head+ #.Nil)
+    (list/map (|>> list) head+)
+
+    (#.Cons head+ tail++)
+    (do list.Monad
+      [tail+ (exhaustive-weaving tail++)
+       head head+]
+      (wrap (#.Cons head tail+)))))
+
+(def: #export (exhaustive-branches allow-literals? variantTC inputC)
+  (-> Bit (List [Code Code]) Code (r.Random (List Code)))
+  (case inputC
+    [_ (#.Bit _)]
+    (random/wrap (list (' #1) (' #0)))
+
+    (^template [  ]
+      [_ ( _)]
+      (if allow-literals?
+        (do r.Monad
+          [?sample (r.maybe )]
+          (case ?sample
+            (#.Some sample)
+            (do @
+              [else (exhaustive-branches allow-literals? variantTC inputC)]
+              (wrap (list& ( sample) else)))
+
+            #.None
+            (wrap (list (' _)))))
+        (random/wrap (list (' _)))))
+    ([#.Nat  r.nat          code.nat]
+     [#.Int  r.int          code.int]
+     [#.Rev  r.rev          code.rev]
+     [#.Frac r.frac         code.frac]
+     [#.Text (r.unicode +5) code.text])
+    
+    (^ [_ (#.Tuple (list))])
+    (random/wrap (list (' [])))
+
+    (^ [_ (#.Record (list))])
+    (random/wrap (list (' {})))
+
+    [_ (#.Tuple members)]
+    (do r.Monad
+      [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
+      (wrap (|> member-wise-patterns
+                exhaustive-weaving
+                (list/map code.tuple))))
+
+    [_ (#.Record kvs)]
+    (do r.Monad
+      [#let [ks (list/map product.left kvs)
+             vs (list/map product.right kvs)]
+       member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
+      (wrap (|> member-wise-patterns
+                exhaustive-weaving
+                (list/map (|>> (list.zip2 ks) code.record)))))
+
+    (^ [_ (#.Form (list [_ (#.Tag _)] _))])
+    (do r.Monad
+      [bundles (monad.map @
+                          (function (_ [_tag _code])
+                            (do @
+                              [v-branches (exhaustive-branches allow-literals? variantTC _code)]
+                              (wrap (list/map (function (_ pattern) (` ((~ _tag) (~ pattern))))
+                                              v-branches))))
+                          variantTC)]
+      (wrap (list/join bundles)))
+
+    _
+    (random/wrap (list))
+    ))
+
+(def: #export (input variant-tags record-tags primitivesC)
+  (-> (List Code) (List Code) (List Code) (r.Random Code))
+  (r.rec
+   (function (_ input)
+     ($_ r.either
+         (random/map product.right _primitive.primitive)
+         (do r.Monad
+           [choice (|> r.nat (:: @ map (n/% (list.size variant-tags))))
+            #let [choiceT (maybe.assume (list.nth choice variant-tags))
+                  choiceC (maybe.assume (list.nth choice primitivesC))]]
+           (wrap (` ((~ choiceT) (~ choiceC)))))
+         (do r.Monad
+           [size (|> r.nat (:: @ map (n/% +3)))
+            elems (r.list size input)]
+           (wrap (code.tuple elems)))
+         (random/wrap (code.record (list.zip2 record-tags primitivesC)))
+         ))))
+
+(def: (branch body pattern)
+  (-> Code Code [Code Code])
+  [pattern body])
+
+(context: "Pattern-matching."
+  ## #seed +9253409297339902486
+  ## #seed +3793366152923578600
+  (<| (seed +5004137551292836565)
+      ## (times +100)
+      (do @
+        [module-name (r.unicode +5)
+         variant-name (r.unicode +5)
+         record-name (|> (r.unicode +5) (r.filter (|>> (text/= variant-name) not)))
+         size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         variant-tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
+         record-tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
+         primitivesTC (r.list size _primitive.primitive)
+         #let [primitivesT (list/map product.left primitivesTC)
+               primitivesC (list/map product.right primitivesTC)
+               code-tag (|>> [module-name] code.tag)
+               variant-tags+ (list/map code-tag variant-tags)
+               record-tags+ (list/map code-tag record-tags)
+               variantTC (list.zip2 variant-tags+ primitivesC)]
+         inputC (input variant-tags+ record-tags+ primitivesC)
+         [outputT outputC] _primitive.primitive
+         [heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not)
+                                                   _primitive.primitive)
+         exhaustive-patterns (exhaustive-branches #1 variantTC inputC)
+         redundant-patterns (exhaustive-branches #0 variantTC inputC)
+         redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns))))
+         heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns))))
+         #let [exhaustive-branchesC (list/map (branch outputC)
+                                              exhaustive-patterns)
+               non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC))
+                                                   exhaustive-branchesC)
+               redundant-branchesC (<| (list/map (branch outputC))
+                                       list.concat
+                                       (list (list.take redundancy-idx redundant-patterns)
+                                             (list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
+                                             (list.drop redundancy-idx redundant-patterns)))
+               heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
+                                                          (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
+                                                                  [_pattern heterogeneousC]))
+                                                          (list.drop (inc heterogeneous-idx) exhaustive-branchesC)))
+               analyse-pm (|>> (/.case _primitive.analyse inputC)
+                               (typeA.with-type outputT)
+                               analysis.with-scope
+                               (do phase.Monad
+                                 [_ (module.declare-tags variant-tags #0
+                                                         (#.Named [module-name variant-name]
+                                                                  (type.variant primitivesT)))
+                                  _ (module.declare-tags record-tags #0
+                                                         (#.Named [module-name record-name]
+                                                                  (type.tuple primitivesT)))])
+                               (module.with-module +0 module-name))]]
+        ($_ seq
+            (test "Will reject empty pattern-matching (no branches)."
+                  (|> (analyse-pm (list))
+                      _structure.check-fails))
+            (test "Can analyse exhaustive pattern-matching."
+                  (|> (analyse-pm exhaustive-branchesC)
+                      _structure.check-succeeds))
+            (test "Will reject non-exhaustive pattern-matching."
+                  (|> (analyse-pm non-exhaustive-branchesC)
+                      _structure.check-fails))
+            (test "Will reject redundant pattern-matching."
+                  (|> (analyse-pm redundant-branchesC)
+                      _structure.check-fails))
+            (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
+                  (|> (analyse-pm heterogeneous-branchesC)
+                      _structure.check-fails)))
+        )))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux
new file mode 100644
index 000000000..b5140f782
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux
@@ -0,0 +1,120 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["e" error]
+    ["." maybe]
+    ["." product]
+    [text ("text/." Equivalence)
+     format]
+    [collection
+     ["." list ("list/." Functor)]]]
+   [math
+    ["r" random]]
+   ["." type]
+   ["." macro
+    ["." code]]
+   [compiler
+    ["." default
+     ["." reference]
+     ["." init]
+     ["." phase
+      ["." analysis (#+ Analysis Operation)
+       [".A" type]
+       ["." expression]
+       ["/" function]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [//
+   ["_." primitive]
+   ["_." structure]])
+
+(def: analyse (expression.analyser (:coerce default.Eval [])))
+
+(def: (check-apply expectedT num-args analysis)
+  (-> Type Nat (Operation Analysis) Bit)
+  (|> analysis
+      (typeA.with-type expectedT)
+      (phase.run [analysisE.bundle (init.compiler [])])
+      (case> (#e.Success applyA)
+             (let [[funcA argsA] (analysis.application applyA)]
+               (n/= num-args (list.size argsA)))
+
+             (#e.Error error)
+             #0)))
+
+(context: "Function definition."
+  (<| (times +100)
+      (do @
+        [func-name (r.unicode +5)
+         arg-name (|> (r.unicode +5) (r.filter (|>> (text/= func-name) not)))
+         [outputT outputC] _primitive.primitive
+         [inputT _] _primitive.primitive
+         #let [g!arg (code.local-symbol arg-name)]]
+        ($_ seq
+            (test "Can analyse function."
+                  (and (|> (typeA.with-type (All [a] (-> a outputT))
+                             (/.function ..analyse func-name arg-name outputC))
+                           _structure.check-succeeds)
+                       (|> (typeA.with-type (All [a] (-> a a))
+                             (/.function ..analyse func-name arg-name g!arg))
+                           _structure.check-succeeds)))
+            (test "Generic functions can always be specialized."
+                  (and (|> (typeA.with-type (-> inputT outputT)
+                             (/.function ..analyse func-name arg-name outputC))
+                           _structure.check-succeeds)
+                       (|> (typeA.with-type (-> inputT inputT)
+                             (/.function ..analyse func-name arg-name g!arg))
+                           _structure.check-succeeds)))
+            (test "The function's name is bound to the function's type."
+                  (|> (typeA.with-type (Rec self (-> inputT self))
+                        (/.function ..analyse func-name arg-name (code.local-symbol func-name)))
+                      _structure.check-succeeds))
+            ))))
+
+(context: "Function application."
+  (<| (times +100)
+      (do @
+        [full-args (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         partial-args (|> r.nat (:: @ map (n/% full-args)))
+         var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max +1))))
+         inputsTC (r.list full-args _primitive.primitive)
+         #let [inputsT (list/map product.left inputsTC)
+               inputsC (list/map product.right inputsTC)]
+         [outputT outputC] _primitive.primitive
+         #let [funcT (type.function inputsT outputT)
+               partialT (type.function (list.drop partial-args inputsT) outputT)
+               varT (#.Parameter +1)
+               polyT (<| (type.univ-q +1)
+                         (type.function (list.concat (list (list.take var-idx inputsT)
+                                                           (list varT)
+                                                           (list.drop (inc var-idx) inputsT))))
+                         varT)
+               poly-inputT (maybe.assume (list.nth var-idx inputsT))
+               partial-poly-inputsT (list.drop (inc var-idx) inputsT)
+               partial-polyT1 (<| (type.function partial-poly-inputsT)
+                                  poly-inputT)
+               partial-polyT2 (<| (type.univ-q +1)
+                                  (type.function (#.Cons varT partial-poly-inputsT))
+                                  varT)
+               dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local +1)))]]
+        ($_ seq
+            (test "Can analyse monomorphic type application."
+                  (|> (/.apply ..analyse funcT dummy-function inputsC)
+                      (check-apply outputT full-args)))
+            (test "Can partially apply functions."
+                  (|> (/.apply ..analyse funcT dummy-function (list.take partial-args inputsC))
+                      (check-apply partialT partial-args)))
+            (test "Can apply polymorphic functions."
+                  (|> (/.apply ..analyse polyT dummy-function inputsC)
+                      (check-apply poly-inputT full-args)))
+            (test "Polymorphic partial application propagates found type-vars."
+                  (|> (/.apply ..analyse polyT dummy-function (list.take (inc var-idx) inputsC))
+                      (check-apply partial-polyT1 (inc var-idx))))
+            (test "Polymorphic partial application preserves quantification for type-vars."
+                  (|> (/.apply ..analyse polyT dummy-function (list.take var-idx inputsC))
+                      (check-apply partial-polyT2 var-idx)))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux
new file mode 100644
index 000000000..ce34ff887
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux
@@ -0,0 +1,93 @@
+(.module:
+  [lux (#- primitive)
+   [control
+    [monad (#+ do)]
+    pipe
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["e" error]
+    [text
+     format]]
+   [math
+    ["r" random ("random/." Monad)]]
+   [".L" type ("type/." Equivalence)]
+   [macro
+    ["." code]]
+   [compiler
+    ["." default
+     ["." init]
+     ["." phase
+      ["." analysis (#+ Analysis Operation)
+       [".A" type]
+       ["." expression]]
+      [extension
+       [".E" analysis]]]]]
+   test])
+
+(def: #export analyse (expression.analyser (:coerce default.Eval [])))
+
+(def: unit
+  (r.Random Code)
+  (random/wrap (' [])))
+
+(def: #export primitive
+  (r.Random [Type Code])
+  (`` ($_ r.either
+          (~~ (do-template [  ]
+                [(r.seq (random/wrap ) (random/map  ))]
+
+                [Any  code.tuple (r.list +0 ..unit)]
+                [Bit code.bit  r.bit]
+                [Nat  code.nat   r.nat]
+                [Int  code.int   r.int]
+                [Rev  code.rev   r.rev]
+                [Frac code.frac  r.frac]
+                [Text code.text  (r.unicode +5)]
+                )))))
+
+(exception: (wrong-inference {expected Type} {inferred Type})
+  (ex.report ["Expected" (%type expected)]
+             ["Inferred" (%type inferred)]))
+
+(def: (infer-primitive expected-type analysis)
+  (-> Type (Operation Analysis) (e.Error Analysis))
+  (|> analysis
+      typeA.with-inference
+      (phase.run [analysisE.bundle (init.compiler [])])
+      (case> (#e.Success [inferred-type output])
+             (if (is? expected-type inferred-type)
+               (#e.Success output)
+               (ex.throw wrong-inference [expected-type inferred-type]))
+
+             (#e.Error error)
+             (#e.Error error))))
+
+(context: "Primitives"
+  ($_ seq
+      (test "Can analyse unit."
+            (|> (infer-primitive Any (..analyse (' [])))
+                (case> (^ (#e.Success (#analysis.Primitive (#analysis.Unit output))))
+                       (is? [] output)
+
+                       _
+                       #0)))
+      (<| (times +100)
+          (`` ($_ seq
+                  (~~ (do-template [    ]
+                        [(do @
+                           [sample ]
+                           (test (format "Can analyse "  ".")
+                                 (|> (infer-primitive  (..analyse ( sample)))
+                                     (case> (#e.Success (#analysis.Primitive ( output)))
+                                            (is? sample output)
+
+                                            _
+                                            #0))))]
+
+                        ["bit"  Bit  #analysis.Bit  r.bit  code.bit]
+                        ["nat"  Nat  #analysis.Nat  r.nat  code.nat]
+                        ["int"  Int  #analysis.Int  r.int  code.int]
+                        ["rev"  Rev  #analysis.Rev  r.rev  code.rev]
+                        ["frac" Frac #analysis.Frac r.frac code.frac]
+                        ["text" Text #analysis.Text (r.unicode +5) code.text]
+                        )))))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux
new file mode 100644
index 000000000..70679e22a
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux
@@ -0,0 +1,308 @@
+(.module:
+  [lux #*
+   [io]
+   [control
+    [monad (#+ do)]
+    pipe]
+   [concurrency
+    ["." atom]]
+   [data
+    ["e" error]
+    ["." product]
+    [text
+     format]]
+   [math
+    ["r" random]]
+   [type ("type/." Equivalence)]
+   [macro
+    ["." code]]
+   [compiler
+    [default
+     ["." init]
+     ["." phase
+      [analysis
+       ["." scope]
+       [".A" type]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [///
+   ["_." primitive]])
+
+(do-template [  ]
+  [(def: ( procedure params output-type)
+     (-> Text (List Code) Type Bit)
+     (|> (scope.with-scope ""
+           (typeA.with-type output-type
+             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
+         (phase.run [analysisE.bundle (init.compiler [])])
+         (case> (#e.Success _)
+                
+
+                (#e.Error error)
+                )))]
+
+  [check-success+ #1 #0]
+  [check-failure+ #0 #1]
+  )
+
+(context: "Lux procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         [antiT antiC] (|> _primitive.primitive
+                           (r.filter (|>> product.left (type/= primT) not)))]
+        ($_ seq
+            (test "Can test for reference equality."
+                  (check-success+ "lux is" (list primC primC) Bit))
+            (test "Reference equality must be done with elements of the same type."
+                  (check-failure+ "lux is" (list primC antiC) Bit))
+            (test "Can 'try' risky IO computations."
+                  (check-success+ "lux try"
+                                  (list (` ([(~' _) (~' _)] (~ primC))))
+                                  (type (Either Text primT))))
+            ))))
+
+(context: "Bit procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.nat (:: @ map code.nat))
+         signedC (|> r.int (:: @ map code.int))
+         paramC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can perform bit 'and'."
+                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
+            (test "Can perform bit 'or'."
+                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
+            (test "Can perform bit 'xor'."
+                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the left."
+                  (check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the right."
+                  (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
+            (test "Can shift signed bit pattern to the right."
+                  (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
+            ))))
+
+(context: "Int procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.int (:: @ map code.int))
+         paramC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can add integers."
+                  (check-success+ "lux int +" (list subjectC paramC) Int))
+            (test "Can subtract integers."
+                  (check-success+ "lux int -" (list subjectC paramC) Int))
+            (test "Can multiply integers."
+                  (check-success+ "lux int *" (list subjectC paramC) Int))
+            (test "Can divide integers."
+                  (check-success+ "lux int /" (list subjectC paramC) Int))
+            (test "Can calculate remainder of integers."
+                  (check-success+ "lux int %" (list subjectC paramC) Int))
+            (test "Can test equivalence of integers."
+                  (check-success+ "lux int =" (list subjectC paramC) Bit))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) Bit))
+            (test "Can convert integer to fraction."
+                  (check-success+ "lux int to-frac" (list subjectC) Frac))
+            (test "Can convert integer to text."
+                  (check-success+ "lux int char" (list subjectC) Text))
+            ))))
+
+(context: "Frac procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))
+         encodedC (|> (r.unicode +5) (:: @ map code.text))]
+        ($_ seq
+            (test "Can add frac numbers."
+                  (check-success+ "lux frac +" (list subjectC paramC) Frac))
+            (test "Can subtract frac numbers."
+                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
+            (test "Can multiply frac numbers."
+                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
+            (test "Can divide frac numbers."
+                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
+            (test "Can calculate remainder of frac numbers."
+                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
+            (test "Can test equivalence of frac numbers."
+                  (check-success+ "lux frac =" (list subjectC paramC) Bit))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) Bit))
+            (test "Can obtain minimum frac number."
+                  (check-success+ "lux frac min" (list) Frac))
+            (test "Can obtain maximum frac number."
+                  (check-success+ "lux frac max" (list) Frac))
+            (test "Can obtain smallest frac number."
+                  (check-success+ "lux frac smallest" (list) Frac))
+            (test "Can convert frac number to integer."
+                  (check-success+ "lux frac to-int" (list subjectC) Int))
+            (test "Can convert frac number to text."
+                  (check-success+ "lux frac encode" (list subjectC) Text))
+            (test "Can convert text to frac number."
+                  (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
+            ))))
+
+(context: "Text procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> (r.unicode +5) (:: @ map code.text))
+         paramC (|> (r.unicode +5) (:: @ map code.text))
+         replacementC (|> (r.unicode +5) (:: @ map code.text))
+         fromC (|> r.nat (:: @ map code.nat))
+         toC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can test text equivalence."
+                  (check-success+ "lux text =" (list subjectC paramC) Bit))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) Bit))
+            (test "Can concatenate one text to another."
+                  (check-success+ "lux text concat" (list subjectC paramC) Text))
+            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
+                  (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
+            (test "Can query the size/length of a text."
+                  (check-success+ "lux text size" (list subjectC) Nat))
+            (test "Can obtain the character code of a text at a given index."
+                  (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat))))
+            (test "Can clip a piece of text between 2 indices."
+                  (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text))))
+            ))))
+
+(context: "Array procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [arrayT (type (Array elemT))
+               g!array (code.local-symbol var-name)
+               array-operation (function (_ output-type code)
+                                 (|> (scope.with-scope ""
+                                       (scope.with-local [var-name arrayT]
+                                         (typeA.with-type output-type
+                                           (_primitive.analyse code))))
+                                     (phase.run [analysisE.bundle (init.compiler [])])
+                                     (case> (#e.Success _)
+                                            #1
+
+                                            (#e.Error error)
+                                            #0)))]]
+        ($_ seq
+            (test "Can create arrays."
+                  (check-success+ "lux array new" (list sizeC) arrayT))
+            (test "Can get a value inside an array."
+                  (array-operation (type (Maybe elemT))
+                                   (` ("lux array get" (~ g!array) (~ idxC)))))
+            (test "Can put a value inside an array."
+                  (array-operation arrayT
+                                   (` ("lux array put" (~ g!array) (~ idxC) (~ elemC)))))
+            (test "Can remove a value from an array."
+                  (array-operation arrayT
+                                   (` ("lux array remove" (~ g!array) (~ idxC)))))
+            (test "Can query the size of an array."
+                  (array-operation Nat
+                                   (` ("lux array size" (~ g!array)))))
+            ))))
+
+(context: "Math procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))]
+        (`` ($_ seq
+                (~~ (do-template [ ]
+                      [(test (format "Can calculate "  ".")
+                             (check-success+  (list subjectC) Frac))]
+
+                      ["lux math cos" "cosine"]
+                      ["lux math sin" "sine"]
+                      ["lux math tan" "tangent"]
+                      ["lux math acos" "inverse/arc cosine"]
+                      ["lux math asin" "inverse/arc sine"]
+                      ["lux math atan" "inverse/arc tangent"]
+                      ["lux math cosh" "hyperbolic cosine"]
+                      ["lux math sinh" "hyperbolic sine"]
+                      ["lux math tanh" "hyperbolic tangent"]
+                      ["lux math exp" "exponentiation"]
+                      ["lux math log" "logarithm"]
+                      ["lux math ceil" "ceiling"]
+                      ["lux math floor" "floor"]
+                      ["lux math round" "rounding"]))
+                (~~ (do-template [ ]
+                      [(test (format "Can calculate "  ".")
+                             (check-success+  (list subjectC paramC) Frac))]
+
+                      ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
+                      ["lux math pow" "power"])))))))
+
+(context: "Atom procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [atomT (type (atom.Atom elemT))]]
+        ($_ seq
+            (test "Can create atomic reference."
+                  (check-success+ "lux atom new" (list elemC) atomT))
+            (test "Can read the value of an atomic reference."
+                  (|> (scope.with-scope ""
+                        (scope.with-local [var-name atomT]
+                          (typeA.with-type elemT
+                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (#e.Success _)
+                             #1
+
+                             (#e.Error _)
+                             #0)))
+            (test "Can swap the value of an atomic reference."
+                  (|> (scope.with-scope ""
+                        (scope.with-local [var-name atomT]
+                          (typeA.with-type Bit
+                            (_primitive.analyse (` ("lux atom compare-and-swap"
+                                                    (~ (code.symbol ["" var-name]))
+                                                    (~ elemC)
+                                                    (~ elemC)))))))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (#e.Success _)
+                             #1
+
+                             (#e.Error _)
+                             #0)))
+            ))))
+
+(context: "Process procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         timeC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can query the level of concurrency."
+                  (check-success+ "lux process parallelism-level" (list) Nat))
+            (test "Can schedule an IO computation to run concurrently at some future time."
+                  (check-success+ "lux process schedule"
+                                  (list timeC
+                                        (` ([(~' _) (~' _)] (~ primC))))
+                                  Any))
+            ))))
+
+(context: "IO procedures"
+  (<| (times +100)
+      (do @
+        [logC (|> (r.unicode +5) (:: @ map code.text))
+         exitC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io log" (list logC) Any))
+            (test "Can throw a run-time error."
+                  (check-success+ "lux io error" (list logC) Nothing))
+            (test "Can exit the program."
+                  (check-success+ "lux io exit" (list exitC) Nothing))
+            (test "Can query the current time (as milliseconds since epoch)."
+                  (check-success+ "lux io current-time" (list) Int))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux
new file mode 100644
index 000000000..6a103d155
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux
@@ -0,0 +1,109 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["e" error]
+    [ident ("ident/." Equivalence)]
+    [text ("text/." Equivalence)]]
+   [math
+    ["r" random]]
+   [type ("type/." Equivalence)]
+   [macro
+    ["." code]]
+   [compiler
+    ["." default
+     ["." reference]
+     ["." init]
+     ["." phase
+      ["." analysis
+       ["." scope]
+       ["." module]
+       [".A" type]
+       ["." expression]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [//
+   ["_." primitive]])
+
+(def: analyse (expression.analyser (:coerce default.Eval [])))
+
+(type: Check (-> (e.Error Any) Bit))
+
+(do-template [  ]
+  [(def: 
+     Check
+     (|>> (case> (#e.Success _)
+                 
+
+                 (#e.Error _)
+                 )))]
+
+  [success? #1 #0]
+  [failure? #0 #1]
+  )
+
+(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
+  (-> Text [Bit Text] [Bit Text] Check Bit)
+  (|> (do phase.Monad
+        [_ (module.with-module +0 def-module
+             (module.define var-name [Any
+                                      (if export?
+                                        (' {#.export? #1})
+                                        (' {}))
+                                      []]))]
+        (module.with-module +0 dependent-module
+          (do @
+            [_ (if import?
+                 (module.import def-module)
+                 (wrap []))]
+            (typeA.with-inference
+              (..analyse (code.symbol [def-module var-name]))))))
+      (phase.run [analysisE.bundle (init.compiler [])])
+      check!))
+
+(context: "References"
+  (<| (times +100)
+      (do @
+        [[expectedT _] _primitive.primitive
+         def-module (r.unicode +5)
+         scope-name (r.unicode +5)
+         var-name (r.unicode +5)
+         dependent-module (|> (r.unicode +5)
+                              (r.filter (|>> (text/= def-module) not)))]
+        ($_ seq
+            (test "Can analyse variable."
+                  (|> (scope.with-scope scope-name
+                        (scope.with-local [var-name expectedT]
+                          (typeA.with-inference
+                            (..analyse (code.local-symbol var-name)))))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (^ (#e.Success [inferredT (#analysis.Reference (reference.local var))]))
+                             (and (type/= expectedT inferredT)
+                                  (n/= +0 var))
+
+                             _
+                             #0)))
+            (test "Can analyse definition (in the same module)."
+                  (let [def-name [def-module var-name]]
+                    (|> (do phase.Monad
+                          [_ (module.define var-name [expectedT (' {}) []])]
+                          (typeA.with-inference
+                            (..analyse (code.symbol def-name))))
+                        (module.with-module +0 def-module)
+                        (phase.run [analysisE.bundle (init.compiler [])])
+                        (case> (^ (#e.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))]))
+                               (and (type/= expectedT inferredT)
+                                    (ident/= def-name constant-name))
+
+                               _
+                               #0))))
+            (test "Can analyse definition (if exported from imported module)."
+                  (reach-test var-name [#1 def-module] [#1 dependent-module] success?))
+            (test "Cannot analyse definition (if not exported from imported module)."
+                  (reach-test var-name [#0 def-module] [#1 dependent-module] failure?))
+            (test "Cannot analyse definition (if exported from non-imported module)."
+                  (reach-test var-name [#1 def-module] [#0 dependent-module] failure?))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux
new file mode 100644
index 000000000..eb517be72
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux
@@ -0,0 +1,299 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    [bit ("bit/." Equivalence)]
+    ["e" error]
+    ["." product]
+    ["." maybe]
+    ["." text]
+    [collection
+     ["." list ("list/." Functor)]
+     ["." set]]]
+   [math
+    ["r" random]]
+   ["." type ("type/." Equivalence)
+    ["." check]]
+   [macro
+    ["." code]]
+   [compiler
+    ["." default
+     ["." init]
+     ["." phase
+      ["." analysis (#+ Analysis Variant Tag Operation)
+       ["." module]
+       [".A" type]
+       ["/" structure]
+       ["." expression]]
+      [extension
+       [".E" analysis]]]]]
+   test]
+  [//
+   ["_." primitive]])
+
+(def: analyse (expression.analyser (:coerce default.Eval [])))
+
+(do-template [  ]
+  [(def: #export 
+     (All [a] (-> (Operation a) Bit))
+     (|>> (phase.run [analysisE.bundle (init.compiler [])])
+          (case> (#e.Success _)
+                 
+
+                 _
+                 )))]
+
+  [check-succeeds #1 #0]
+  [check-fails    #0 #1]
+  )
+
+(def: (check-sum' size tag variant)
+  (-> Nat Tag (Variant Analysis) Bit)
+  (let [variant-tag (if (get@ #analysis.right? variant)
+                      (inc (get@ #analysis.lefts variant))
+                      (get@ #analysis.lefts variant))]
+    (|> size dec (n/= tag)
+        (bit/= (get@ #analysis.right? variant))
+        (and (n/= tag variant-tag)))))
+
+(def: (check-sum type size tag analysis)
+  (-> Type Nat Tag (Operation Analysis) Bit)
+  (|> analysis
+      (typeA.with-type type)
+      (phase.run [analysisE.bundle (init.compiler [])])
+      (case> (^multi (#e.Success sumA)
+                     [(analysis.variant sumA)
+                      (#.Some variant)])
+             (check-sum' size tag variant)
+
+             _
+             #0)))
+
+(def: (tagged module tags type)
+  (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a])))
+  (|>> (do phase.Monad
+         [_ (module.declare-tags tags #0 type)])
+       (module.with-module +0 module)))
+
+(def: (check-variant module tags type size tag analysis)
+  (-> Text (List module.Tag) Type Nat Tag (Operation Analysis) Bit)
+  (|> analysis
+      (tagged module tags type)
+      (typeA.with-type type)
+      (phase.run [analysisE.bundle (init.compiler [])])
+      (case> (^multi (#e.Success [_ sumA])
+                     [(analysis.variant sumA)
+                      (#.Some variant)])
+             (check-sum' size tag variant)
+
+             _
+             #0)))
+
+(def: (right-size? size)
+  (-> Nat (-> Analysis Bit))
+  (|>> analysis.tuple list.size (n/= size)))
+
+(def: (check-record-inference module tags type size analysis)
+  (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit)
+  (|> analysis
+      (tagged module tags type)
+      (phase.run [analysisE.bundle (init.compiler [])])
+      (case> (#e.Success [_ productT productA])
+             (and (type/= type productT)
+                  (right-size? size productA))
+
+             _
+             #0)))
+
+(context: "Sums"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         choice (|> r.nat (:: @ map (n/% size)))
+         primitives (r.list size _primitive.primitive)
+         +choice (|> r.nat (:: @ map (n/% (inc size))))
+         [_ +valueC] _primitive.primitive
+         #let [variantT (type.variant (list/map product.left primitives))
+               [valueT valueC] (maybe.assume (list.nth choice primitives))
+               +size (inc size)
+               +primitives (list.concat (list (list.take choice primitives)
+                                              (list [(#.Parameter +1) +valueC])
+                                              (list.drop choice primitives)))
+               [+valueT +valueC] (maybe.assume (list.nth +choice +primitives))
+               +variantT (type.variant (list/map product.left +primitives))]]
+        ($_ seq
+            (test "Can analyse sum."
+                  (check-sum variantT size choice
+                             (/.sum ..analyse choice valueC)))
+            (test "Can analyse sum through bound type-vars."
+                  (|> (do phase.Monad
+                        [[_ varT] (typeA.with-env check.var)
+                         _ (typeA.with-env
+                             (check.check varT variantT))]
+                        (typeA.with-type varT
+                          (/.sum ..analyse choice valueC)))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (^multi (#e.Success sumA)
+                                     [(analysis.variant sumA)
+                                      (#.Some variant)])
+                             (check-sum' size choice variant)
+
+                             _
+                             #0)))
+            (test "Cannot analyse sum through unbound type-vars."
+                  (|> (do phase.Monad
+                        [[_ varT] (typeA.with-env check.var)]
+                        (typeA.with-type varT
+                          (/.sum ..analyse choice valueC)))
+                      check-fails))
+            (test "Can analyse sum through existential quantification."
+                  (|> (typeA.with-type (type.ex-q +1 +variantT)
+                        (/.sum ..analyse +choice +valueC))
+                      check-succeeds))
+            (test "Can analyse sum through universal quantification."
+                  (let [check-outcome (if (not (n/= choice +choice))
+                                        check-succeeds
+                                        check-fails)]
+                    (|> (typeA.with-type (type.univ-q +1 +variantT)
+                          (/.sum ..analyse +choice +valueC))
+                        check-outcome)))
+            ))))
+
+(context: "Products"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         primitives (r.list size _primitive.primitive)
+         choice (|> r.nat (:: @ map (n/% size)))
+         [_ +valueC] _primitive.primitive
+         #let [tupleT (type.tuple (list/map product.left primitives))
+               [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume)
+               +primitives (list.concat (list (list.take choice primitives)
+                                              (list [(#.Parameter +1) +valueC])
+                                              (list.drop choice primitives)))
+               +tupleT (type.tuple (list/map product.left +primitives))]]
+        ($_ seq
+            (test "Can analyse product."
+                  (|> (typeA.with-type tupleT
+                        (/.product ..analyse (list/map product.right primitives)))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (#e.Success tupleA)
+                             (right-size? size tupleA)
+
+                             _
+                             #0)))
+            (test "Can infer product."
+                  (|> (typeA.with-inference
+                        (/.product ..analyse (list/map product.right primitives)))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (#e.Success [_type tupleA])
+                             (and (type/= tupleT _type)
+                                  (right-size? size tupleA))
+
+                             _
+                             #0)))
+            (test "Can analyse pseudo-product (singleton tuple)"
+                  (|> (typeA.with-type singletonT
+                        (..analyse (` [(~ singletonC)])))
+                      check-succeeds))
+            (test "Can analyse product through bound type-vars."
+                  (|> (do phase.Monad
+                        [[_ varT] (typeA.with-env check.var)
+                         _ (typeA.with-env
+                             (check.check varT (type.tuple (list/map product.left primitives))))]
+                        (typeA.with-type varT
+                          (/.product ..analyse (list/map product.right primitives))))
+                      (phase.run [analysisE.bundle (init.compiler [])])
+                      (case> (#e.Success tupleA)
+                             (right-size? size tupleA)
+
+                             _
+                             #0)))
+            (test "Can analyse product through existential quantification."
+                  (|> (typeA.with-type (type.ex-q +1 +tupleT)
+                        (/.product ..analyse (list/map product.right +primitives)))
+                      check-succeeds))
+            (test "Cannot analyse product through universal quantification."
+                  (|> (typeA.with-type (type.univ-q +1 +tupleT)
+                        (/.product ..analyse (list/map product.right +primitives)))
+                      check-fails))
+            ))))
+
+(context: "Tagged Sums"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
+         choice (|> r.nat (:: @ map (n/% size)))
+         other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not)))
+         primitives (r.list size _primitive.primitive)
+         module-name (r.unicode +5)
+         type-name (r.unicode +5)
+         #let [varT (#.Parameter +1)
+               primitivesT (list/map product.left primitives)
+               [choiceT choiceC] (maybe.assume (list.nth choice primitives))
+               [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives))
+               variantT (type.variant primitivesT)
+               namedT (#.Named [module-name type-name] variantT)
+               named-polyT (|> (type.variant (list.concat (list (list.take choice primitivesT)
+                                                                (list varT)
+                                                                (list.drop (inc choice) primitivesT))))
+                               (type.univ-q +1)
+                               (#.Named [module-name type-name]))
+               choice-tag (maybe.assume (list.nth choice tags))
+               other-choice-tag (maybe.assume (list.nth other-choice tags))]]
+        ($_ seq
+            (test "Can infer tagged sum."
+                  (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC)
+                      (check-variant module-name tags namedT choice size)))
+            (test "Tagged sums specialize when type-vars get bound."
+                  (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC)
+                      (check-variant module-name tags named-polyT choice size)))
+            (test "Tagged sum inference retains universal quantification when type-vars are not bound."
+                  (|> (/.tagged-sum ..analyse [module-name other-choice-tag] other-choiceC)
+                      (check-variant module-name tags named-polyT other-choice size)))
+            (test "Can specialize generic tagged sums."
+                  (|> (typeA.with-type variantT
+                        (/.tagged-sum ..analyse [module-name other-choice-tag] other-choiceC))
+                      (check-variant module-name tags named-polyT other-choice size)))
+            ))))
+
+(context: "Records"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
+         primitives (r.list size _primitive.primitive)
+         module-name (r.unicode +5)
+         type-name (r.unicode +5)
+         choice (|> r.nat (:: @ map (n/% size)))
+         #let [varT (#.Parameter +1)
+               tagsC (list/map (|>> [module-name] code.tag) tags)
+               primitivesT (list/map product.left primitives)
+               primitivesC (list/map product.right primitives)
+               tupleT (type.tuple primitivesT)
+               namedT (#.Named [module-name type-name] tupleT)
+               recordC (list.zip2 tagsC primitivesC)
+               named-polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT)
+                                                              (list varT)
+                                                              (list.drop (inc choice) primitivesT))))
+                               (type.univ-q +1)
+                               (#.Named [module-name type-name]))]]
+        ($_ seq
+            (test "Can infer record."
+                  (|> (typeA.with-inference
+                        (/.record ..analyse recordC))
+                      (check-record-inference module-name tags namedT size)))
+            (test "Records specialize when type-vars get bound."
+                  (|> (typeA.with-inference
+                        (/.record ..analyse recordC))
+                      (check-record-inference module-name tags named-polyT size)))
+            (test "Can specialize generic records."
+                  (|> (do phase.Monad
+                        [recordA (typeA.with-type tupleT
+                                   (/.record ..analyse recordC))]
+                        (wrap [tupleT recordA]))
+                      (check-record-inference module-name tags named-polyT size)))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux
new file mode 100644
index 000000000..ad0d5c60a
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux
@@ -0,0 +1,88 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error ("error/." Functor)]]
+   [compiler
+    [default
+     ["." reference]
+     ["." phase
+      ["." analysis (#+ Branch Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(context: "Dummy variables."
+  (<| (times +100)
+      (do @
+        [maskedA //primitive.primitive
+         temp (|> r.nat (:: @ map (n/% +100)))
+         #let [maskA (analysis.control/case
+                      [maskedA
+                       [[(#analysis.Bind temp)
+                         (#analysis.Reference (reference.local temp))]
+                        (list)]])]]
+        (test "Dummy variables created to mask expressions get eliminated during synthesis."
+              (|> maskA
+                  expression.synthesize
+                  (phase.run [bundle.empty //.init])
+                  (error/map (//primitive.corresponds? maskedA))
+                  (error.default #0))))))
+
+(context: "Let expressions."
+  (<| (times +100)
+      (do @
+        [registerA r.nat
+         inputA //primitive.primitive
+         outputA //primitive.primitive
+         #let [letA (analysis.control/case
+                     [inputA
+                      [[(#analysis.Bind registerA)
+                        outputA]
+                       (list)]])]]
+        (test "Can detect and reify simple 'let' expressions."
+              (|> letA
+                  expression.synthesize
+                  (phase.run [bundle.empty //.init])
+                  (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
+                         (and (n/= registerA registerS)
+                              (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? outputA outputS))
+
+                         _
+                         #0))))))
+
+(context: "If expressions."
+  (<| (times +100)
+      (do @
+        [then|else r.bit
+         inputA //primitive.primitive
+         thenA //primitive.primitive
+         elseA //primitive.primitive
+         #let [thenB (: Branch
+                        [(#analysis.Simple (#analysis.Bit #1))
+                         thenA])
+               elseB (: Branch
+                        [(#analysis.Simple (#analysis.Bit #0))
+                         elseA])
+               ifA (if then|else
+                     (analysis.control/case [inputA [thenB (list elseB)]])
+                     (analysis.control/case [inputA [elseB (list thenB)]]))]]
+        (test "Can detect and reify simple 'if' expressions."
+              (|> ifA
+                  expression.synthesize
+                  (phase.run [bundle.empty //.init])
+                  (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
+                         (and (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? thenA thenS)
+                              (//primitive.corresponds? elseA elseS))
+
+                         _
+                         #0))))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux
new file mode 100644
index 000000000..2249acca1
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux
@@ -0,0 +1,175 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." error]
+    ["." number]
+    [text
+     format]
+    [collection
+     ["." list ("list/." Functor Fold)]
+     ["dict" dictionary (#+ Dictionary)]
+     ["." set]]]
+   [compiler
+    [default
+     ["." reference (#+ Variable) ("variable/." Equivalence)]
+     ["." phase
+      ["." analysis (#+ Arity Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(def: constant-function
+  (r.Random [Arity Analysis Analysis])
+  (r.rec
+   (function (_ constant-function)
+     (do r.Monad
+       [function? r.bit]
+       (if function?
+         (do @
+           [[arity bodyA predictionA] constant-function]
+           (wrap [(inc arity)
+                  (#analysis.Function (list) bodyA)
+                  predictionA]))
+         (do @
+           [predictionA //primitive.primitive]
+           (wrap [+0 predictionA predictionA])))))))
+
+(def: (pick scope-size)
+  (-> Nat (r.Random Nat))
+  (|> r.nat (:: r.Monad map (n/% scope-size))))
+
+(def: function-with-environment
+  (r.Random [Arity Analysis Variable])
+  (do r.Monad
+    [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
+     #let [indices (list.n/range +0 (dec num-locals))
+           local-env (list/map (|>> #reference.Local) indices)
+           foreign-env (list/map (|>> #reference.Foreign) indices)]
+     [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
+                                  (loop [arity +1
+                                         current-env foreign-env]
+                                    (let [current-env/size (list.size current-env)
+                                          resolver (list/fold (function (_ [idx var] resolver)
+                                                                (dict.put idx var resolver))
+                                                              (: (Dictionary Nat Variable)
+                                                                 (dict.new number.Hash))
+                                                              (list.enumerate current-env))]
+                                      (do @
+                                        [nest? r.bit]
+                                        (if nest?
+                                          (do @
+                                            [num-picks (:: @ map (n/max +1) (pick (inc current-env/size)))
+                                             picks (|> (r.set number.Hash num-picks (pick current-env/size))
+                                                       (:: @ map set.to-list))
+                                             [arity bodyA predictionA] (recur (inc arity)
+                                                                              (list/map (function (_ pick)
+                                                                                          (maybe.assume (list.nth pick current-env)))
+                                                                                        picks))
+                                             #let [picked-env (list/map (|>> #reference.Foreign) picks)]]
+                                            (wrap [arity
+                                                   (#analysis.Function picked-env bodyA)
+                                                   predictionA]))
+                                          (do @
+                                            [chosen (pick (list.size current-env))]
+                                            (wrap [arity
+                                                   (#analysis.Reference (reference.foreign chosen))
+                                                   (maybe.assume (dict.get chosen resolver))])))))))]
+    (wrap [arity
+           (#analysis.Function local-env bodyA)
+           predictionA])))
+
+(def: local-function
+  (r.Random [Arity Analysis Variable])
+  (loop [arity +0
+         nest? #1]
+    (if nest?
+      (do r.Monad
+        [nest?' r.bit
+         [arity' bodyA predictionA] (recur (inc arity) nest?')]
+        (wrap [arity'
+               (#analysis.Function (list) bodyA)
+               predictionA]))
+      (do r.Monad
+        [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
+        (wrap [arity
+               (#analysis.Reference (reference.local chosen))
+               (|> chosen (n/+ (dec arity)) #reference.Local)])))))
+
+(context: "Function definition."
+  (<| (seed +13007429814532219492)
+      ## (times +100)
+      (do @
+        [[arity//constant function//constant prediction//constant] constant-function
+         [arity//environment function//environment prediction//environment] function-with-environment
+         [arity//local function//local prediction//local] local-function]
+        ($_ seq
+            (test "Nested functions will get folded together."
+                  (|> function//constant
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity output])))
+                             (and (n/= arity//constant arity)
+                                  (//primitive.corresponds? prediction//constant output))
+                             
+                             _
+                             (n/= +0 arity//constant))))
+            (test "Folded functions provide direct access to environment variables."
+                  (|> function//environment
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
+                             (and (n/= arity//environment arity)
+                                  (variable/= prediction//environment output))
+                             
+                             _
+                             #0)))
+            (test "Folded functions properly offset local variables."
+                  (|> function//local
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
+                             (and (n/= arity//local arity)
+                                  (variable/= prediction//local output))
+                             
+                             _
+                             #0)))
+            ))))
+
+(context: "Function application."
+  (<| (times +100)
+      (do @
+        [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+         funcA //primitive.primitive
+         argsA (r.list arity //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize function application."
+                  (|> (analysis.apply [funcA argsA])
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
+                             (and (//primitive.corresponds? funcA funcS)
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 argsA argsS)))
+                             
+                             _
+                             #0)))
+            (test "Function application on no arguments just synthesizes to the function itself."
+                  (|> (analysis.apply [funcA (list)])
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (#error.Success funcS)
+                             (//primitive.corresponds? funcA funcS)
+
+                             _
+                             #0)))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux
new file mode 100644
index 000000000..4312f2bae
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux
@@ -0,0 +1,97 @@
+(.module:
+  [lux (#- primitive)
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    ["." error]
+    [text
+     format]]
+   [compiler
+    [default
+     ["." phase
+      ["." analysis (#+ Analysis)]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test])
+
+(def: #export primitive
+  (r.Random Analysis)
+  (do r.Monad
+    [primitive (: (r.Random analysis.Primitive)
+                  ($_ r.alt
+                      (wrap [])
+                      r.bit
+                      r.nat
+                      r.int
+                      r.rev
+                      r.frac
+                      (r.unicode +5)))]
+    (wrap (#analysis.Primitive primitive))))
+
+(def: #export (corresponds? analysis synthesis)
+  (-> Analysis Synthesis Bit)
+  (case [synthesis analysis]
+    [(#//.Primitive (#//.Text valueS))
+     (#analysis.Primitive (#analysis.Unit valueA))]
+    (is? valueS (:coerce Text valueA))
+    
+    [(#//.Primitive (#//.Bit valueS))
+     (#analysis.Primitive (#analysis.Bit valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Nat valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Int valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysis.Primitive (#analysis.Rev valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.F64 valueS))
+     (#analysis.Primitive (#analysis.Frac valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.Text valueS))
+     (#analysis.Primitive (#analysis.Text valueA))]
+    (is? valueS valueA)
+    
+    _
+    #0))
+
+(context: "Primitives."
+  (<| (times +100)
+      (do @
+        [|bit| r.bit
+         |nat| r.nat
+         |int| r.int
+         |rev| r.rev
+         |frac| r.frac
+         |text| (r.unicode +5)]
+        (`` ($_ seq
+                (~~ (do-template [   ]
+                      [(test (format "Can synthesize "  ".")
+                             (|> (#analysis.Primitive ( ))
+                                 expression.synthesize
+                                 (phase.run [bundle.empty //.init])
+                                 (case> (#error.Success (#//.Primitive ( value)))
+                                        (is?  value)
+
+                                        _
+                                        #0)))]
+
+                      ["unit" #analysis.Unit #//.Text //.unit]
+                      ["bit"  #analysis.Bit  #//.Bit  |bit|]
+                      ["nat"  #analysis.Nat  #//.I64  (.i64 |nat|)]
+                      ["int"  #analysis.Int  #//.I64  (.i64 |int|)]
+                      ["rev"  #analysis.Rev  #//.I64  (.i64 |rev|)]
+                      ["frac" #analysis.Frac #//.F64  |frac|]
+                      ["text" #analysis.Text #//.Text |text|])))))))
diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
new file mode 100644
index 000000000..924a4126d
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux
@@ -0,0 +1,63 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    [bit ("bit/." Equivalence)]
+    ["." product]
+    ["." error]
+    [collection
+     ["." list]]]
+   [compiler
+    [default
+     ["." phase
+      ["." analysis]
+      ["//" synthesis (#+ Synthesis)
+       ["." expression]]
+      [extension
+       ["." bundle]]]]]
+   [math
+    ["r" random]]
+   test]
+  ["." //primitive])
+
+(context: "Variants"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/+ +2))))
+         tagA (|> r.nat (:: @ map (n/% size)))
+         memberA //primitive.primitive]
+        ($_ seq
+            (test "Can synthesize variants."
+                  (|> (analysis.sum-analysis size tagA memberA)
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
+                             (let [tagS (if right?S (inc leftsS) leftsS)]
+                               (and (n/= tagA tagS)
+                                    (|> tagS (n/= (dec size)) (bit/= right?S))
+                                    (//primitive.corresponds? memberA valueS)))
+                             
+                             _
+                             #0)))
+            ))))
+
+(context: "Tuples"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         membersA (r.list size //primitive.primitive)]
+        ($_ seq
+            (test "Can synthesize tuple."
+                  (|> (analysis.product-analysis membersA)
+                      expression.synthesize
+                      (phase.run [bundle.empty //.init])
+                      (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
+                             (and (n/= size (list.size membersS))
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 membersA membersS)))
+
+                             _
+                             #0)))
+            ))))
diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux
new file mode 100644
index 000000000..42ae7f379
--- /dev/null
+++ b/stdlib/test/test/lux/compiler/default/syntax.lux
@@ -0,0 +1,248 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    [number]
+    ["e" error]
+    ["." text
+     format
+     ["l" lexer]]
+    [collection
+     ["." list]
+     ["dict" dictionary (#+ Dictionary)]]]
+   [math
+    ["r" random ("r/." Monad)]]
+   [macro
+    ["." code]]
+   [compiler
+    [default
+     ["&" syntax]]]
+   test])
+
+(def: default-cursor
+  Cursor
+  {#.module ""
+   #.line   +0
+   #.column +0})
+
+(def: ident-part^
+  (r.Random Text)
+  (do r.Monad
+    [#let [digits "0123456789"
+           delimiters "()[]{}#.\""
+           space "\t\v \n\r\f"
+           invalid-range (format digits delimiters space)
+           char-gen (|> r.nat
+                        (:: @ map (|>> (n/% +256) (n/max +1)))
+                        (r.filter (function (_ sample)
+                                    (not (text.contains? (text.from-code sample)
+                                                         invalid-range)))))]
+     size (|> r.nat (:: @ map (|>> (n/% +20) (n/max +1))))]
+    (r.text char-gen size)))
+
+(def: ident^
+  (r.Random Ident)
+  (r.seq ident-part^ ident-part^))
+
+(def: code^
+  (r.Random Code)
+  (let [numeric^ (: (r.Random Code)
+                    ($_ r.either
+                        (|> r.bit (r/map code.bit))
+                        (|> r.nat (r/map code.nat))
+                        (|> r.int (r/map code.int))
+                        (|> r.rev (r/map code.rev))
+                        (|> r.frac (r/map code.frac))))
+        textual^ (: (r.Random Code)
+                    ($_ r.either
+                        (do r.Monad
+                          [size (|> r.nat (r/map (n/% +20)))]
+                          (|> (r.unicode size) (r/map code.text)))
+                        (|> ident^ (r/map code.symbol))
+                        (|> ident^ (r/map code.tag))))
+        simple^ (: (r.Random Code)
+                   ($_ r.either
+                       numeric^
+                       textual^))]
+    (r.rec
+     (function (_ code^)
+       (let [multi^ (do r.Monad
+                      [size (|> r.nat (r/map (n/% +3)))]
+                      (r.list size code^))
+             composite^ (: (r.Random Code)
+                           ($_ r.either
+                               (|> multi^ (r/map code.form))
+                               (|> multi^ (r/map code.tuple))
+                               (do r.Monad
+                                 [size (|> r.nat (r/map (n/% +3)))]
+                                 (|> (r.list size (r.seq code^ code^))
+                                     (r/map code.record)))))]
+         (r.either simple^
+                   composite^))))))
+
+(context: "Lux code syntax."
+  (<| (times +100)
+      (do @
+        [sample code^
+         other code^]
+        ($_ seq
+            (test "Can parse Lux code."
+                  (case (&.read "" (dict.new text.Hash)
+                                [default-cursor +0 (code.to-text sample)])
+                    (#e.Error error)
+                    #0
+
+                    (#e.Success [_ parsed])
+                    (:: code.Equivalence = parsed sample)))
+            (test "Can parse Lux multiple code nodes."
+                  (case (&.read "" (dict.new text.Hash)
+                                [default-cursor +0 (format (code.to-text sample) " "
+                                                           (code.to-text other))])
+                    (#e.Error error)
+                    #0
+
+                    (#e.Success [remaining =sample])
+                    (case (&.read "" (dict.new text.Hash)
+                                  remaining)
+                      (#e.Error error)
+                      #0
+
+                      (#e.Success [_ =other])
+                      (and (:: code.Equivalence = sample =sample)
+                           (:: code.Equivalence = other =other)))))
+            ))))
+
+(context: "Frac special syntax."
+  (<| (times +100)
+      (do @
+        [numerator (|> r.nat (:: @ map (|>> (n/% +100) .int int-to-frac)))
+         denominator (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1) .int int-to-frac)))
+         signed? r.bit
+         #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 1.0)))]]
+        (test "Can parse frac ratio syntax."
+              (case (&.read "" (dict.new text.Hash)
+                            [default-cursor +0
+                             (format (if signed? "-" "")
+                                     (%i (frac-to-int numerator))
+                                     "/"
+                                     (%i (frac-to-int denominator)))])
+                (#e.Success [_ [_ (#.Frac actual)]])
+                (f/= expected actual)
+
+                _
+                #0)
+              ))))
+
+(context: "Nat special syntax."
+  (<| (times +100)
+      (do @
+        [expected (|> r.nat (:: @ map (n/% +1_000)))]
+        (test "Can parse nat char syntax."
+              (case (&.read "" (dict.new text.Hash)
+                            [default-cursor +0
+                             (format "#" (%t (text.from-code expected)) "")])
+                (#e.Success [_ [_ (#.Nat actual)]])
+                (n/= expected actual)
+
+                _
+                #0)
+              ))))
+
+(def: comment-text^
+  (r.Random Text)
+  (let [char-gen (|> r.nat (r.filter (function (_ value)
+                                       (not (or (text.space? value)
+                                                (n/= (char "#") value)
+                                                (n/= (char "(") value)
+                                                (n/= (char ")") value))))))]
+    (do r.Monad
+      [size (|> r.nat (r/map (n/% +20)))]
+      (r.text char-gen size))))
+
+(def: comment^
+  (r.Random Text)
+  (r.either (do r.Monad
+              [comment comment-text^]
+              (wrap (format "## " comment "\n")))
+            (r.rec (function (_ nested^)
+                     (do r.Monad
+                       [comment (r.either comment-text^
+                                          nested^)]
+                       (wrap (format "#( " comment " )#")))))))
+
+(context: "Multi-line text & comments."
+  (<| (seed +12137892244981970631)
+      ## (times +100)
+      (do @
+        [#let [char-gen (|> r.nat (r.filter (function (_ value)
+                                              (not (or (text.space? value)
+                                                       (n/= (char "\"") value))))))]
+         x char-gen
+         y char-gen
+         z char-gen
+         offset-size (|> r.nat (r/map (|>> (n/% +10) (n/max +1))))
+         #let [offset (text.join-with "" (list.repeat offset-size " "))]
+         sample code^
+         comment comment^
+         unbalanced-comment comment-text^]
+        ($_ seq
+            (test "Will reject invalid multi-line text."
+                  (let [bad-match (format (text.from-code x) "\n"
+                                          (text.from-code y) "\n"
+                                          (text.from-code z))]
+                    (case (&.read "" (dict.new text.Hash)
+                                  [default-cursor +0
+                                   (format "\"" bad-match "\"")])
+                      (#e.Error error)
+                      #1
+
+                      (#e.Success [_ parsed])
+                      #0)))
+            (test "Will accept valid multi-line text"
+                  (let [good-input (format (text.from-code x) "\n"
+                                           offset (text.from-code y) "\n"
+                                           offset (text.from-code z))
+                        good-output (format (text.from-code x) "\n"
+                                            (text.from-code y) "\n"
+                                            (text.from-code z))]
+                    (case (&.read "" (dict.new text.Hash)
+                                  [(|> default-cursor (update@ #.column (n/+ (dec offset-size))))
+                                   +0
+                                   (format "\"" good-input "\"")])
+                      (#e.Error error)
+                      #0
+
+                      (#e.Success [_ parsed])
+                      (:: code.Equivalence =
+                          parsed
+                          (code.text good-output)))))
+            (test "Can handle comments."
+                  (case (&.read "" (dict.new text.Hash)
+                                [default-cursor +0
+                                 (format comment (code.to-text sample))])
+                    (#e.Error error)
+                    #0
+
+                    (#e.Success [_ parsed])
+                    (:: code.Equivalence = parsed sample)))
+            (test "Will reject unbalanced multi-line comments."
+                  (and (case (&.read "" (dict.new text.Hash)
+                                     [default-cursor +0
+                                      (format "#(" "#(" unbalanced-comment ")#"
+                                              (code.to-text sample))])
+                         (#e.Error error)
+                         #1
+
+                         (#e.Success [_ parsed])
+                         #0)
+                       (case (&.read "" (dict.new text.Hash)
+                                     [default-cursor +0
+                                      (format "#(" unbalanced-comment ")#" ")#"
+                                              (code.to-text sample))])
+                         (#e.Error error)
+                         #1
+
+                         (#e.Success [_ parsed])
+                         #0)))
+            ))))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/case.lux b/stdlib/test/test/lux/language/compiler/analysis/case.lux
deleted file mode 100644
index 5956cc48e..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/case.lux
+++ /dev/null
@@ -1,197 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    ["." monad (#+ do)]
-    pipe]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." text ("text/." Equivalence)]
-    [collection
-     ["." list ("list/." Monad)]
-     ["." set]]]
-   [math
-    ["r" random ("random/." Monad)]]
-   ["." type
-    ["." check]]
-   [macro
-    ["." code]]
-   [language
-    ["." compiler
-     ["." analysis
-      ["." module]
-      [".A" type]
-      ["/" case]]]]
-   test]
-  [//
-   ["_." primitive]
-   ["_." structure]])
-
-(def: (exhaustive-weaving branchings)
-  (-> (List (List Code)) (List (List Code)))
-  (case branchings
-    #.Nil
-    #.Nil
-
-    (#.Cons head+ #.Nil)
-    (list/map (|>> list) head+)
-
-    (#.Cons head+ tail++)
-    (do list.Monad
-      [tail+ (exhaustive-weaving tail++)
-       head head+]
-      (wrap (#.Cons head tail+)))))
-
-(def: #export (exhaustive-branches allow-literals? variantTC inputC)
-  (-> Bit (List [Code Code]) Code (r.Random (List Code)))
-  (case inputC
-    [_ (#.Bit _)]
-    (random/wrap (list (' #1) (' #0)))
-
-    (^template [  ]
-      [_ ( _)]
-      (if allow-literals?
-        (do r.Monad
-          [?sample (r.maybe )]
-          (case ?sample
-            (#.Some sample)
-            (do @
-              [else (exhaustive-branches allow-literals? variantTC inputC)]
-              (wrap (list& ( sample) else)))
-
-            #.None
-            (wrap (list (' _)))))
-        (random/wrap (list (' _)))))
-    ([#.Nat  r.nat          code.nat]
-     [#.Int  r.int          code.int]
-     [#.Rev  r.rev          code.rev]
-     [#.Frac r.frac         code.frac]
-     [#.Text (r.unicode +5) code.text])
-    
-    (^ [_ (#.Tuple (list))])
-    (random/wrap (list (' [])))
-
-    (^ [_ (#.Record (list))])
-    (random/wrap (list (' {})))
-
-    [_ (#.Tuple members)]
-    (do r.Monad
-      [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)]
-      (wrap (|> member-wise-patterns
-                exhaustive-weaving
-                (list/map code.tuple))))
-
-    [_ (#.Record kvs)]
-    (do r.Monad
-      [#let [ks (list/map product.left kvs)
-             vs (list/map product.right kvs)]
-       member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)]
-      (wrap (|> member-wise-patterns
-                exhaustive-weaving
-                (list/map (|>> (list.zip2 ks) code.record)))))
-
-    (^ [_ (#.Form (list [_ (#.Tag _)] _))])
-    (do r.Monad
-      [bundles (monad.map @
-                          (function (_ [_tag _code])
-                            (do @
-                              [v-branches (exhaustive-branches allow-literals? variantTC _code)]
-                              (wrap (list/map (function (_ pattern) (` ((~ _tag) (~ pattern))))
-                                              v-branches))))
-                          variantTC)]
-      (wrap (list/join bundles)))
-
-    _
-    (random/wrap (list))
-    ))
-
-(def: #export (input variant-tags record-tags primitivesC)
-  (-> (List Code) (List Code) (List Code) (r.Random Code))
-  (r.rec
-   (function (_ input)
-     ($_ r.either
-         (random/map product.right _primitive.primitive)
-         (do r.Monad
-           [choice (|> r.nat (:: @ map (n/% (list.size variant-tags))))
-            #let [choiceT (maybe.assume (list.nth choice variant-tags))
-                  choiceC (maybe.assume (list.nth choice primitivesC))]]
-           (wrap (` ((~ choiceT) (~ choiceC)))))
-         (do r.Monad
-           [size (|> r.nat (:: @ map (n/% +3)))
-            elems (r.list size input)]
-           (wrap (code.tuple elems)))
-         (random/wrap (code.record (list.zip2 record-tags primitivesC)))
-         ))))
-
-(def: (branch body pattern)
-  (-> Code Code [Code Code])
-  [pattern body])
-
-(context: "Pattern-matching."
-  ## #seed +9253409297339902486
-  ## #seed +3793366152923578600
-  (<| (seed +5004137551292836565)
-      ## (times +100)
-      (do @
-        [module-name (r.unicode +5)
-         variant-name (r.unicode +5)
-         record-name (|> (r.unicode +5) (r.filter (|>> (text/= variant-name) not)))
-         size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         variant-tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
-         record-tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
-         primitivesTC (r.list size _primitive.primitive)
-         #let [primitivesT (list/map product.left primitivesTC)
-               primitivesC (list/map product.right primitivesTC)
-               code-tag (|>> [module-name] code.tag)
-               variant-tags+ (list/map code-tag variant-tags)
-               record-tags+ (list/map code-tag record-tags)
-               variantTC (list.zip2 variant-tags+ primitivesC)]
-         inputC (input variant-tags+ record-tags+ primitivesC)
-         [outputT outputC] _primitive.primitive
-         [heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not)
-                                                   _primitive.primitive)
-         exhaustive-patterns (exhaustive-branches #1 variantTC inputC)
-         redundant-patterns (exhaustive-branches #0 variantTC inputC)
-         redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns))))
-         heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns))))
-         #let [exhaustive-branchesC (list/map (branch outputC)
-                                              exhaustive-patterns)
-               non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC))
-                                                   exhaustive-branchesC)
-               redundant-branchesC (<| (list/map (branch outputC))
-                                       list.concat
-                                       (list (list.take redundancy-idx redundant-patterns)
-                                             (list (maybe.assume (list.nth redundancy-idx redundant-patterns)))
-                                             (list.drop redundancy-idx redundant-patterns)))
-               heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC)
-                                                          (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))]
-                                                                  [_pattern heterogeneousC]))
-                                                          (list.drop (inc heterogeneous-idx) exhaustive-branchesC)))
-               analyse-pm (|>> (/.case _primitive.analyse inputC)
-                               (typeA.with-type outputT)
-                               analysis.with-scope
-                               (do compiler.Monad
-                                 [_ (module.declare-tags variant-tags #0
-                                                         (#.Named [module-name variant-name]
-                                                                  (type.variant primitivesT)))
-                                  _ (module.declare-tags record-tags #0
-                                                         (#.Named [module-name record-name]
-                                                                  (type.tuple primitivesT)))])
-                               (module.with-module +0 module-name))]]
-        ($_ seq
-            (test "Will reject empty pattern-matching (no branches)."
-                  (|> (analyse-pm (list))
-                      _structure.check-fails))
-            (test "Can analyse exhaustive pattern-matching."
-                  (|> (analyse-pm exhaustive-branchesC)
-                      _structure.check-succeeds))
-            (test "Will reject non-exhaustive pattern-matching."
-                  (|> (analyse-pm non-exhaustive-branchesC)
-                      _structure.check-fails))
-            (test "Will reject redundant pattern-matching."
-                  (|> (analyse-pm redundant-branchesC)
-                      _structure.check-fails))
-            (test "Will reject pattern-matching if the bodies of the branches do not all have the same type."
-                  (|> (analyse-pm heterogeneous-branchesC)
-                      _structure.check-fails)))
-        )))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/function.lux b/stdlib/test/test/lux/language/compiler/analysis/function.lux
deleted file mode 100644
index 22ff04213..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/function.lux
+++ /dev/null
@@ -1,119 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["e" error]
-    ["." maybe]
-    ["." product]
-    [text ("text/." Equivalence)
-     format]
-    [collection
-     ["." list ("list/." Functor)]]]
-   [math
-    ["r" random]]
-   ["." type]
-   ["." macro
-    ["." code]]
-   ["." language
-    ["." reference]
-    ["." compiler
-     ["." init]
-     ["." analysis (#+ Analysis Operation)
-      [".A" type]
-      ["." expression]
-      ["/" function]]
-     [extension
-      [".E" analysis]]]]
-   test]
-  [//
-   ["_." primitive]
-   ["_." structure]])
-
-(def: analyse (expression.analyser (:coerce language.Eval [])))
-
-(def: (check-apply expectedT num-args analysis)
-  (-> Type Nat (Operation Analysis) Bit)
-  (|> analysis
-      (typeA.with-type expectedT)
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      (case> (#e.Success applyA)
-             (let [[funcA argsA] (analysis.application applyA)]
-               (n/= num-args (list.size argsA)))
-
-             (#e.Error error)
-             #0)))
-
-(context: "Function definition."
-  (<| (times +100)
-      (do @
-        [func-name (r.unicode +5)
-         arg-name (|> (r.unicode +5) (r.filter (|>> (text/= func-name) not)))
-         [outputT outputC] _primitive.primitive
-         [inputT _] _primitive.primitive
-         #let [g!arg (code.local-symbol arg-name)]]
-        ($_ seq
-            (test "Can analyse function."
-                  (and (|> (typeA.with-type (All [a] (-> a outputT))
-                             (/.function ..analyse func-name arg-name outputC))
-                           _structure.check-succeeds)
-                       (|> (typeA.with-type (All [a] (-> a a))
-                             (/.function ..analyse func-name arg-name g!arg))
-                           _structure.check-succeeds)))
-            (test "Generic functions can always be specialized."
-                  (and (|> (typeA.with-type (-> inputT outputT)
-                             (/.function ..analyse func-name arg-name outputC))
-                           _structure.check-succeeds)
-                       (|> (typeA.with-type (-> inputT inputT)
-                             (/.function ..analyse func-name arg-name g!arg))
-                           _structure.check-succeeds)))
-            (test "The function's name is bound to the function's type."
-                  (|> (typeA.with-type (Rec self (-> inputT self))
-                        (/.function ..analyse func-name arg-name (code.local-symbol func-name)))
-                      _structure.check-succeeds))
-            ))))
-
-(context: "Function application."
-  (<| (times +100)
-      (do @
-        [full-args (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         partial-args (|> r.nat (:: @ map (n/% full-args)))
-         var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max +1))))
-         inputsTC (r.list full-args _primitive.primitive)
-         #let [inputsT (list/map product.left inputsTC)
-               inputsC (list/map product.right inputsTC)]
-         [outputT outputC] _primitive.primitive
-         #let [funcT (type.function inputsT outputT)
-               partialT (type.function (list.drop partial-args inputsT) outputT)
-               varT (#.Parameter +1)
-               polyT (<| (type.univ-q +1)
-                         (type.function (list.concat (list (list.take var-idx inputsT)
-                                                           (list varT)
-                                                           (list.drop (inc var-idx) inputsT))))
-                         varT)
-               poly-inputT (maybe.assume (list.nth var-idx inputsT))
-               partial-poly-inputsT (list.drop (inc var-idx) inputsT)
-               partial-polyT1 (<| (type.function partial-poly-inputsT)
-                                  poly-inputT)
-               partial-polyT2 (<| (type.univ-q +1)
-                                  (type.function (#.Cons varT partial-poly-inputsT))
-                                  varT)
-               dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local +1)))]]
-        ($_ seq
-            (test "Can analyse monomorphic type application."
-                  (|> (/.apply ..analyse funcT dummy-function inputsC)
-                      (check-apply outputT full-args)))
-            (test "Can partially apply functions."
-                  (|> (/.apply ..analyse funcT dummy-function (list.take partial-args inputsC))
-                      (check-apply partialT partial-args)))
-            (test "Can apply polymorphic functions."
-                  (|> (/.apply ..analyse polyT dummy-function inputsC)
-                      (check-apply poly-inputT full-args)))
-            (test "Polymorphic partial application propagates found type-vars."
-                  (|> (/.apply ..analyse polyT dummy-function (list.take (inc var-idx) inputsC))
-                      (check-apply partial-polyT1 (inc var-idx))))
-            (test "Polymorphic partial application preserves quantification for type-vars."
-                  (|> (/.apply ..analyse polyT dummy-function (list.take var-idx inputsC))
-                      (check-apply partial-polyT2 var-idx)))
-            ))))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/primitive.lux b/stdlib/test/test/lux/language/compiler/analysis/primitive.lux
deleted file mode 100644
index adad90f18..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/primitive.lux
+++ /dev/null
@@ -1,92 +0,0 @@
-(.module:
-  [lux (#- primitive)
-   [control
-    [monad (#+ do)]
-    pipe
-    ["ex" exception (#+ exception:)]]
-   [data
-    ["e" error]
-    [text
-     format]]
-   [math
-    ["r" random ("random/." Monad)]]
-   [".L" type ("type/." Equivalence)]
-   [macro
-    ["." code]]
-   ["." language
-    ["." compiler
-     ["." init]
-     ["." analysis (#+ Analysis Operation)
-      [".A" type]
-      ["." expression]]
-     [extension
-      [".E" analysis]]]]
-   test])
-
-(def: #export analyse (expression.analyser (:coerce language.Eval [])))
-
-(def: unit
-  (r.Random Code)
-  (random/wrap (' [])))
-
-(def: #export primitive
-  (r.Random [Type Code])
-  (`` ($_ r.either
-          (~~ (do-template [  ]
-                [(r.seq (random/wrap ) (random/map  ))]
-
-                [Any  code.tuple (r.list +0 ..unit)]
-                [Bit code.bit  r.bit]
-                [Nat  code.nat   r.nat]
-                [Int  code.int   r.int]
-                [Rev  code.rev   r.rev]
-                [Frac code.frac  r.frac]
-                [Text code.text  (r.unicode +5)]
-                )))))
-
-(exception: (wrong-inference {expected Type} {inferred Type})
-  (ex.report ["Expected" (%type expected)]
-             ["Inferred" (%type inferred)]))
-
-(def: (infer-primitive expected-type analysis)
-  (-> Type (Operation Analysis) (e.Error Analysis))
-  (|> analysis
-      typeA.with-inference
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      (case> (#e.Success [inferred-type output])
-             (if (is? expected-type inferred-type)
-               (#e.Success output)
-               (ex.throw wrong-inference [expected-type inferred-type]))
-
-             (#e.Error error)
-             (#e.Error error))))
-
-(context: "Primitives"
-  ($_ seq
-      (test "Can analyse unit."
-            (|> (infer-primitive Any (..analyse (' [])))
-                (case> (^ (#e.Success (#analysis.Primitive (#analysis.Unit output))))
-                       (is? [] output)
-
-                       _
-                       #0)))
-      (<| (times +100)
-          (`` ($_ seq
-                  (~~ (do-template [    ]
-                        [(do @
-                           [sample ]
-                           (test (format "Can analyse "  ".")
-                                 (|> (infer-primitive  (..analyse ( sample)))
-                                     (case> (#e.Success (#analysis.Primitive ( output)))
-                                            (is? sample output)
-
-                                            _
-                                            #0))))]
-
-                        ["bit"  Bit  #analysis.Bit  r.bit  code.bit]
-                        ["nat"  Nat  #analysis.Nat  r.nat  code.nat]
-                        ["int"  Int  #analysis.Int  r.int  code.int]
-                        ["rev"  Rev  #analysis.Rev  r.rev  code.rev]
-                        ["frac" Frac #analysis.Frac r.frac code.frac]
-                        ["text" Text #analysis.Text (r.unicode +5) code.text]
-                        )))))))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux
deleted file mode 100644
index 2a5cc2ee3..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux
+++ /dev/null
@@ -1,307 +0,0 @@
-(.module:
-  [lux #*
-   [io]
-   [control
-    [monad (#+ do)]
-    pipe]
-   [concurrency
-    ["." atom]]
-   [data
-    ["e" error]
-    ["." product]
-    [text
-     format]]
-   [math
-    ["r" random]]
-   [type ("type/." Equivalence)]
-   [macro
-    ["." code]]
-   [language
-    ["." compiler
-     ["." init]
-     [analysis
-      ["." scope]
-      [".A" type]]
-     [extension
-      [".E" analysis]]]]
-   test]
-  [///
-   ["_." primitive]])
-
-(do-template [  ]
-  [(def: ( procedure params output-type)
-     (-> Text (List Code) Type Bit)
-     (|> (scope.with-scope ""
-           (typeA.with-type output-type
-             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
-         (compiler.run [analysisE.bundle (init.compiler [])])
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [check-success+ #1 #0]
-  [check-failure+ #0 #1]
-  )
-
-(context: "Lux procedures"
-  (<| (times +100)
-      (do @
-        [[primT primC] _primitive.primitive
-         [antiT antiC] (|> _primitive.primitive
-                           (r.filter (|>> product.left (type/= primT) not)))]
-        ($_ seq
-            (test "Can test for reference equality."
-                  (check-success+ "lux is" (list primC primC) Bit))
-            (test "Reference equality must be done with elements of the same type."
-                  (check-failure+ "lux is" (list primC antiC) Bit))
-            (test "Can 'try' risky IO computations."
-                  (check-success+ "lux try"
-                                  (list (` ([(~' _) (~' _)] (~ primC))))
-                                  (type (Either Text primT))))
-            ))))
-
-(context: "Bit procedures"
-  (<| (times +100)
-      (do @
-        [subjectC (|> r.nat (:: @ map code.nat))
-         signedC (|> r.int (:: @ map code.int))
-         paramC (|> r.nat (:: @ map code.nat))]
-        ($_ seq
-            (test "Can perform bit 'and'."
-                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
-            (test "Can perform bit 'or'."
-                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
-            (test "Can perform bit 'xor'."
-                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
-            (test "Can shift bit pattern to the left."
-                  (check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
-            (test "Can shift bit pattern to the right."
-                  (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
-            (test "Can shift signed bit pattern to the right."
-                  (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
-            ))))
-
-(context: "Int procedures"
-  (<| (times +100)
-      (do @
-        [subjectC (|> r.int (:: @ map code.int))
-         paramC (|> r.int (:: @ map code.int))]
-        ($_ seq
-            (test "Can add integers."
-                  (check-success+ "lux int +" (list subjectC paramC) Int))
-            (test "Can subtract integers."
-                  (check-success+ "lux int -" (list subjectC paramC) Int))
-            (test "Can multiply integers."
-                  (check-success+ "lux int *" (list subjectC paramC) Int))
-            (test "Can divide integers."
-                  (check-success+ "lux int /" (list subjectC paramC) Int))
-            (test "Can calculate remainder of integers."
-                  (check-success+ "lux int %" (list subjectC paramC) Int))
-            (test "Can test equivalence of integers."
-                  (check-success+ "lux int =" (list subjectC paramC) Bit))
-            (test "Can compare integers."
-                  (check-success+ "lux int <" (list subjectC paramC) Bit))
-            (test "Can convert integer to fraction."
-                  (check-success+ "lux int to-frac" (list subjectC) Frac))
-            (test "Can convert integer to text."
-                  (check-success+ "lux int char" (list subjectC) Text))
-            ))))
-
-(context: "Frac procedures"
-  (<| (times +100)
-      (do @
-        [subjectC (|> r.frac (:: @ map code.frac))
-         paramC (|> r.frac (:: @ map code.frac))
-         encodedC (|> (r.unicode +5) (:: @ map code.text))]
-        ($_ seq
-            (test "Can add frac numbers."
-                  (check-success+ "lux frac +" (list subjectC paramC) Frac))
-            (test "Can subtract frac numbers."
-                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
-            (test "Can multiply frac numbers."
-                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
-            (test "Can divide frac numbers."
-                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
-            (test "Can calculate remainder of frac numbers."
-                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
-            (test "Can test equivalence of frac numbers."
-                  (check-success+ "lux frac =" (list subjectC paramC) Bit))
-            (test "Can compare frac numbers."
-                  (check-success+ "lux frac <" (list subjectC paramC) Bit))
-            (test "Can obtain minimum frac number."
-                  (check-success+ "lux frac min" (list) Frac))
-            (test "Can obtain maximum frac number."
-                  (check-success+ "lux frac max" (list) Frac))
-            (test "Can obtain smallest frac number."
-                  (check-success+ "lux frac smallest" (list) Frac))
-            (test "Can convert frac number to integer."
-                  (check-success+ "lux frac to-int" (list subjectC) Int))
-            (test "Can convert frac number to text."
-                  (check-success+ "lux frac encode" (list subjectC) Text))
-            (test "Can convert text to frac number."
-                  (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
-            ))))
-
-(context: "Text procedures"
-  (<| (times +100)
-      (do @
-        [subjectC (|> (r.unicode +5) (:: @ map code.text))
-         paramC (|> (r.unicode +5) (:: @ map code.text))
-         replacementC (|> (r.unicode +5) (:: @ map code.text))
-         fromC (|> r.nat (:: @ map code.nat))
-         toC (|> r.nat (:: @ map code.nat))]
-        ($_ seq
-            (test "Can test text equivalence."
-                  (check-success+ "lux text =" (list subjectC paramC) Bit))
-            (test "Compare texts in lexicographical order."
-                  (check-success+ "lux text <" (list subjectC paramC) Bit))
-            (test "Can concatenate one text to another."
-                  (check-success+ "lux text concat" (list subjectC paramC) Text))
-            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
-                  (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
-            (test "Can query the size/length of a text."
-                  (check-success+ "lux text size" (list subjectC) Nat))
-            (test "Can obtain the character code of a text at a given index."
-                  (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat))))
-            (test "Can clip a piece of text between 2 indices."
-                  (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text))))
-            ))))
-
-(context: "Array procedures"
-  (<| (times +100)
-      (do @
-        [[elemT elemC] _primitive.primitive
-         sizeC (|> r.nat (:: @ map code.nat))
-         idxC (|> r.nat (:: @ map code.nat))
-         var-name (r.unicode +5)
-         #let [arrayT (type (Array elemT))
-               g!array (code.local-symbol var-name)
-               array-operation (function (_ output-type code)
-                                 (|> (scope.with-scope ""
-                                       (scope.with-local [var-name arrayT]
-                                         (typeA.with-type output-type
-                                           (_primitive.analyse code))))
-                                     (compiler.run [analysisE.bundle (init.compiler [])])
-                                     (case> (#e.Success _)
-                                            #1
-
-                                            (#e.Error error)
-                                            #0)))]]
-        ($_ seq
-            (test "Can create arrays."
-                  (check-success+ "lux array new" (list sizeC) arrayT))
-            (test "Can get a value inside an array."
-                  (array-operation (type (Maybe elemT))
-                                   (` ("lux array get" (~ g!array) (~ idxC)))))
-            (test "Can put a value inside an array."
-                  (array-operation arrayT
-                                   (` ("lux array put" (~ g!array) (~ idxC) (~ elemC)))))
-            (test "Can remove a value from an array."
-                  (array-operation arrayT
-                                   (` ("lux array remove" (~ g!array) (~ idxC)))))
-            (test "Can query the size of an array."
-                  (array-operation Nat
-                                   (` ("lux array size" (~ g!array)))))
-            ))))
-
-(context: "Math procedures"
-  (<| (times +100)
-      (do @
-        [subjectC (|> r.frac (:: @ map code.frac))
-         paramC (|> r.frac (:: @ map code.frac))]
-        (`` ($_ seq
-                (~~ (do-template [ ]
-                      [(test (format "Can calculate "  ".")
-                             (check-success+  (list subjectC) Frac))]
-
-                      ["lux math cos" "cosine"]
-                      ["lux math sin" "sine"]
-                      ["lux math tan" "tangent"]
-                      ["lux math acos" "inverse/arc cosine"]
-                      ["lux math asin" "inverse/arc sine"]
-                      ["lux math atan" "inverse/arc tangent"]
-                      ["lux math cosh" "hyperbolic cosine"]
-                      ["lux math sinh" "hyperbolic sine"]
-                      ["lux math tanh" "hyperbolic tangent"]
-                      ["lux math exp" "exponentiation"]
-                      ["lux math log" "logarithm"]
-                      ["lux math ceil" "ceiling"]
-                      ["lux math floor" "floor"]
-                      ["lux math round" "rounding"]))
-                (~~ (do-template [ ]
-                      [(test (format "Can calculate "  ".")
-                             (check-success+  (list subjectC paramC) Frac))]
-
-                      ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
-                      ["lux math pow" "power"])))))))
-
-(context: "Atom procedures"
-  (<| (times +100)
-      (do @
-        [[elemT elemC] _primitive.primitive
-         sizeC (|> r.nat (:: @ map code.nat))
-         idxC (|> r.nat (:: @ map code.nat))
-         var-name (r.unicode +5)
-         #let [atomT (type (atom.Atom elemT))]]
-        ($_ seq
-            (test "Can create atomic reference."
-                  (check-success+ "lux atom new" (list elemC) atomT))
-            (test "Can read the value of an atomic reference."
-                  (|> (scope.with-scope ""
-                        (scope.with-local [var-name atomT]
-                          (typeA.with-type elemT
-                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (#e.Success _)
-                             #1
-
-                             (#e.Error _)
-                             #0)))
-            (test "Can swap the value of an atomic reference."
-                  (|> (scope.with-scope ""
-                        (scope.with-local [var-name atomT]
-                          (typeA.with-type Bit
-                            (_primitive.analyse (` ("lux atom compare-and-swap"
-                                                    (~ (code.symbol ["" var-name]))
-                                                    (~ elemC)
-                                                    (~ elemC)))))))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (#e.Success _)
-                             #1
-
-                             (#e.Error _)
-                             #0)))
-            ))))
-
-(context: "Process procedures"
-  (<| (times +100)
-      (do @
-        [[primT primC] _primitive.primitive
-         timeC (|> r.nat (:: @ map code.nat))]
-        ($_ seq
-            (test "Can query the level of concurrency."
-                  (check-success+ "lux process parallelism-level" (list) Nat))
-            (test "Can schedule an IO computation to run concurrently at some future time."
-                  (check-success+ "lux process schedule"
-                                  (list timeC
-                                        (` ([(~' _) (~' _)] (~ primC))))
-                                  Any))
-            ))))
-
-(context: "IO procedures"
-  (<| (times +100)
-      (do @
-        [logC (|> (r.unicode +5) (:: @ map code.text))
-         exitC (|> r.int (:: @ map code.int))]
-        ($_ seq
-            (test "Can log messages to standard output."
-                  (check-success+ "lux io log" (list logC) Any))
-            (test "Can throw a run-time error."
-                  (check-success+ "lux io error" (list logC) Nothing))
-            (test "Can exit the program."
-                  (check-success+ "lux io exit" (list exitC) Nothing))
-            (test "Can query the current time (as milliseconds since epoch)."
-                  (check-success+ "lux io current-time" (list) Int))
-            ))))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/reference.lux b/stdlib/test/test/lux/language/compiler/analysis/reference.lux
deleted file mode 100644
index 66c990ef4..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/reference.lux
+++ /dev/null
@@ -1,108 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["e" error]
-    [ident ("ident/." Equivalence)]
-    [text ("text/." Equivalence)]]
-   [math
-    ["r" random]]
-   [type ("type/." Equivalence)]
-   [macro
-    ["." code]]
-   ["." language
-    ["." reference]
-    ["." compiler
-     ["." init]
-     ["." analysis
-      ["." scope]
-      ["." module]
-      [".A" type]
-      ["." expression]]
-     [extension
-      [".E" analysis]]]]
-   test]
-  [//
-   ["_." primitive]])
-
-(def: analyse (expression.analyser (:coerce language.Eval [])))
-
-(type: Check (-> (e.Error Any) Bit))
-
-(do-template [  ]
-  [(def: 
-     Check
-     (|>> (case> (#e.Success _)
-                 
-
-                 (#e.Error _)
-                 )))]
-
-  [success? #1 #0]
-  [failure? #0 #1]
-  )
-
-(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
-  (-> Text [Bit Text] [Bit Text] Check Bit)
-  (|> (do compiler.Monad
-        [_ (module.with-module +0 def-module
-             (module.define var-name [Any
-                                      (if export?
-                                        (' {#.export? #1})
-                                        (' {}))
-                                      []]))]
-        (module.with-module +0 dependent-module
-          (do @
-            [_ (if import?
-                 (module.import def-module)
-                 (wrap []))]
-            (typeA.with-inference
-              (..analyse (code.symbol [def-module var-name]))))))
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      check!))
-
-(context: "References"
-  (<| (times +100)
-      (do @
-        [[expectedT _] _primitive.primitive
-         def-module (r.unicode +5)
-         scope-name (r.unicode +5)
-         var-name (r.unicode +5)
-         dependent-module (|> (r.unicode +5)
-                              (r.filter (|>> (text/= def-module) not)))]
-        ($_ seq
-            (test "Can analyse variable."
-                  (|> (scope.with-scope scope-name
-                        (scope.with-local [var-name expectedT]
-                          (typeA.with-inference
-                            (..analyse (code.local-symbol var-name)))))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (^ (#e.Success [inferredT (#analysis.Reference (reference.local var))]))
-                             (and (type/= expectedT inferredT)
-                                  (n/= +0 var))
-
-                             _
-                             #0)))
-            (test "Can analyse definition (in the same module)."
-                  (let [def-name [def-module var-name]]
-                    (|> (do compiler.Monad
-                          [_ (module.define var-name [expectedT (' {}) []])]
-                          (typeA.with-inference
-                            (..analyse (code.symbol def-name))))
-                        (module.with-module +0 def-module)
-                        (compiler.run [analysisE.bundle (init.compiler [])])
-                        (case> (^ (#e.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))]))
-                               (and (type/= expectedT inferredT)
-                                    (ident/= def-name constant-name))
-
-                               _
-                               #0))))
-            (test "Can analyse definition (if exported from imported module)."
-                  (reach-test var-name [#1 def-module] [#1 dependent-module] success?))
-            (test "Cannot analyse definition (if not exported from imported module)."
-                  (reach-test var-name [#0 def-module] [#1 dependent-module] failure?))
-            (test "Cannot analyse definition (if exported from non-imported module)."
-                  (reach-test var-name [#1 def-module] [#0 dependent-module] failure?))
-            ))))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/structure.lux b/stdlib/test/test/lux/language/compiler/analysis/structure.lux
deleted file mode 100644
index 6dca4fb12..000000000
--- a/stdlib/test/test/lux/language/compiler/analysis/structure.lux
+++ /dev/null
@@ -1,298 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    [bit ("bit/." Equivalence)]
-    ["e" error]
-    ["." product]
-    ["." maybe]
-    ["." text]
-    [collection
-     ["." list ("list/." Functor)]
-     ["." set]]]
-   [math
-    ["r" random]]
-   ["." type ("type/." Equivalence)
-    ["." check]]
-   [macro
-    ["." code]]
-   ["." language
-    ["." compiler
-     ["." init]
-     ["." analysis (#+ Analysis Variant Tag Operation)
-      ["." module]
-      [".A" type]
-      ["/" structure]
-      ["." expression]]
-     [extension
-      [".E" analysis]]]]
-   test]
-  [//
-   ["_." primitive]])
-
-(def: analyse (expression.analyser (:coerce language.Eval [])))
-
-(do-template [  ]
-  [(def: #export 
-     (All [a] (-> (Operation a) Bit))
-     (|>> (compiler.run [analysisE.bundle (init.compiler [])])
-          (case> (#e.Success _)
-                 
-
-                 _
-                 )))]
-
-  [check-succeeds #1 #0]
-  [check-fails    #0 #1]
-  )
-
-(def: (check-sum' size tag variant)
-  (-> Nat Tag (Variant Analysis) Bit)
-  (let [variant-tag (if (get@ #analysis.right? variant)
-                      (inc (get@ #analysis.lefts variant))
-                      (get@ #analysis.lefts variant))]
-    (|> size dec (n/= tag)
-        (bit/= (get@ #analysis.right? variant))
-        (and (n/= tag variant-tag)))))
-
-(def: (check-sum type size tag analysis)
-  (-> Type Nat Tag (Operation Analysis) Bit)
-  (|> analysis
-      (typeA.with-type type)
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      (case> (^multi (#e.Success sumA)
-                     [(analysis.variant sumA)
-                      (#.Some variant)])
-             (check-sum' size tag variant)
-
-             _
-             #0)))
-
-(def: (tagged module tags type)
-  (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a])))
-  (|>> (do compiler.Monad
-         [_ (module.declare-tags tags #0 type)])
-       (module.with-module +0 module)))
-
-(def: (check-variant module tags type size tag analysis)
-  (-> Text (List module.Tag) Type Nat Tag (Operation Analysis) Bit)
-  (|> analysis
-      (tagged module tags type)
-      (typeA.with-type type)
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      (case> (^multi (#e.Success [_ sumA])
-                     [(analysis.variant sumA)
-                      (#.Some variant)])
-             (check-sum' size tag variant)
-
-             _
-             #0)))
-
-(def: (right-size? size)
-  (-> Nat (-> Analysis Bit))
-  (|>> analysis.tuple list.size (n/= size)))
-
-(def: (check-record-inference module tags type size analysis)
-  (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit)
-  (|> analysis
-      (tagged module tags type)
-      (compiler.run [analysisE.bundle (init.compiler [])])
-      (case> (#e.Success [_ productT productA])
-             (and (type/= type productT)
-                  (right-size? size productA))
-
-             _
-             #0)))
-
-(context: "Sums"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         choice (|> r.nat (:: @ map (n/% size)))
-         primitives (r.list size _primitive.primitive)
-         +choice (|> r.nat (:: @ map (n/% (inc size))))
-         [_ +valueC] _primitive.primitive
-         #let [variantT (type.variant (list/map product.left primitives))
-               [valueT valueC] (maybe.assume (list.nth choice primitives))
-               +size (inc size)
-               +primitives (list.concat (list (list.take choice primitives)
-                                              (list [(#.Parameter +1) +valueC])
-                                              (list.drop choice primitives)))
-               [+valueT +valueC] (maybe.assume (list.nth +choice +primitives))
-               +variantT (type.variant (list/map product.left +primitives))]]
-        ($_ seq
-            (test "Can analyse sum."
-                  (check-sum variantT size choice
-                             (/.sum ..analyse choice valueC)))
-            (test "Can analyse sum through bound type-vars."
-                  (|> (do compiler.Monad
-                        [[_ varT] (typeA.with-env check.var)
-                         _ (typeA.with-env
-                             (check.check varT variantT))]
-                        (typeA.with-type varT
-                          (/.sum ..analyse choice valueC)))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (^multi (#e.Success sumA)
-                                     [(analysis.variant sumA)
-                                      (#.Some variant)])
-                             (check-sum' size choice variant)
-
-                             _
-                             #0)))
-            (test "Cannot analyse sum through unbound type-vars."
-                  (|> (do compiler.Monad
-                        [[_ varT] (typeA.with-env check.var)]
-                        (typeA.with-type varT
-                          (/.sum ..analyse choice valueC)))
-                      check-fails))
-            (test "Can analyse sum through existential quantification."
-                  (|> (typeA.with-type (type.ex-q +1 +variantT)
-                        (/.sum ..analyse +choice +valueC))
-                      check-succeeds))
-            (test "Can analyse sum through universal quantification."
-                  (let [check-outcome (if (not (n/= choice +choice))
-                                        check-succeeds
-                                        check-fails)]
-                    (|> (typeA.with-type (type.univ-q +1 +variantT)
-                          (/.sum ..analyse +choice +valueC))
-                        check-outcome)))
-            ))))
-
-(context: "Products"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         primitives (r.list size _primitive.primitive)
-         choice (|> r.nat (:: @ map (n/% size)))
-         [_ +valueC] _primitive.primitive
-         #let [tupleT (type.tuple (list/map product.left primitives))
-               [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume)
-               +primitives (list.concat (list (list.take choice primitives)
-                                              (list [(#.Parameter +1) +valueC])
-                                              (list.drop choice primitives)))
-               +tupleT (type.tuple (list/map product.left +primitives))]]
-        ($_ seq
-            (test "Can analyse product."
-                  (|> (typeA.with-type tupleT
-                        (/.product ..analyse (list/map product.right primitives)))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             #0)))
-            (test "Can infer product."
-                  (|> (typeA.with-inference
-                        (/.product ..analyse (list/map product.right primitives)))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (#e.Success [_type tupleA])
-                             (and (type/= tupleT _type)
-                                  (right-size? size tupleA))
-
-                             _
-                             #0)))
-            (test "Can analyse pseudo-product (singleton tuple)"
-                  (|> (typeA.with-type singletonT
-                        (..analyse (` [(~ singletonC)])))
-                      check-succeeds))
-            (test "Can analyse product through bound type-vars."
-                  (|> (do compiler.Monad
-                        [[_ varT] (typeA.with-env check.var)
-                         _ (typeA.with-env
-                             (check.check varT (type.tuple (list/map product.left primitives))))]
-                        (typeA.with-type varT
-                          (/.product ..analyse (list/map product.right primitives))))
-                      (compiler.run [analysisE.bundle (init.compiler [])])
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             #0)))
-            (test "Can analyse product through existential quantification."
-                  (|> (typeA.with-type (type.ex-q +1 +tupleT)
-                        (/.product ..analyse (list/map product.right +primitives)))
-                      check-succeeds))
-            (test "Cannot analyse product through universal quantification."
-                  (|> (typeA.with-type (type.univ-q +1 +tupleT)
-                        (/.product ..analyse (list/map product.right +primitives)))
-                      check-fails))
-            ))))
-
-(context: "Tagged Sums"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
-         choice (|> r.nat (:: @ map (n/% size)))
-         other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not)))
-         primitives (r.list size _primitive.primitive)
-         module-name (r.unicode +5)
-         type-name (r.unicode +5)
-         #let [varT (#.Parameter +1)
-               primitivesT (list/map product.left primitives)
-               [choiceT choiceC] (maybe.assume (list.nth choice primitives))
-               [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives))
-               variantT (type.variant primitivesT)
-               namedT (#.Named [module-name type-name] variantT)
-               named-polyT (|> (type.variant (list.concat (list (list.take choice primitivesT)
-                                                                (list varT)
-                                                                (list.drop (inc choice) primitivesT))))
-                               (type.univ-q +1)
-                               (#.Named [module-name type-name]))
-               choice-tag (maybe.assume (list.nth choice tags))
-               other-choice-tag (maybe.assume (list.nth other-choice tags))]]
-        ($_ seq
-            (test "Can infer tagged sum."
-                  (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC)
-                      (check-variant module-name tags namedT choice size)))
-            (test "Tagged sums specialize when type-vars get bound."
-                  (|> (/.tagged-sum ..analyse [module-name choice-tag] choiceC)
-                      (check-variant module-name tags named-polyT choice size)))
-            (test "Tagged sum inference retains universal quantification when type-vars are not bound."
-                  (|> (/.tagged-sum ..analyse [module-name other-choice-tag] other-choiceC)
-                      (check-variant module-name tags named-polyT other-choice size)))
-            (test "Can specialize generic tagged sums."
-                  (|> (typeA.with-type variantT
-                        (/.tagged-sum ..analyse [module-name other-choice-tag] other-choiceC))
-                      (check-variant module-name tags named-polyT other-choice size)))
-            ))))
-
-(context: "Records"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         tags (|> (r.set text.Hash size (r.unicode +5)) (:: @ map set.to-list))
-         primitives (r.list size _primitive.primitive)
-         module-name (r.unicode +5)
-         type-name (r.unicode +5)
-         choice (|> r.nat (:: @ map (n/% size)))
-         #let [varT (#.Parameter +1)
-               tagsC (list/map (|>> [module-name] code.tag) tags)
-               primitivesT (list/map product.left primitives)
-               primitivesC (list/map product.right primitives)
-               tupleT (type.tuple primitivesT)
-               namedT (#.Named [module-name type-name] tupleT)
-               recordC (list.zip2 tagsC primitivesC)
-               named-polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT)
-                                                              (list varT)
-                                                              (list.drop (inc choice) primitivesT))))
-                               (type.univ-q +1)
-                               (#.Named [module-name type-name]))]]
-        ($_ seq
-            (test "Can infer record."
-                  (|> (typeA.with-inference
-                        (/.record ..analyse recordC))
-                      (check-record-inference module-name tags namedT size)))
-            (test "Records specialize when type-vars get bound."
-                  (|> (typeA.with-inference
-                        (/.record ..analyse recordC))
-                      (check-record-inference module-name tags named-polyT size)))
-            (test "Can specialize generic records."
-                  (|> (do compiler.Monad
-                        [recordA (typeA.with-type tupleT
-                                   (/.record ..analyse recordC))]
-                        (wrap [tupleT recordA]))
-                      (check-record-inference module-name tags named-polyT size)))
-            ))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/case.lux b/stdlib/test/test/lux/language/compiler/synthesis/case.lux
deleted file mode 100644
index 70e13af4b..000000000
--- a/stdlib/test/test/lux/language/compiler/synthesis/case.lux
+++ /dev/null
@@ -1,87 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error ("error/." Functor)]]
-   [language
-    ["." reference]
-    ["." compiler
-     ["." analysis (#+ Branch Analysis)]
-     ["//" synthesis (#+ Synthesis)
-      ["." expression]]
-     [extension
-      ["." bundle]]]]
-   [math
-    ["r" random]]
-   test]
-  ["." //primitive])
-
-(context: "Dummy variables."
-  (<| (times +100)
-      (do @
-        [maskedA //primitive.primitive
-         temp (|> r.nat (:: @ map (n/% +100)))
-         #let [maskA (analysis.control/case
-                      [maskedA
-                       [[(#analysis.Bind temp)
-                         (#analysis.Reference (reference.local temp))]
-                        (list)]])]]
-        (test "Dummy variables created to mask expressions get eliminated during synthesis."
-              (|> maskA
-                  expression.synthesize
-                  (compiler.run [bundle.empty //.init])
-                  (error/map (//primitive.corresponds? maskedA))
-                  (error.default #0))))))
-
-(context: "Let expressions."
-  (<| (times +100)
-      (do @
-        [registerA r.nat
-         inputA //primitive.primitive
-         outputA //primitive.primitive
-         #let [letA (analysis.control/case
-                     [inputA
-                      [[(#analysis.Bind registerA)
-                        outputA]
-                       (list)]])]]
-        (test "Can detect and reify simple 'let' expressions."
-              (|> letA
-                  expression.synthesize
-                  (compiler.run [bundle.empty //.init])
-                  (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
-                         (and (n/= registerA registerS)
-                              (//primitive.corresponds? inputA inputS)
-                              (//primitive.corresponds? outputA outputS))
-
-                         _
-                         #0))))))
-
-(context: "If expressions."
-  (<| (times +100)
-      (do @
-        [then|else r.bit
-         inputA //primitive.primitive
-         thenA //primitive.primitive
-         elseA //primitive.primitive
-         #let [thenB (: Branch
-                        [(#analysis.Simple (#analysis.Bit #1))
-                         thenA])
-               elseB (: Branch
-                        [(#analysis.Simple (#analysis.Bit #0))
-                         elseA])
-               ifA (if then|else
-                     (analysis.control/case [inputA [thenB (list elseB)]])
-                     (analysis.control/case [inputA [elseB (list thenB)]]))]]
-        (test "Can detect and reify simple 'if' expressions."
-              (|> ifA
-                  expression.synthesize
-                  (compiler.run [bundle.empty //.init])
-                  (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
-                         (and (//primitive.corresponds? inputA inputS)
-                              (//primitive.corresponds? thenA thenS)
-                              (//primitive.corresponds? elseA elseS))
-
-                         _
-                         #0))))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/function.lux b/stdlib/test/test/lux/language/compiler/synthesis/function.lux
deleted file mode 100644
index 62d8c97a0..000000000
--- a/stdlib/test/test/lux/language/compiler/synthesis/function.lux
+++ /dev/null
@@ -1,174 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." error]
-    ["." number]
-    [text
-     format]
-    [collection
-     ["." list ("list/." Functor Fold)]
-     ["dict" dictionary (#+ Dictionary)]
-     ["." set]]]
-   [language
-    ["." reference (#+ Variable) ("variable/." Equivalence)]
-    ["." compiler
-     ["." analysis (#+ Arity Analysis)]
-     ["//" synthesis (#+ Synthesis)
-      ["." expression]]
-     [extension
-      ["." bundle]]]]
-   [math
-    ["r" random]]
-   test]
-  ["." //primitive])
-
-(def: constant-function
-  (r.Random [Arity Analysis Analysis])
-  (r.rec
-   (function (_ constant-function)
-     (do r.Monad
-       [function? r.bit]
-       (if function?
-         (do @
-           [[arity bodyA predictionA] constant-function]
-           (wrap [(inc arity)
-                  (#analysis.Function (list) bodyA)
-                  predictionA]))
-         (do @
-           [predictionA //primitive.primitive]
-           (wrap [+0 predictionA predictionA])))))))
-
-(def: (pick scope-size)
-  (-> Nat (r.Random Nat))
-  (|> r.nat (:: r.Monad map (n/% scope-size))))
-
-(def: function-with-environment
-  (r.Random [Arity Analysis Variable])
-  (do r.Monad
-    [num-locals (|> r.nat (:: @ map (|>> (n/% +100) (n/max +10))))
-     #let [indices (list.n/range +0 (dec num-locals))
-           local-env (list/map (|>> #reference.Local) indices)
-           foreign-env (list/map (|>> #reference.Foreign) indices)]
-     [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable])
-                                  (loop [arity +1
-                                         current-env foreign-env]
-                                    (let [current-env/size (list.size current-env)
-                                          resolver (list/fold (function (_ [idx var] resolver)
-                                                                (dict.put idx var resolver))
-                                                              (: (Dictionary Nat Variable)
-                                                                 (dict.new number.Hash))
-                                                              (list.enumerate current-env))]
-                                      (do @
-                                        [nest? r.bit]
-                                        (if nest?
-                                          (do @
-                                            [num-picks (:: @ map (n/max +1) (pick (inc current-env/size)))
-                                             picks (|> (r.set number.Hash num-picks (pick current-env/size))
-                                                       (:: @ map set.to-list))
-                                             [arity bodyA predictionA] (recur (inc arity)
-                                                                              (list/map (function (_ pick)
-                                                                                          (maybe.assume (list.nth pick current-env)))
-                                                                                        picks))
-                                             #let [picked-env (list/map (|>> #reference.Foreign) picks)]]
-                                            (wrap [arity
-                                                   (#analysis.Function picked-env bodyA)
-                                                   predictionA]))
-                                          (do @
-                                            [chosen (pick (list.size current-env))]
-                                            (wrap [arity
-                                                   (#analysis.Reference (reference.foreign chosen))
-                                                   (maybe.assume (dict.get chosen resolver))])))))))]
-    (wrap [arity
-           (#analysis.Function local-env bodyA)
-           predictionA])))
-
-(def: local-function
-  (r.Random [Arity Analysis Variable])
-  (loop [arity +0
-         nest? #1]
-    (if nest?
-      (do r.Monad
-        [nest?' r.bit
-         [arity' bodyA predictionA] (recur (inc arity) nest?')]
-        (wrap [arity'
-               (#analysis.Function (list) bodyA)
-               predictionA]))
-      (do r.Monad
-        [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
-        (wrap [arity
-               (#analysis.Reference (reference.local chosen))
-               (|> chosen (n/+ (dec arity)) #reference.Local)])))))
-
-(context: "Function definition."
-  (<| (seed +13007429814532219492)
-      ## (times +100)
-      (do @
-        [[arity//constant function//constant prediction//constant] constant-function
-         [arity//environment function//environment prediction//environment] function-with-environment
-         [arity//local function//local prediction//local] local-function]
-        ($_ seq
-            (test "Nested functions will get folded together."
-                  (|> function//constant
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (^ (#error.Success (//.function/abstraction [environment arity output])))
-                             (and (n/= arity//constant arity)
-                                  (//primitive.corresponds? prediction//constant output))
-                             
-                             _
-                             (n/= +0 arity//constant))))
-            (test "Folded functions provide direct access to environment variables."
-                  (|> function//environment
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
-                             (and (n/= arity//environment arity)
-                                  (variable/= prediction//environment output))
-                             
-                             _
-                             #0)))
-            (test "Folded functions properly offset local variables."
-                  (|> function//local
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))])))
-                             (and (n/= arity//local arity)
-                                  (variable/= prediction//local output))
-                             
-                             _
-                             #0)))
-            ))))
-
-(context: "Function application."
-  (<| (times +100)
-      (do @
-        [arity (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
-         funcA //primitive.primitive
-         argsA (r.list arity //primitive.primitive)]
-        ($_ seq
-            (test "Can synthesize function application."
-                  (|> (analysis.apply [funcA argsA])
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
-                             (and (//primitive.corresponds? funcA funcS)
-                                  (list.every? (product.uncurry //primitive.corresponds?)
-                                               (list.zip2 argsA argsS)))
-                             
-                             _
-                             #0)))
-            (test "Function application on no arguments just synthesizes to the function itself."
-                  (|> (analysis.apply [funcA (list)])
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (#error.Success funcS)
-                             (//primitive.corresponds? funcA funcS)
-
-                             _
-                             #0)))
-            ))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux
deleted file mode 100644
index c4cc940f1..000000000
--- a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux
+++ /dev/null
@@ -1,96 +0,0 @@
-(.module:
-  [lux (#- primitive)
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error]
-    [text
-     format]]
-   [language
-    ["." compiler
-     ["." analysis (#+ Analysis)]
-     ["//" synthesis (#+ Synthesis)
-      ["." expression]]
-     [extension
-      ["." bundle]]]]
-   [math
-    ["r" random]]
-   test])
-
-(def: #export primitive
-  (r.Random Analysis)
-  (do r.Monad
-    [primitive (: (r.Random analysis.Primitive)
-                  ($_ r.alt
-                      (wrap [])
-                      r.bit
-                      r.nat
-                      r.int
-                      r.rev
-                      r.frac
-                      (r.unicode +5)))]
-    (wrap (#analysis.Primitive primitive))))
-
-(def: #export (corresponds? analysis synthesis)
-  (-> Analysis Synthesis Bit)
-  (case [synthesis analysis]
-    [(#//.Primitive (#//.Text valueS))
-     (#analysis.Primitive (#analysis.Unit valueA))]
-    (is? valueS (:coerce Text valueA))
-    
-    [(#//.Primitive (#//.Bit valueS))
-     (#analysis.Primitive (#analysis.Bit valueA))]
-    (is? valueS valueA)
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysis.Primitive (#analysis.Nat valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysis.Primitive (#analysis.Int valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysis.Primitive (#analysis.Rev valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.F64 valueS))
-     (#analysis.Primitive (#analysis.Frac valueA))]
-    (is? valueS valueA)
-    
-    [(#//.Primitive (#//.Text valueS))
-     (#analysis.Primitive (#analysis.Text valueA))]
-    (is? valueS valueA)
-    
-    _
-    #0))
-
-(context: "Primitives."
-  (<| (times +100)
-      (do @
-        [|bit| r.bit
-         |nat| r.nat
-         |int| r.int
-         |rev| r.rev
-         |frac| r.frac
-         |text| (r.unicode +5)]
-        (`` ($_ seq
-                (~~ (do-template [   ]
-                      [(test (format "Can synthesize "  ".")
-                             (|> (#analysis.Primitive ( ))
-                                 expression.synthesize
-                                 (compiler.run [bundle.empty //.init])
-                                 (case> (#error.Success (#//.Primitive ( value)))
-                                        (is?  value)
-
-                                        _
-                                        #0)))]
-
-                      ["unit" #analysis.Unit #//.Text //.unit]
-                      ["bit"  #analysis.Bit  #//.Bit  |bit|]
-                      ["nat"  #analysis.Nat  #//.I64  (.i64 |nat|)]
-                      ["int"  #analysis.Int  #//.I64  (.i64 |int|)]
-                      ["rev"  #analysis.Rev  #//.I64  (.i64 |rev|)]
-                      ["frac" #analysis.Frac #//.F64  |frac|]
-                      ["text" #analysis.Text #//.Text |text|])))))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux
deleted file mode 100644
index dcec26fb9..000000000
--- a/stdlib/test/test/lux/language/compiler/synthesis/structure.lux
+++ /dev/null
@@ -1,62 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    [bit ("bit/." Equivalence)]
-    ["." product]
-    ["." error]
-    [collection
-     ["." list]]]
-   [language
-    ["." compiler
-     ["." analysis]
-     ["//" synthesis (#+ Synthesis)
-      ["." expression]]
-     [extension
-      ["." bundle]]]]
-   [math
-    ["r" random]]
-   test]
-  ["." //primitive])
-
-(context: "Variants"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/+ +2))))
-         tagA (|> r.nat (:: @ map (n/% size)))
-         memberA //primitive.primitive]
-        ($_ seq
-            (test "Can synthesize variants."
-                  (|> (analysis.sum-analysis size tagA memberA)
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS])))
-                             (let [tagS (if right?S (inc leftsS) leftsS)]
-                               (and (n/= tagA tagS)
-                                    (|> tagS (n/= (dec size)) (bit/= right?S))
-                                    (//primitive.corresponds? memberA valueS)))
-                             
-                             _
-                             #0)))
-            ))))
-
-(context: "Tuples"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
-         membersA (r.list size //primitive.primitive)]
-        ($_ seq
-            (test "Can synthesize tuple."
-                  (|> (analysis.product-analysis membersA)
-                      expression.synthesize
-                      (compiler.run [bundle.empty //.init])
-                      (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
-                             (and (n/= size (list.size membersS))
-                                  (list.every? (product.uncurry //primitive.corresponds?)
-                                               (list.zip2 membersA membersS)))
-
-                             _
-                             #0)))
-            ))))
diff --git a/stdlib/test/test/lux/language/syntax.lux b/stdlib/test/test/lux/language/syntax.lux
deleted file mode 100644
index 469e07c10..000000000
--- a/stdlib/test/test/lux/language/syntax.lux
+++ /dev/null
@@ -1,247 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]]
-   [data
-    [number]
-    ["e" error]
-    ["." text
-     format
-     ["l" lexer]]
-    [collection
-     ["." list]
-     ["dict" dictionary (#+ Dictionary)]]]
-   [math
-    ["r" random ("r/." Monad)]]
-   [macro
-    ["." code]]
-   [language
-    ["&" syntax]]
-   test])
-
-(def: default-cursor
-  Cursor
-  {#.module ""
-   #.line   +0
-   #.column +0})
-
-(def: ident-part^
-  (r.Random Text)
-  (do r.Monad
-    [#let [digits "0123456789"
-           delimiters "()[]{}#.\""
-           space "\t\v \n\r\f"
-           invalid-range (format digits delimiters space)
-           char-gen (|> r.nat
-                        (:: @ map (|>> (n/% +256) (n/max +1)))
-                        (r.filter (function (_ sample)
-                                    (not (text.contains? (text.from-code sample)
-                                                         invalid-range)))))]
-     size (|> r.nat (:: @ map (|>> (n/% +20) (n/max +1))))]
-    (r.text char-gen size)))
-
-(def: ident^
-  (r.Random Ident)
-  (r.seq ident-part^ ident-part^))
-
-(def: code^
-  (r.Random Code)
-  (let [numeric^ (: (r.Random Code)
-                    ($_ r.either
-                        (|> r.bit (r/map code.bit))
-                        (|> r.nat (r/map code.nat))
-                        (|> r.int (r/map code.int))
-                        (|> r.rev (r/map code.rev))
-                        (|> r.frac (r/map code.frac))))
-        textual^ (: (r.Random Code)
-                    ($_ r.either
-                        (do r.Monad
-                          [size (|> r.nat (r/map (n/% +20)))]
-                          (|> (r.unicode size) (r/map code.text)))
-                        (|> ident^ (r/map code.symbol))
-                        (|> ident^ (r/map code.tag))))
-        simple^ (: (r.Random Code)
-                   ($_ r.either
-                       numeric^
-                       textual^))]
-    (r.rec
-     (function (_ code^)
-       (let [multi^ (do r.Monad
-                      [size (|> r.nat (r/map (n/% +3)))]
-                      (r.list size code^))
-             composite^ (: (r.Random Code)
-                           ($_ r.either
-                               (|> multi^ (r/map code.form))
-                               (|> multi^ (r/map code.tuple))
-                               (do r.Monad
-                                 [size (|> r.nat (r/map (n/% +3)))]
-                                 (|> (r.list size (r.seq code^ code^))
-                                     (r/map code.record)))))]
-         (r.either simple^
-                   composite^))))))
-
-(context: "Lux code syntax."
-  (<| (times +100)
-      (do @
-        [sample code^
-         other code^]
-        ($_ seq
-            (test "Can parse Lux code."
-                  (case (&.read "" (dict.new text.Hash)
-                                [default-cursor +0 (code.to-text sample)])
-                    (#e.Error error)
-                    #0
-
-                    (#e.Success [_ parsed])
-                    (:: code.Equivalence = parsed sample)))
-            (test "Can parse Lux multiple code nodes."
-                  (case (&.read "" (dict.new text.Hash)
-                                [default-cursor +0 (format (code.to-text sample) " "
-                                                           (code.to-text other))])
-                    (#e.Error error)
-                    #0
-
-                    (#e.Success [remaining =sample])
-                    (case (&.read "" (dict.new text.Hash)
-                                  remaining)
-                      (#e.Error error)
-                      #0
-
-                      (#e.Success [_ =other])
-                      (and (:: code.Equivalence = sample =sample)
-                           (:: code.Equivalence = other =other)))))
-            ))))
-
-(context: "Frac special syntax."
-  (<| (times +100)
-      (do @
-        [numerator (|> r.nat (:: @ map (|>> (n/% +100) .int int-to-frac)))
-         denominator (|> r.nat (:: @ map (|>> (n/% +100) (n/max +1) .int int-to-frac)))
-         signed? r.bit
-         #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 1.0)))]]
-        (test "Can parse frac ratio syntax."
-              (case (&.read "" (dict.new text.Hash)
-                            [default-cursor +0
-                             (format (if signed? "-" "")
-                                     (%i (frac-to-int numerator))
-                                     "/"
-                                     (%i (frac-to-int denominator)))])
-                (#e.Success [_ [_ (#.Frac actual)]])
-                (f/= expected actual)
-
-                _
-                #0)
-              ))))
-
-(context: "Nat special syntax."
-  (<| (times +100)
-      (do @
-        [expected (|> r.nat (:: @ map (n/% +1_000)))]
-        (test "Can parse nat char syntax."
-              (case (&.read "" (dict.new text.Hash)
-                            [default-cursor +0
-                             (format "#" (%t (text.from-code expected)) "")])
-                (#e.Success [_ [_ (#.Nat actual)]])
-                (n/= expected actual)
-
-                _
-                #0)
-              ))))
-
-(def: comment-text^
-  (r.Random Text)
-  (let [char-gen (|> r.nat (r.filter (function (_ value)
-                                       (not (or (text.space? value)
-                                                (n/= (char "#") value)
-                                                (n/= (char "(") value)
-                                                (n/= (char ")") value))))))]
-    (do r.Monad
-      [size (|> r.nat (r/map (n/% +20)))]
-      (r.text char-gen size))))
-
-(def: comment^
-  (r.Random Text)
-  (r.either (do r.Monad
-              [comment comment-text^]
-              (wrap (format "## " comment "\n")))
-            (r.rec (function (_ nested^)
-                     (do r.Monad
-                       [comment (r.either comment-text^
-                                          nested^)]
-                       (wrap (format "#( " comment " )#")))))))
-
-(context: "Multi-line text & comments."
-  (<| (seed +12137892244981970631)
-      ## (times +100)
-      (do @
-        [#let [char-gen (|> r.nat (r.filter (function (_ value)
-                                              (not (or (text.space? value)
-                                                       (n/= (char "\"") value))))))]
-         x char-gen
-         y char-gen
-         z char-gen
-         offset-size (|> r.nat (r/map (|>> (n/% +10) (n/max +1))))
-         #let [offset (text.join-with "" (list.repeat offset-size " "))]
-         sample code^
-         comment comment^
-         unbalanced-comment comment-text^]
-        ($_ seq
-            (test "Will reject invalid multi-line text."
-                  (let [bad-match (format (text.from-code x) "\n"
-                                          (text.from-code y) "\n"
-                                          (text.from-code z))]
-                    (case (&.read "" (dict.new text.Hash)
-                                  [default-cursor +0
-                                   (format "\"" bad-match "\"")])
-                      (#e.Error error)
-                      #1
-
-                      (#e.Success [_ parsed])
-                      #0)))
-            (test "Will accept valid multi-line text"
-                  (let [good-input (format (text.from-code x) "\n"
-                                           offset (text.from-code y) "\n"
-                                           offset (text.from-code z))
-                        good-output (format (text.from-code x) "\n"
-                                            (text.from-code y) "\n"
-                                            (text.from-code z))]
-                    (case (&.read "" (dict.new text.Hash)
-                                  [(|> default-cursor (update@ #.column (n/+ (dec offset-size))))
-                                   +0
-                                   (format "\"" good-input "\"")])
-                      (#e.Error error)
-                      #0
-
-                      (#e.Success [_ parsed])
-                      (:: code.Equivalence =
-                          parsed
-                          (code.text good-output)))))
-            (test "Can handle comments."
-                  (case (&.read "" (dict.new text.Hash)
-                                [default-cursor +0
-                                 (format comment (code.to-text sample))])
-                    (#e.Error error)
-                    #0
-
-                    (#e.Success [_ parsed])
-                    (:: code.Equivalence = parsed sample)))
-            (test "Will reject unbalanced multi-line comments."
-                  (and (case (&.read "" (dict.new text.Hash)
-                                     [default-cursor +0
-                                      (format "#(" "#(" unbalanced-comment ")#"
-                                              (code.to-text sample))])
-                         (#e.Error error)
-                         #1
-
-                         (#e.Success [_ parsed])
-                         #0)
-                       (case (&.read "" (dict.new text.Hash)
-                                     [default-cursor +0
-                                      (format "#(" unbalanced-comment ")#" ")#"
-                                              (code.to-text sample))])
-                         (#e.Error error)
-                         #1
-
-                         (#e.Success [_ parsed])
-                         #0)))
-            ))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index bdd8ef0ab..e855220dd 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -39,32 +39,31 @@
    [world
     ["._" environment]
     ["._" console]]
-   [language
+   [compiler
     [host
      [".H" scheme]]
-    [compiler
-     ["._" translation
-      [scheme
-       ["._scheme" primitive]
-       ["._scheme" structure]
-       ["._scheme" reference]
-       ["._scheme" function]
-       ["._scheme" loop]
-       ["._scheme" case]
-       ["._scheme" extension]
-       ["._scheme" extension/common]
-       ["._scheme" expression]]]
-     [default
-      [repl
-       ["._" type]]]
-     [meta
-      ["._meta" io
-       ["._meta_io" context]
-       ["._meta_io" archive]]
-      ["._meta" archive]
-      ["._meta" cache]]
-     [default
-      ["._default" cache]]]]]
+    [default
+     [phase
+      ["._" translation
+       [scheme
+        ["._scheme" primitive]
+        ["._scheme" structure]
+        ["._scheme" reference]
+        ["._scheme" function]
+        ["._scheme" loop]
+        ["._scheme" case]
+        ["._scheme" extension]
+        ["._scheme" extension/common]
+        ["._scheme" expression]]]]
+     ["._default" cache]
+     [repl
+      ["._" type]]]
+    [meta
+     ["._meta" io
+      ["._meta_io" context]
+      ["._meta_io" archive]]
+     ["._meta" archive]
+     ["._meta" cache]]]]
   [test
    ["_." lux]
    [lux
@@ -150,22 +149,23 @@
      [object
       ["_." interface]
       ["_." protocol]]]
-    [language
-     ["_language/." syntax]
-     [compiler
-      [analysis
-       ["_.A" primitive]
-       ["_.A" structure]
-       ["_.A" reference]
-       ["_.A" case]
-       ["_.A" function]
-       [procedure
-        ["_.A" common]]]
-      [synthesis
-       ["_.S" primitive]
-       ["_.S" structure]
-       ["_.S" case]
-       ["_.S" function]]]]
+    [compiler
+     [default
+      ["_default/." syntax]
+      [phase
+       [analysis
+        ["_.A" primitive]
+        ["_.A" structure]
+        ["_.A" reference]
+        ["_.A" case]
+        ["_.A" function]
+        [procedure
+         ["_.A" common]]]
+       [synthesis
+        ["_.S" primitive]
+        ["_.S" structure]
+        ["_.S" case]
+        ["_.S" function]]]]]
     [world
      ["_." binary]
      ## ["_." file] ## TODO: Specially troublesome...
-- 
cgit v1.2.3