From 842aba98d9213b26df3f0b37c5293d18922cf7fa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 10 Jul 2018 21:26:11 -0400 Subject: - Re-named path "lux/lang/*" to "lux/language/*". --- stdlib/source/lux/data/text/buffer.lux | 2 +- stdlib/source/lux/data/text/encoding.lux | 2 +- stdlib/source/lux/data/text/format.lux | 2 +- stdlib/source/lux/host.jvm.lux | 2 +- stdlib/source/lux/lang.lux | 9 - stdlib/source/lux/lang/compiler.lux | 79 -- stdlib/source/lux/lang/compiler/analysis.lux | 281 ----- stdlib/source/lux/lang/compiler/analysis/case.lux | 290 ----- .../lux/lang/compiler/analysis/case/coverage.lux | 321 ----- .../lux/lang/compiler/analysis/expression.lux | 121 -- .../source/lux/lang/compiler/analysis/function.lux | 99 -- .../lux/lang/compiler/analysis/inference.lux | 254 ---- .../lux/lang/compiler/analysis/primitive.lux | 28 - .../lux/lang/compiler/analysis/reference.lux | 77 -- .../lux/lang/compiler/analysis/structure.lux | 354 ------ stdlib/source/lux/lang/compiler/analysis/type.lux | 61 - stdlib/source/lux/lang/compiler/default/cache.lux | 33 - .../source/lux/lang/compiler/default/repl/type.lux | 197 --- stdlib/source/lux/lang/compiler/extension.lux | 64 - .../lux/lang/compiler/extension/analysis.lux | 18 - .../lang/compiler/extension/analysis/common.lux | 375 ------ .../lang/compiler/extension/analysis/host.jvm.lux | 1268 -------------------- .../source/lux/lang/compiler/extension/bundle.lux | 31 - .../lux/lang/compiler/extension/synthesis.lux | 9 - .../lux/lang/compiler/extension/translation.lux | 9 - stdlib/source/lux/lang/compiler/init.lux | 51 - stdlib/source/lux/lang/compiler/meta/archive.lux | 117 -- stdlib/source/lux/lang/compiler/meta/cache.lux | 162 --- .../lux/lang/compiler/meta/cache/dependency.lux | 51 - stdlib/source/lux/lang/compiler/meta/io.lux | 18 - .../source/lux/lang/compiler/meta/io/archive.lux | 70 -- .../source/lux/lang/compiler/meta/io/context.lux | 89 -- stdlib/source/lux/lang/compiler/synthesis.lux | 241 ---- stdlib/source/lux/lang/compiler/synthesis/case.lux | 177 --- .../lux/lang/compiler/synthesis/expression.lux | 99 -- .../lux/lang/compiler/synthesis/function.lux | 130 -- stdlib/source/lux/lang/compiler/synthesis/loop.lux | 285 ----- stdlib/source/lux/lang/compiler/translation.lux | 162 --- .../lang/compiler/translation/scheme/case.jvm.lux | 170 --- .../compiler/translation/scheme/expression.jvm.lux | 54 - .../compiler/translation/scheme/extension.jvm.lux | 32 - .../translation/scheme/extension/common.jvm.lux | 376 ------ .../compiler/translation/scheme/function.jvm.lux | 85 -- .../lang/compiler/translation/scheme/loop.jvm.lux | 36 - .../compiler/translation/scheme/primitive.jvm.lux | 22 - .../compiler/translation/scheme/reference.jvm.lux | 54 - .../compiler/translation/scheme/runtime.jvm.lux | 362 ------ .../compiler/translation/scheme/structure.jvm.lux | 29 - stdlib/source/lux/lang/host.lux | 18 - stdlib/source/lux/lang/host/scheme.lux | 302 ----- stdlib/source/lux/lang/module.lux | 240 ---- stdlib/source/lux/lang/name.lux | 47 - stdlib/source/lux/lang/reference.lux | 66 - stdlib/source/lux/lang/scope.lux | 188 --- stdlib/source/lux/lang/syntax.lux | 626 ---------- stdlib/source/lux/lang/type.lux | 389 ------ stdlib/source/lux/lang/type/check.lux | 681 ----------- stdlib/source/lux/language.lux | 9 + stdlib/source/lux/language/compiler.lux | 79 ++ stdlib/source/lux/language/compiler/analysis.lux | 281 +++++ .../source/lux/language/compiler/analysis/case.lux | 290 +++++ .../language/compiler/analysis/case/coverage.lux | 321 +++++ .../lux/language/compiler/analysis/expression.lux | 121 ++ .../lux/language/compiler/analysis/function.lux | 99 ++ .../lux/language/compiler/analysis/inference.lux | 254 ++++ .../lux/language/compiler/analysis/primitive.lux | 28 + .../lux/language/compiler/analysis/reference.lux | 77 ++ .../lux/language/compiler/analysis/structure.lux | 354 ++++++ .../source/lux/language/compiler/analysis/type.lux | 61 + .../source/lux/language/compiler/default/cache.lux | 33 + .../lux/language/compiler/default/repl/type.lux | 197 +++ stdlib/source/lux/language/compiler/extension.lux | 64 + .../lux/language/compiler/extension/analysis.lux | 18 + .../compiler/extension/analysis/common.lux | 375 ++++++ .../compiler/extension/analysis/host.jvm.lux | 1268 ++++++++++++++++++++ .../lux/language/compiler/extension/bundle.lux | 31 + .../lux/language/compiler/extension/synthesis.lux | 9 + .../language/compiler/extension/translation.lux | 9 + stdlib/source/lux/language/compiler/init.lux | 51 + .../source/lux/language/compiler/meta/archive.lux | 117 ++ stdlib/source/lux/language/compiler/meta/cache.lux | 162 +++ .../language/compiler/meta/cache/dependency.lux | 51 + stdlib/source/lux/language/compiler/meta/io.lux | 18 + .../lux/language/compiler/meta/io/archive.lux | 70 ++ .../lux/language/compiler/meta/io/context.lux | 89 ++ stdlib/source/lux/language/compiler/synthesis.lux | 241 ++++ .../lux/language/compiler/synthesis/case.lux | 177 +++ .../lux/language/compiler/synthesis/expression.lux | 99 ++ .../lux/language/compiler/synthesis/function.lux | 130 ++ .../lux/language/compiler/synthesis/loop.lux | 285 +++++ .../source/lux/language/compiler/translation.lux | 162 +++ .../compiler/translation/scheme/case.jvm.lux | 170 +++ .../compiler/translation/scheme/expression.jvm.lux | 54 + .../compiler/translation/scheme/extension.jvm.lux | 32 + .../translation/scheme/extension/common.jvm.lux | 376 ++++++ .../compiler/translation/scheme/function.jvm.lux | 85 ++ .../compiler/translation/scheme/loop.jvm.lux | 36 + .../compiler/translation/scheme/primitive.jvm.lux | 22 + .../compiler/translation/scheme/reference.jvm.lux | 54 + .../compiler/translation/scheme/runtime.jvm.lux | 362 ++++++ .../compiler/translation/scheme/structure.jvm.lux | 29 + stdlib/source/lux/language/host.lux | 18 + stdlib/source/lux/language/host/scheme.lux | 302 +++++ stdlib/source/lux/language/module.lux | 240 ++++ stdlib/source/lux/language/name.lux | 47 + stdlib/source/lux/language/reference.lux | 66 + stdlib/source/lux/language/scope.lux | 188 +++ stdlib/source/lux/language/syntax.lux | 626 ++++++++++ stdlib/source/lux/language/type.lux | 389 ++++++ stdlib/source/lux/language/type/check.lux | 681 +++++++++++ stdlib/source/lux/macro/poly.lux | 4 +- stdlib/source/lux/macro/poly/equivalence.lux | 2 +- stdlib/source/lux/macro/poly/functor.lux | 2 +- stdlib/source/lux/macro/poly/json.lux | 2 +- stdlib/source/lux/type/abstract.lux | 2 +- stdlib/source/lux/type/implicit.lux | 4 +- stdlib/source/lux/type/object/interface.lux | 2 +- stdlib/source/lux/type/quotient.lux | 2 +- stdlib/source/lux/type/refinement.lux | 2 +- stdlib/source/lux/world/file.lux | 4 +- .../test/test/lux/lang/compiler/analysis/case.lux | 194 --- .../test/lux/lang/compiler/analysis/function.lux | 112 -- .../test/lux/lang/compiler/analysis/primitive.lux | 86 -- .../lang/compiler/analysis/procedure/common.lux | 310 ----- .../lang/compiler/analysis/procedure/host.jvm.lux | 541 --------- .../test/lux/lang/compiler/analysis/reference.lux | 102 -- .../test/lux/lang/compiler/analysis/structure.lux | 292 ----- .../test/test/lux/lang/compiler/synthesis/case.lux | 82 -- .../test/lux/lang/compiler/synthesis/function.lux | 168 --- .../test/lux/lang/compiler/synthesis/primitive.lux | 92 -- .../test/lux/lang/compiler/synthesis/structure.lux | 57 - stdlib/test/test/lux/lang/syntax.lux | 242 ---- stdlib/test/test/lux/lang/type.lux | 163 --- stdlib/test/test/lux/lang/type/check.lux | 262 ---- .../test/lux/language/compiler/analysis/case.lux | 194 +++ .../lux/language/compiler/analysis/function.lux | 112 ++ .../lux/language/compiler/analysis/primitive.lux | 86 ++ .../compiler/analysis/procedure/common.lux | 310 +++++ .../compiler/analysis/procedure/host.jvm.lux | 541 +++++++++ .../lux/language/compiler/analysis/reference.lux | 102 ++ .../lux/language/compiler/analysis/structure.lux | 292 +++++ .../test/lux/language/compiler/synthesis/case.lux | 82 ++ .../lux/language/compiler/synthesis/function.lux | 168 +++ .../lux/language/compiler/synthesis/primitive.lux | 92 ++ .../lux/language/compiler/synthesis/structure.lux | 57 + stdlib/test/test/lux/language/syntax.lux | 242 ++++ stdlib/test/test/lux/language/type.lux | 163 +++ stdlib/test/test/lux/language/type/check.lux | 262 ++++ stdlib/test/test/lux/math/modular.lux | 2 +- 149 files changed, 12128 insertions(+), 12128 deletions(-) delete mode 100644 stdlib/source/lux/lang.lux delete mode 100644 stdlib/source/lux/lang/compiler.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/case.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/case/coverage.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/expression.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/function.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/inference.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/primitive.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/reference.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/structure.lux delete mode 100644 stdlib/source/lux/lang/compiler/analysis/type.lux delete mode 100644 stdlib/source/lux/lang/compiler/default/cache.lux delete mode 100644 stdlib/source/lux/lang/compiler/default/repl/type.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/analysis.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/analysis/common.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/analysis/host.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/bundle.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/synthesis.lux delete mode 100644 stdlib/source/lux/lang/compiler/extension/translation.lux delete mode 100644 stdlib/source/lux/lang/compiler/init.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/archive.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/cache.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/cache/dependency.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/io.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/io/archive.lux delete mode 100644 stdlib/source/lux/lang/compiler/meta/io/context.lux delete mode 100644 stdlib/source/lux/lang/compiler/synthesis.lux delete mode 100644 stdlib/source/lux/lang/compiler/synthesis/case.lux delete mode 100644 stdlib/source/lux/lang/compiler/synthesis/expression.lux delete mode 100644 stdlib/source/lux/lang/compiler/synthesis/function.lux delete mode 100644 stdlib/source/lux/lang/compiler/synthesis/loop.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/case.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/expression.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/extension.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/extension/common.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/function.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/loop.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/primitive.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/reference.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/runtime.jvm.lux delete mode 100644 stdlib/source/lux/lang/compiler/translation/scheme/structure.jvm.lux delete mode 100644 stdlib/source/lux/lang/host.lux delete mode 100644 stdlib/source/lux/lang/host/scheme.lux delete mode 100644 stdlib/source/lux/lang/module.lux delete mode 100644 stdlib/source/lux/lang/name.lux delete mode 100644 stdlib/source/lux/lang/reference.lux delete mode 100644 stdlib/source/lux/lang/scope.lux delete mode 100644 stdlib/source/lux/lang/syntax.lux delete mode 100644 stdlib/source/lux/lang/type.lux delete mode 100644 stdlib/source/lux/lang/type/check.lux create mode 100644 stdlib/source/lux/language.lux create mode 100644 stdlib/source/lux/language/compiler.lux create mode 100644 stdlib/source/lux/language/compiler/analysis.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/case.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/case/coverage.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/expression.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/function.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/inference.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/primitive.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/reference.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/structure.lux create mode 100644 stdlib/source/lux/language/compiler/analysis/type.lux create mode 100644 stdlib/source/lux/language/compiler/default/cache.lux create mode 100644 stdlib/source/lux/language/compiler/default/repl/type.lux create mode 100644 stdlib/source/lux/language/compiler/extension.lux create mode 100644 stdlib/source/lux/language/compiler/extension/analysis.lux create mode 100644 stdlib/source/lux/language/compiler/extension/analysis/common.lux create mode 100644 stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/extension/bundle.lux create mode 100644 stdlib/source/lux/language/compiler/extension/synthesis.lux create mode 100644 stdlib/source/lux/language/compiler/extension/translation.lux create mode 100644 stdlib/source/lux/language/compiler/init.lux create mode 100644 stdlib/source/lux/language/compiler/meta/archive.lux create mode 100644 stdlib/source/lux/language/compiler/meta/cache.lux create mode 100644 stdlib/source/lux/language/compiler/meta/cache/dependency.lux create mode 100644 stdlib/source/lux/language/compiler/meta/io.lux create mode 100644 stdlib/source/lux/language/compiler/meta/io/archive.lux create mode 100644 stdlib/source/lux/language/compiler/meta/io/context.lux create mode 100644 stdlib/source/lux/language/compiler/synthesis.lux create mode 100644 stdlib/source/lux/language/compiler/synthesis/case.lux create mode 100644 stdlib/source/lux/language/compiler/synthesis/expression.lux create mode 100644 stdlib/source/lux/language/compiler/synthesis/function.lux create mode 100644 stdlib/source/lux/language/compiler/synthesis/loop.lux create mode 100644 stdlib/source/lux/language/compiler/translation.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux create mode 100644 stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux create mode 100644 stdlib/source/lux/language/host.lux create mode 100644 stdlib/source/lux/language/host/scheme.lux create mode 100644 stdlib/source/lux/language/module.lux create mode 100644 stdlib/source/lux/language/name.lux create mode 100644 stdlib/source/lux/language/reference.lux create mode 100644 stdlib/source/lux/language/scope.lux create mode 100644 stdlib/source/lux/language/syntax.lux create mode 100644 stdlib/source/lux/language/type.lux create mode 100644 stdlib/source/lux/language/type/check.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/case.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/function.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/primitive.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/procedure/common.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/procedure/host.jvm.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/reference.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/analysis/structure.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/synthesis/case.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/synthesis/function.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux delete mode 100644 stdlib/test/test/lux/lang/compiler/synthesis/structure.lux delete mode 100644 stdlib/test/test/lux/lang/syntax.lux delete mode 100644 stdlib/test/test/lux/lang/type.lux delete mode 100644 stdlib/test/test/lux/lang/type/check.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/case.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/function.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/primitive.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/reference.lux create mode 100644 stdlib/test/test/lux/language/compiler/analysis/structure.lux create mode 100644 stdlib/test/test/lux/language/compiler/synthesis/case.lux create mode 100644 stdlib/test/test/lux/language/compiler/synthesis/function.lux create mode 100644 stdlib/test/test/lux/language/compiler/synthesis/primitive.lux create mode 100644 stdlib/test/test/lux/language/compiler/synthesis/structure.lux create mode 100644 stdlib/test/test/lux/language/syntax.lux create mode 100644 stdlib/test/test/lux/language/type.lux create mode 100644 stdlib/test/test/lux/language/type/check.lux diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 0641ba215..8721b957d 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -3,7 +3,7 @@ (lux (data [product] text/format (collection [row #+ Row "row/" Fold])) - (lang ["_" host]) + (language ["_" host]) (type abstract) [host #+ import:]) [//]) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index eb3b618c4..b4e6fe113 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -2,7 +2,7 @@ lux (lux (data [error #+ Error]) (world [blob #+ Blob]) - (lang ["_" host]) + (language ["_" host]) [host #+ import:])) (`` (for {(~~ (static _.jvm)) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 26fca323d..16651957e 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -16,7 +16,7 @@ [macro] (macro [code] ["s" syntax #+ syntax: Syntax]) - (lang [type]) + (language [type]) )) ## [Syntax] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 43a78472b..4a680a5a8 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -15,7 +15,7 @@ [macro #+ with-gensyms Functor Monad] (macro [code] ["s" syntax #+ syntax: Syntax]) - (lang [type "type/" Equivalence]) + (language [type "type/" Equivalence]) )) (do-template [ ] diff --git a/stdlib/source/lux/lang.lux b/stdlib/source/lux/lang.lux deleted file mode 100644 index bc6e2c9ec..000000000 --- a/stdlib/source/lux/lang.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/lang/compiler.lux b/stdlib/source/lux/lang/compiler.lux deleted file mode 100644 index 2e88938de..000000000 --- a/stdlib/source/lux/lang/compiler.lux +++ /dev/null @@ -1,79 +0,0 @@ -(.module: - lux - (lux (control [state] - ["ex" exception #+ Exception exception:] - [monad #+ do]) - (data [product] - [error #+ Error] - [text] - text/format) - [function] - (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 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 (localized transform) - (All [s o] - (-> (-> s s) - (-> (Operation s o) (Operation s o)))) - (function (_ operation) - (function (_ state) - (case (operation (transform state)) - (#error.Error error) - (#error.Error error) - - (#error.Success [state' output]) - (#error.Success [state output]))))) - -(def: #export (with-state state) - (All [s o] (-> s (-> (Operation s o) (Operation s o)))) - (localized (function.constant state))) - -(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/lang/compiler/analysis.lux b/stdlib/source/lux/lang/compiler/analysis.lux deleted file mode 100644 index 87a4cbe4f..000000000 --- a/stdlib/source/lux/lang/compiler/analysis.lux +++ /dev/null @@ -1,281 +0,0 @@ -(.module: - [lux #- nat int rev] - (lux (data [product] - [error] - [text "text/" Equivalence] - (collection [list "list/" Fold])) - [function]) - [///reference #+ Register Variable Reference] - [//]) - -(type: #export #rec Primitive - #Unit - (#Bool Bool) - (#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)) - -(type: #export Operation - (//.Operation .Lux)) - -(type: #export Compiler - (//.Compiler .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))] - - [bool Bool #Bool] - [nat Nat #Nat] - [int Int #Int] - [rev Rev #Rev] - [frac Frac #Frac] - [text Text #Text] - ) - -(type: #export (Variant a) - {#lefts Nat - #right? Bool - #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 Bool) - (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? false - #value valueA})) - - ( (#Sum (#.Right valueA))) - (#.Some {#lefts lefts - #right? true - #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/bool #..Bool] - [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 (_ compiler) - (let [old-source (get@ #.source compiler)] - (case (action (set@ #.source source compiler)) - (#error.Error error) - (#error.Error error) - - (#error.Success [compiler' output]) - (#error.Success [(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 (_ compiler) - (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler)) - (#error.Success [compiler' output]) - (case (get@ #.scopes compiler') - #.Nil - (#error.Error "Impossible error: Drained scopes!") - - (#.Cons head tail) - (#error.Success [(set@ #.scopes tail compiler') - [head output]])) - - (#error.Error error) - (#error.Error error)))) - -(def: #export (with-current-module name action) - (All [a] (-> Text (Operation a) (Operation a))) - (function (_ compiler) - (case (action (set@ #.current-module (#.Some name) compiler)) - (#error.Success [compiler' output]) - (#error.Success [(set@ #.current-module - (get@ #.current-module compiler) - compiler') - output]) - - (#error.Error error) - (#error.Error error)))) - -(def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Operation a) (Operation a))) - (if (text/= "" (product.left cursor)) - action - (function (_ compiler) - (let [old-cursor (get@ #.cursor compiler)] - (case (action (set@ #.cursor cursor compiler)) - (#error.Success [compiler' output]) - (#error.Success [(set@ #.cursor old-cursor compiler') - output]) - - (#error.Error error) - (#error.Error error)))))) diff --git a/stdlib/source/lux/lang/compiler/analysis/case.lux b/stdlib/source/lux/lang/compiler/analysis/case.lux deleted file mode 100644 index fc1e83d4a..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/case.lux +++ /dev/null @@ -1,290 +0,0 @@ -(.module: - [lux #- case] - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [product] - [error] - [maybe] - text/format - (collection [list "list/" Fold Monoid Functor])) - [macro] - (macro [code])) - (//// [type] - (type ["tc" check]) - [scope]) - [///] - [// #+ Pattern Analysis Operation Compiler] - [//type] - [//structure] - [/coverage]) - -(exception: #export (cannot-match-type-with-pattern {type Type} {pattern Code}) - (ex.report ["Type" (%type type)] - ["Pattern" (%code pattern)])) - -(exception: #export (sum-type-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-type-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-type caseT) - (-> Type (Operation Type)) - (loop [envs (: (List (List Type)) - (list)) - caseT caseT] - (.case caseT - (#.Var id) - (do ///.Monad - [?caseT' (//type.with-env - (tc.read id))] - (.case ?caseT' - (#.Some caseT') - (recur envs caseT') - - _ - (///.throw cannot-simplify-type-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 - tc.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 tc.Monad - [?funct' (tc.read funcT-id)] - (.case ?funct' - (#.Some funct') - (wrap funct') - - _ - (tc.throw cannot-simplify-type-for-pattern-matching caseT))))] - (recur envs (#.Apply inputT funcT'))) - - _ - (.case (type.apply (list inputT) funcT) - (#.Some outputT) - (recur envs outputT) - - #.None - (///.throw cannot-simplify-type-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 - (tc.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)) - ([Bool (#.Bool pattern-value) (#//.Bool 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-type inputT)] - (.case inputT' - (#.Product _) - (let [sub-types (type.flatten-tuple inputT') - num-sub-types (maybe.default (list.size sub-types) - num-tags) - num-sub-patterns (list.size sub-patterns) - matches (cond (n/< num-sub-types num-sub-patterns) - (let [[prefix suffix] (list.split (dec num-sub-patterns) sub-types)] - (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns)) - - (n/> num-sub-types num-sub-patterns) - (let [[prefix suffix] (list.split (dec num-sub-types) sub-patterns)] - (list.zip2 sub-types (list/compose prefix (list (code.tuple suffix))))) - - ## (n/= num-sub-types num-sub-patterns) - (list.zip2 sub-types 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-type-with-pattern [inputT pattern]) - ))) - - [cursor (#.Record record)] - (do ///.Monad - [record (//structure.normalize record) - [members recordT] (//structure.order record) - _ (//type.with-env - (tc.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-type 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 case-type) - (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 case-type (` [(~+ values)]) next))] - (wrap [(//.sum-pattern num-cases idx testP) - nextA])) - - _ - (///.throw sum-type-has-no-case [idx inputT]))) - - _ - (///.throw cannot-match-type-with-pattern [inputT pattern])))) - - (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))]) - (//.with-cursor cursor - (do ///.Monad - [tag (macro.normalize tag) - [idx group variantT] (macro.resolve-tag tag) - _ (//type.with-env - (tc.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/lang/compiler/analysis/case/coverage.lux b/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux deleted file mode 100644 index 70c9fa80f..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/case/coverage.lux +++ /dev/null @@ -1,321 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - equivalence) - (data [bool "bool/" 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? false - #///.value valueP}) - - (#.Right valueP) - {#///.lefts lefts - #///.right? true - #///.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 booleans -## and variants. -(type: #export #rec Coverage - #Partial - (#Bool Bool) - (#Variant (Maybe Nat) (Dictionary Nat Coverage)) - (#Seq Coverage Coverage) - (#Alt Coverage Coverage) - #Exhaustive) - -(def: #export (exhaustive? coverage) - (-> Coverage Bool) - (case coverage - (#Exhaustive _) - true - - _ - false)) - -(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]) - - ## Bools are the exception, since there is only "true" and - ## "false", which means it is possible for boolean - ## pattern-matching to become exhaustive if complementary parts meet. - (#///.Simple (#///.Bool value)) - (operation/wrap (#Bool 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) - (-> Bool Bool Bool) - (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] - true - - [(#Bool sideR) (#Bool sideS)] - (bool/= 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)))) - - _ - false))) - -(open: "C/" 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 boolean coverages are exhaustive if they compliment one another. - (^multi [(#Bool sideA) (#Bool 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 [(C/= leftSF leftA) (C/= rightSF rightA)] - ## There is nothing the addition adds to the coverage. - [true true] - redundant-pattern - - ## The 2 sequences cannot possibly be merged. - [false false] - (error/wrap (#Alt so-far addition)) - - ## Same prefix - [true false] - (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 - [false true] - (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] - (C/= left single)) - redundant-pattern - - ## The right part is not necessary, since it can always match the left. - (^multi [single (#Seq left right)] - (C/= 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 (C/= 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/lang/compiler/analysis/expression.lux b/stdlib/source/lux/lang/compiler/analysis/expression.lux deleted file mode 100644 index 2ef2cae5b..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/expression.lux +++ /dev/null @@ -1,121 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data ["e" error] - [product] - text/format) - [macro]) - [//// #+ Eval] - ## (//// [".L" macro] - ## [".L" extension]) - [///] - [// #+ Analysis Operation Compiler] - [//type] - [//primitive] - [//structure] - [//reference]) - -(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 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)) - ([#.Bool //primitive.bool] - [#.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))) - (undefined) - ## (do ///.Monad - ## [extension (extensionL.find-analysis extension-name)] - ## (extension compile eval 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 - ## (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/lang/compiler/analysis/function.lux b/stdlib/source/lux/lang/compiler/analysis/function.lux deleted file mode 100644 index f8d8b826b..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/function.lux +++ /dev/null @@ -1,99 +0,0 @@ -(.module: - [lux #- function] - (lux (control monad - ["ex" exception #+ exception:]) - (data [maybe] - [text] - text/format - (collection [list "list/" Fold Monoid Monad])) - [macro] - (macro [code]) - (lang [type] - (type ["tc" check]) - [".L" scope])) - [///] - [// #+ Analysis Compiler] - [//type] - [//inference]) - -(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 (Meta Analysis)) - (do macro.Monad - [functionT 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 tc.existential] - [#.ExQ tc.var]) - - (#.Var id) - (do @ - [?expectedT' (//type.with-env - (tc.read id))] - (case ?expectedT' - (#.Some expectedT') - (recur expectedT') - - ## Inference - _ - (do @ - [[input-id inputT] (//type.with-env tc.var) - [output-id outputT] (//type.with-env tc.var) - #let [functionT (#.Function inputT outputT)] - functionA (recur functionT) - _ (//type.with-env - (tc.check expectedT functionT))] - (wrap functionA)) - )) - - (#.Function inputT outputT) - (<| (:: @ map (.function (_ [scope bodyA]) - (#//.Function (scopeL.environment scope) bodyA))) - //.with-scope - ## Functions have access not only to their argument, but - ## also to themselves, through a local variable. - (scopeL.with-local [function-name expectedT]) - (scopeL.with-local [arg-name inputT]) - (//type.with-type outputT) - (analyse body)) - - _ - (///.fail "") - ))))) - -(def: #export (apply analyse functionT functionA args) - (-> Compiler Type Analysis (List Code) (Meta Analysis)) - (<| (///.with-stack cannot-apply [functionT args]) - (do macro.Monad - [[applyT argsA] (//inference.general analyse functionT args)]) - (wrap (//.apply [functionA argsA])))) diff --git a/stdlib/source/lux/lang/compiler/analysis/inference.lux b/stdlib/source/lux/lang/compiler/analysis/inference.lux deleted file mode 100644 index a89ed40f8..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/inference.lux +++ /dev/null @@ -1,254 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - [text] - text/format - (collection [list "list/" Functor])) - [macro]) - (//// [type] - (type ["tc" check])) - [/// #+ "operation/" Monad] - [// #+ 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: new-named-type - (Operation Type) - (do ///.Monad - [[module line column] macro.cursor - [ex-id _] (//type.with-env tc.existential)] - (wrap (#.Primitive (format "{New Type @ " (%t module) - "," (%n line) - "," (%n column) - "} " (%n ex-id)) - (list))))) - -## 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 tc.var)] - (general analyse (maybe.assume (type.apply (list varT) inferT)) args)) - - (#.ExQ _) - (do ///.Monad - [[var-id varT] (//type.with-env tc.var) - output (general analyse - (maybe.assume (type.apply (list varT) inferT)) - args) - bound? (//type.with-env - (tc.bound? var-id)) - _ (if bound? - (wrap []) - (do @ - [newT new-named-type] - (//type.with-env - (tc.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 (tc.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/lang/compiler/analysis/primitive.lux b/stdlib/source/lux/lang/compiler/analysis/primitive.lux deleted file mode 100644 index 5f6604926..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/primitive.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux #- nat int rev] - (lux (control monad) - [macro]) - [// #+ Analysis] - (// [".A" type])) - -## [Analysers] -(do-template [ ] - [(def: #export ( value) - (-> (Meta Analysis)) - (do macro.Monad - [_ (typeA.infer )] - (wrap (#//.Primitive ( value)))))] - - [bool Bool #//.Bool] - [nat Nat #//.Nat] - [int Int #//.Int] - [rev Rev #//.Rev] - [frac Frac #//.Frac] - [text Text #//.Text] - ) - -(def: #export unit - (Meta Analysis) - (do macro.Monad - [_ (typeA.infer Any)] - (wrap (#//.Primitive #//.Unit)))) diff --git a/stdlib/source/lux/lang/compiler/analysis/reference.lux b/stdlib/source/lux/lang/compiler/analysis/reference.lux deleted file mode 100644 index a3436d15b..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/reference.lux +++ /dev/null @@ -1,77 +0,0 @@ -(.module: - lux - (lux (control monad - ["ex" exception #+ exception:]) - [macro] - (macro [code]) - (lang (type ["tc" check])) - (data [text "text/" Equivalence] - text/format)) - [///] - [// #+ Analysis Operation] - [//type] - [////reference] - [////scope]) - -(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 _] (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]) (macro.normalize def-name) - current macro.current-module-name] - (if (text/= current ::module) - - (if (macro.export? def-anns) - (do @ - [imported! (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 macro.current-module-name] - (definition [this-module simple-name])))) - - _ - (definition reference))) diff --git a/stdlib/source/lux/lang/compiler/analysis/structure.lux b/stdlib/source/lux/lang/compiler/analysis/structure.lux deleted file mode 100644 index 087ffa8c5..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/structure.lux +++ /dev/null @@ -1,354 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [ident] - [number] - [product] - [maybe] - (collection [list "list/" Functor] - ["dict" dictionary #+ Dictionary]) - text/format) - [macro] - (macro [code])) - (//// [type] - (type ["tc" check])) - [///] - [// #+ Tag Analysis Operation Compiler] - [//type] - [//primitive] - [//inference]) - -(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 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 - (tc.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 tc.existential] - [#.ExQ tc.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) - (do @ - [?funT' (//type.with-env (tc.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 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 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 - (tc.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 - (tc.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 tc.existential] - [#.ExQ tc.var]) - - (#.Apply inputT funT) - (case funT - (#.Var funT-id) - (do @ - [?funT' (//type.with-env (tc.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 (macro.normalize tag) - [idx group variantT] (macro.resolve-tag tag) - expectedT 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 (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 (macro.normalize head-k) - [_ tag-set recordT] (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 (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 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/lang/compiler/analysis/type.lux b/stdlib/source/lux/lang/compiler/analysis/type.lux deleted file mode 100644 index 9fcfb2743..000000000 --- a/stdlib/source/lux/lang/compiler/analysis/type.lux +++ /dev/null @@ -1,61 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [error]) - [macro] - (lang (type ["tc" check]))) - [///] - [// #+ Operation]) - -(def: #export (with-type expected action) - (All [a] (-> Type (Operation a) (Operation a))) - (function (_ compiler) - (case (action (set@ #.expected (#.Some expected) compiler)) - (#error.Success [compiler' output]) - (let [old-expected (get@ #.expected compiler)] - (#error.Success [(set@ #.expected old-expected compiler') - output])) - - (#error.Error error) - (#error.Error error)))) - -(def: #export (with-env action) - (All [a] (-> (tc.Check a) (Operation a))) - (function (_ compiler) - (case (action (get@ #.type-context compiler)) - (#error.Error error) - ((///.fail error) compiler) - - (#error.Success [context' output]) - (#error.Success [(set@ #.type-context context' compiler) - output])))) - -(def: #export (with-fresh-env action) - (All [a] (-> (Operation a) (Operation a))) - (function (_ compiler) - (let [old (get@ #.type-context compiler)] - (case (action (set@ #.type-context tc.fresh-context compiler)) - (#error.Success [compiler' output]) - (#error.Success [(set@ #.type-context old compiler') - output]) - - output - output)))) - -(def: #export (infer actualT) - (-> Type (Operation Any)) - (do ///.Monad - [expectedT 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/lang/compiler/default/cache.lux b/stdlib/source/lux/lang/compiler/default/cache.lux deleted file mode 100644 index a878e1615..000000000 --- a/stdlib/source/lux/lang/compiler/default/cache.lux +++ /dev/null @@ -1,33 +0,0 @@ -(.module: - lux - (lux (data (format [binary #+ Binary])))) - -(def: definition - (Binary Definition) - ($_ binary.seq binary.type binary.code binary.any)) - -(def: alias - (Binary [Text Text]) - (binary.seq binary.text binary.text)) - -## TODO: Remove #module-hash, #imports & #module-state ASAP. -## TODO: Not just from this parser, but from the lux.Module type. -(def: #export module - (Binary Module) - ($_ binary.seq - ## #module-hash - (binary.ignore +0) - ## #module-aliases - (binary.list ..alias) - ## #definitions - (binary.list (binary.seq binary.text ..definition)) - ## #imports - (binary.list binary.text) - ## #tags - (binary.ignore (list)) - ## #types - (binary.ignore (list)) - ## #module-annotations - (binary.maybe binary.code) - ## #module-state - (binary.ignore #.Cached))) diff --git a/stdlib/source/lux/lang/compiler/default/repl/type.lux b/stdlib/source/lux/lang/compiler/default/repl/type.lux deleted file mode 100644 index b78d1785c..000000000 --- a/stdlib/source/lux/lang/compiler/default/repl/type.lux +++ /dev/null @@ -1,197 +0,0 @@ -(.module: - lux - (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] - [macro] - (macro [code] - [poly #+ Poly]) - (lang [type]))) - -(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.this Any)] - (wrap (function.constant "[]"))) - - (~~ (do-template [ ] - [(do p.Monad - [_ (poly.like )] - (wrap (|>> (:coerce ) )))] - - [Bool %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.like )] - (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.this List) poly.any)) - elemR (poly.local (list elemT) representation)] - (wrap (|>> (:coerce (List Any)) (%list elemR)))) - - (do p.Monad - [[_ elemT] (poly.apply (p.seq (poly.this 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/lang/compiler/extension.lux b/stdlib/source/lux/lang/compiler/extension.lux deleted file mode 100644 index e23e9b511..000000000 --- a/stdlib/source/lux/lang/compiler/extension.lux +++ /dev/null @@ -1,64 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [error #+ Error] - [text] - (collection ["dict" dictionary #+ Dictionary]))) - [// #+ Operation Compiler]) - -(type: #export (Extension i) - (#Base i) - (#Extension [Text (List (Extension i))])) - -(with-expansions [ (as-is (Dictionary Text (-> Text (Handler s i o))))] - (type: #export (Handler s i o) - (-> (Compiler [s ] (Extension i) (Extension o)) - (Compiler [s ] (List (Extension i)) (Extension o)))) - - (type: #export (Bundle s i o) - )) - -(do-template [] - [(exception: #export ( {name Text}) - (ex.report ["Name" name]))] - - [unknown-extension] - [cannot-overwrite-existing-extension] - ) - -(def: #export (extend compiler) - (All [s i o] - (-> (Compiler s i o) - (Compiler [s (Bundle s i o)] - (Extension i) - (Extension o)))) - (function (compiler' input (^@ stateE [stateB bundle])) - (case input - (#Base input') - (do error.Monad - [[stateB' output] (compiler input' stateB)] - (wrap [[stateB' bundle] (#Base output)])) - - (#Extension name parameters) - (case (dict.get name bundle) - (#.Some handler) - (do error.Monad - [[stateE' output] (handler name compiler' parameters stateE)] - (wrap [stateE' output])) - - #.None - (ex.throw unknown-extension name))))) - -(def: #export (install name handler) - (All [s i o] - (-> Text (-> Text (Handler s i o)) - (Operation [s (Bundle s i o)] Any))) - (function (_ (^@ stateE [_ bundle])) - (if (dict.contains? name bundle) - (ex.throw cannot-overwrite-existing-extension name) - (ex.return [stateE (dict.put name handler bundle)])))) - -(def: #export fresh - Bundle - (dict.new text.Hash)) diff --git a/stdlib/source/lux/lang/compiler/extension/analysis.lux b/stdlib/source/lux/lang/compiler/extension/analysis.lux deleted file mode 100644 index 9f48c79b4..000000000 --- a/stdlib/source/lux/lang/compiler/extension/analysis.lux +++ /dev/null @@ -1,18 +0,0 @@ -(.module: - lux - (lux (data [text] - (collection [list "list/" Functor] - ["dict" dictionary #+ Dictionary]))) - [///analysis #+ Analysis State] - [///synthesis #+ Synthesis] - [//] - [/common] - [/host]) - -(def: #export defaults - (//.Bundle State Analysis Synthesis) - (|> /common.extensions - (dict.merge /host.extensions) - dict.entries - (list/map (function (_ [name proc]) [name (proc name)])) - (dict.from-list text.Hash))) diff --git a/stdlib/source/lux/lang/compiler/extension/analysis/common.lux b/stdlib/source/lux/lang/compiler/extension/analysis/common.lux deleted file mode 100644 index 62a01cee7..000000000 --- a/stdlib/source/lux/lang/compiler/extension/analysis/common.lux +++ /dev/null @@ -1,375 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - [thread #+ Box]) - (concurrency [atom #+ Atom]) - (data [text] - text/format - (collection [list "list/" Functor] - [array] - ["dict" dictionary #+ Dictionary])) - [lang] - (lang (type ["tc" check])) - [io #+ IO]) - [////] - (//// [analysis #+ Analysis] - (analysis [".A" type] - [".A" case] - [".A" function])) - [///] - [///bundle]) - -(type: Handler - (///.Handler .Lux .Code Analysis)) - -## [Utils] -(def: (simple extension inputsT+ outputT) - (-> Text (List Type) Type ..Handler) - (let [num-expected (list.size inputsT+)] - (function (_ 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 (#///.Extension extension argsA))) - (lang.throw ///bundle.incorrect-arity [extension num-expected num-actual])))))) - -(def: #export (nullary valueT extension) - (-> Type Text ..Handler) - (simple extension (list) valueT)) - -(def: #export (unary inputT outputT extension) - (-> Type Type Text ..Handler) - (simple extension (list inputT) outputT)) - -(def: #export (binary subjectT paramT outputT extension) - (-> Type Type Type Text ..Handler) - (simple extension (list subjectT paramT) outputT)) - -(def: #export (trinary subjectT param0T param1T outputT extension) - (-> Type Type Type Type Text ..Handler) - (simple extension (list subjectT param0T param1T) outputT)) - -## [Analysers] -## "lux is" represents reference/pointer equality. -(def: (lux//is extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((binary varT varT Bool extension) - analyse args)))) - -## "lux try" provides a simple way to interact with the host platform's -## error-handling facilities. -(def: (lux//try extension) - (-> Text ..Handler) - (function (_ analyse args) - (case args - (^ (list opC)) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var) - _ (typeA.infer (type (Either Text varT))) - opA (typeA.with-type (type (IO varT)) - (analyse opC))] - (wrap (#///.Extension extension (list opA)))) - - _ - (lang.throw ///bundle.incorrect-arity [extension +1 (list.size args)])))) - -(def: (lux//in-module extension) - (-> Text ..Handler) - (function (_ analyse argsC+) - (case argsC+ - (^ (list [_ (#.Text module-name)] exprC)) - (lang.with-current-module module-name - (analyse exprC)) - - _ - (lang.throw ///bundle.invalid-syntax [extension])))) - -## (do-template [ ] -## [(def: ( extension) -## (-> Text ..Handler) -## (function (_ analyse args) -## (case args -## (^ (list typeC valueC)) -## (do ////.Monad -## [actualT (eval Type typeC) -## _ (typeA.infer (:coerce Type actualT))] -## (typeA.with-type -## (analyse valueC))) - -## _ -## (lang.throw ///bundle.incorrect-arity [extension +2 (list.size args)]))))] - -## [lux//check (:coerce Type actualT)] -## [lux//coerce Any] -## ) - -(def: (lux//check//type extension) - (-> Text ..Handler) - (function (_ analyse args) - (case args - (^ (list valueC)) - (do ////.Monad - [_ (typeA.infer Type) - valueA (typeA.with-type Type - (analyse valueC))] - (wrap valueA)) - - _ - (lang.throw ///bundle.incorrect-arity [extension +1 (list.size args)])))) - -(def: bundle/lux - ///.Bundle - (|> ///.fresh - (///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") - (|> ///.fresh - (///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") - (|> ///.fresh - (///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") - (|> ///.fresh - (///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 Bool)) - (///bundle.install "<" (binary Int Int Bool)) - (///bundle.install "min" (nullary Int)) - (///bundle.install "max" (nullary Int)) - (///bundle.install "to-nat" (unary Int Nat)) - (///bundle.install "to-frac" (unary Int Frac)) - (///bundle.install "char" (unary Int Text))))) - -(def: bundle/frac - ///.Bundle - (<| (///bundle.prefix "frac") - (|> ///.fresh - (///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 Bool)) - (///bundle.install "<" (binary Frac Frac Bool)) - (///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") - (|> ///.fresh - (///bundle.install "=" (binary Text Text Bool)) - (///bundle.install "<" (binary Text Text Bool)) - (///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 "hash" (unary Text Nat)) - (///bundle.install "replace-once" (trinary Text Text Text Text)) - (///bundle.install "replace-all" (trinary Text Text Text Text)) - (///bundle.install "char" (binary Text Nat (type (Maybe Nat)))) - (///bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text)))) - ))) - -(def: (array//get extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((binary (type (Array varT)) Nat (type (Maybe varT)) extension) - analyse args)))) - -(def: (array//put extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension) - analyse args)))) - -(def: (array//remove extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((binary (type (Array varT)) Nat (type (Array varT)) extension) - analyse args)))) - -(def: bundle/array - ///.Bundle - (<| (///bundle.prefix "array") - (|> ///.fresh - (///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") - (|> ///.fresh - (///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 extension) - (-> Text ..Handler) - (function (_ analyse args) - (case args - (^ (list initC)) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var) - _ (typeA.infer (type (Atom varT))) - initA (typeA.with-type varT - (analyse initC))] - (wrap (#///.Extension extension (list initA)))) - - _ - (lang.throw ///bundle.incorrect-arity [extension +1 (list.size args)])))) - -(def: (atom-read extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((unary (type (Atom varT)) varT extension) - analyse args)))) - -(def: (atom//compare-and-swap extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var)] - ((trinary (type (Atom varT)) varT varT Bool extension) - analyse args)))) - -(def: bundle/atom - ///.Bundle - (<| (///bundle.prefix "atom") - (|> ///.fresh - (///bundle.install "new" atom-new) - (///bundle.install "read" atom-read) - (///bundle.install "compare-and-swap" atom//compare-and-swap) - ))) - -(def: (box//new extension) - (-> Text ..Handler) - (function (_ analyse args) - (case args - (^ (list initC)) - (do ////.Monad - [[var-id varT] (typeA.with-env tc.var) - _ (typeA.infer (type (All [!] (Box ! varT)))) - initA (typeA.with-type varT - (analyse initC))] - (wrap (#///.Extension extension (list initA)))) - - _ - (lang.throw ///bundle.incorrect-arity [extension +1 (list.size args)])))) - -(def: (box//read extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[thread-id threadT] (typeA.with-env tc.var) - [var-id varT] (typeA.with-env tc.var)] - ((unary (type (Box threadT varT)) varT extension) - analyse args)))) - -(def: (box//write extension) - (-> Text ..Handler) - (function (_ analyse args) - (do ////.Monad - [[thread-id threadT] (typeA.with-env tc.var) - [var-id varT] (typeA.with-env tc.var)] - ((binary varT (type (Box threadT varT)) Any extension) - analyse args)))) - -(def: bundle/box - ///.Bundle - (<| (///bundle.prefix "box") - (|> ///.fresh - (///bundle.install "new" box//new) - (///bundle.install "read" box//read) - (///bundle.install "write" box//write) - ))) - -(def: bundle/process - ///.Bundle - (<| (///bundle.prefix "process") - (|> ///.fresh - (///bundle.install "parallelism" (nullary Nat)) - (///bundle.install "schedule" (binary Nat (type (IO Any)) Any)) - ))) - -(def: #export bundle - ///.Bundle - (<| (///bundle.prefix "lux") - (|> ///.fresh - (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/lang/compiler/extension/analysis/host.jvm.lux b/stdlib/source/lux/lang/compiler/extension/analysis/host.jvm.lux deleted file mode 100644 index 265836e66..000000000 --- a/stdlib/source/lux/lang/compiler/extension/analysis/host.jvm.lux +++ /dev/null @@ -1,1268 +0,0 @@ -(.module: - [lux #- char int] - (lux (control [monad #+ do] - ["p" parser] - ["ex" exception #+ exception:]) - (data ["e" error] - [maybe] - [product] - [bool "bool/" Equivalence] - [text "text/" Equivalence] - (text format - ["l" lexer]) - (collection [list "list/" Fold Functor Monoid] - [array] - ["dict" dictionary #+ Dictionary])) - [macro "macro/" Monad] - (macro [code] - ["s" syntax]) - [lang] - (lang [type] - (type ["tc" check])) - [host]) - ["/" //common] - (//// [".L" analysis #+ Analysis] - (analysis [".A" type] - [".A" inference])) - [///] - ) - -(host.import: #long java/lang/reflect/Type - (getTypeName [] String)) - -(def: jvm-type-name - (-> java/lang/reflect/Type Text) - (java/lang/reflect/Type::getTypeName [])) - -(exception: #export (jvm-type-is-not-a-class {jvm-type java/lang/reflect/Type}) - (jvm-type-name jvm-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] - - [cannot-convert-to-a-class] - [cannot-convert-to-a-parameter] - [cannot-convert-to-a-lux-type] - [unknown-type-var] - [type-parameter-mismatch] - [cannot-correspond-type-with-a-class] - ) - -(do-template [] - [(exception: #export ( {class Text} {method Text} {hints (List [Type (List Type)])}) - (ex.report ["Class" class] - ["Method" method] - ["Hints" (|> hints - (list/map (|>> %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: conversion-procs - /.Bundle - (<| (/.prefix "convert") - (|> (dict.new text.Hash) - (/.install "double-to-float" (/.unary Double Float)) - (/.install "double-to-int" (/.unary Double Integer)) - (/.install "double-to-long" (/.unary Double Long)) - (/.install "float-to-double" (/.unary Float Double)) - (/.install "float-to-int" (/.unary Float Integer)) - (/.install "float-to-long" (/.unary Float Long)) - (/.install "int-to-byte" (/.unary Integer Byte)) - (/.install "int-to-char" (/.unary Integer Character)) - (/.install "int-to-double" (/.unary Integer Double)) - (/.install "int-to-float" (/.unary Integer Float)) - (/.install "int-to-long" (/.unary Integer Long)) - (/.install "int-to-short" (/.unary Integer Short)) - (/.install "long-to-double" (/.unary Long Double)) - (/.install "long-to-float" (/.unary Long Float)) - (/.install "long-to-int" (/.unary Long Integer)) - (/.install "long-to-short" (/.unary Long Short)) - (/.install "long-to-byte" (/.unary Long Byte)) - (/.install "char-to-byte" (/.unary Character Byte)) - (/.install "char-to-short" (/.unary Character Short)) - (/.install "char-to-int" (/.unary Character Integer)) - (/.install "char-to-long" (/.unary Character Long)) - (/.install "byte-to-long" (/.unary Byte Long)) - (/.install "short-to-long" (/.unary Short Long)) - ))) - -(do-template [ ] - [(def: - /.Bundle - (<| (/.prefix ) - (|> (dict.new text.Hash) - (/.install "+" (/.binary )) - (/.install "-" (/.binary )) - (/.install "*" (/.binary )) - (/.install "/" (/.binary )) - (/.install "%" (/.binary )) - (/.install "=" (/.binary Boolean)) - (/.install "<" (/.binary Boolean)) - (/.install "and" (/.binary )) - (/.install "or" (/.binary )) - (/.install "xor" (/.binary )) - (/.install "shl" (/.binary Integer )) - (/.install "shr" (/.binary Integer )) - (/.install "ushr" (/.binary Integer )) - )))] - - [int-procs "int" Integer] - [long-procs "long" Long] - ) - -(do-template [ ] - [(def: - /.Bundle - (<| (/.prefix ) - (|> (dict.new text.Hash) - (/.install "+" (/.binary )) - (/.install "-" (/.binary )) - (/.install "*" (/.binary )) - (/.install "/" (/.binary )) - (/.install "%" (/.binary )) - (/.install "=" (/.binary Boolean)) - (/.install "<" (/.binary Boolean)) - )))] - - [float-procs "float" Float] - [double-procs "double" Double] - ) - -(def: char-procs - /.Bundle - (<| (/.prefix "char") - (|> (dict.new text.Hash) - (/.install "=" (/.binary Character Character Boolean)) - (/.install "<" (/.binary Character Character Boolean)) - ))) - -(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"]) - (dict.from-list text.Hash))) - -(def: (array//length proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list arrayC)) - (do macro.Monad - [_ (typeA.infer Nat) - [var-id varT] (typeA.with-env tc.var) - arrayA (typeA.with-type (type (Array varT)) - (analyse arrayC))] - (wrap (#analysisL.Extension proc (list arrayA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +1 (list.size args)])))) - -(def: (array//new proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list lengthC)) - (do macro.Monad - [lengthA (typeA.with-type Nat - (analyse lengthC)) - expectedT macro.expected-type - [level elem-class] (: (Meta [Nat Text]) - (loop [analysisT expectedT - level +0] - (case analysisT - (#.Apply inputT funcT) - (case (type.apply (list inputT) funcT) - (#.Some outputT) - (recur outputT level) - - #.None - (lang.throw non-array expectedT)) - - (^ (#.Primitive "#Array" (list elemT))) - (recur elemT (inc level)) - - (#.Primitive class _) - (wrap [level class]) - - _ - (lang.throw non-array expectedT)))) - _ (if (n/> +0 level) - (wrap []) - (lang.throw non-array expectedT))] - (wrap (#analysisL.Extension proc (list (analysisL.nat (dec level)) - (analysisL.text elem-class) - lengthA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +1 (list.size args)])))) - -(def: (check-jvm objectT) - (-> Type (Meta Text)) - (case objectT - (#.Primitive name _) - (macro/wrap name) - - (#.Named name unnamed) - (check-jvm unnamed) - - (#.Var id) - (macro/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 - (lang.throw non-object objectT)) - - _ - (lang.throw non-object objectT))) - -(def: (check-object objectT) - (-> Type (Meta Text)) - (do macro.Monad - [name (check-jvm objectT)] - (if (dict.contains? name boxes) - (lang.throw primitives-are-not-objects name) - (macro/wrap name)))) - -(def: (box-array-element-type elemT) - (-> Type (Meta [Type Text])) - (case elemT - (#.Primitive name #.Nil) - (let [boxed-name (|> (dict.get name boxes) - (maybe.default name))] - (macro/wrap [(#.Primitive boxed-name #.Nil) - boxed-name])) - - (#.Primitive name _) - (if (dict.contains? name boxes) - (lang.throw primitives-cannot-have-type-parameters name) - (macro/wrap [elemT name])) - - _ - (lang.throw invalid-type-for-array-element (%type elemT)))) - -(def: (array//read proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list arrayC idxC)) - (do macro.Monad - [[var-id varT] (typeA.with-env tc.var) - _ (typeA.infer varT) - arrayA (typeA.with-type (type (Array varT)) - (analyse arrayC)) - ?elemT (typeA.with-env - (tc.read var-id)) - [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT)) - idxA (typeA.with-type Nat - (analyse idxC))] - (wrap (#analysisL.Extension proc (list (analysisL.text elem-class) idxA arrayA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +2 (list.size args)])))) - -(def: (array//write proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list arrayC idxC valueC)) - (do macro.Monad - [[var-id varT] (typeA.with-env tc.var) - _ (typeA.infer (type (Array varT))) - arrayA (typeA.with-type (type (Array varT)) - (analyse arrayC)) - ?elemT (typeA.with-env - (tc.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 (#analysisL.Extension proc (list (analysisL.text elem-class) idxA valueA arrayA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +3 (list.size args)])))) - -(def: array-procs - /.Bundle - (<| (/.prefix "array") - (|> (dict.new text.Hash) - (/.install "length" array//length) - (/.install "new" array//new) - (/.install "read" array//read) - (/.install "write" array//write) - ))) - -(def: (object//null proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list)) - (do macro.Monad - [expectedT macro.expected-type - _ (check-object expectedT)] - (wrap (#analysisL.Extension proc (list)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +0 (list.size args)])))) - -(def: (object//null? proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list objectC)) - (do macro.Monad - [_ (typeA.infer Bool) - [objectT objectA] (typeA.with-inference - (analyse objectC)) - _ (check-object objectT)] - (wrap (#analysisL.Extension proc (list objectA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +1 (list.size args)])))) - -(def: (object//synchronized proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list monitorC exprC)) - (do macro.Monad - [[monitorT monitorA] (typeA.with-inference - (analyse monitorC)) - _ (check-object monitorT) - exprA (analyse exprC)] - (wrap (#analysisL.Extension proc (list monitorA exprA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +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 (Meta (Class Object))) - (do macro.Monad - [] - (case (Class::forName [name]) - (#e.Success [class]) - (wrap class) - - (#e.Error error) - (lang.throw unknown-class name)))) - -(def: (sub-class? super sub) - (-> Text Text (Meta Bool)) - (do macro.Monad - [super (load-class super) - sub (load-class sub)] - (wrap (Class::isAssignableFrom [sub] super)))) - -(def: (object//throw proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list exceptionC)) - (do macro.Monad - [_ (typeA.infer Nothing) - [exceptionT exceptionA] (typeA.with-inference - (analyse exceptionC)) - exception-class (check-object exceptionT) - ? (sub-class? "java.lang.Throwable" exception-class) - _ (: (Meta Any) - (if ? - (wrap []) - (lang.throw non-throwable exception-class)))] - (wrap (#analysisL.Extension proc (list exceptionA)))) - - _ - (lang.throw /.incorrect-extension-arity [proc +1 (list.size args)])))) - -(def: (object//class proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC)) - (case classC - [_ (#.Text class)] - (do macro.Monad - [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) - _ (load-class class)] - (wrap (#analysisL.Extension proc (list (analysisL.text class))))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +1 (list.size args)])))) - -(def: (object//instance? proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC objectC)) - (case classC - [_ (#.Text class)] - (do macro.Monad - [_ (typeA.infer Bool) - [objectT objectA] (typeA.with-inference - (analyse objectC)) - object-class (check-object objectT) - ? (sub-class? class object-class)] - (if ? - (wrap (#analysisL.Extension proc (list (analysisL.text class)))) - (lang.throw cannot-possibly-be-an-instance (format object-class " !<= " class)))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +2 (list.size args)])))) - -(def: (java-type-to-class type) - (-> java/lang/reflect/Type (Meta Text)) - (cond (host.instance? Class type) - (macro/wrap (Class::getName [] (:coerce Class type))) - - (host.instance? ParameterizedType type) - (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType type))) - - ## else - (lang.throw cannot-convert-to-a-class (jvm-type-name type)))) - -(type: Mappings - (Dictionary Text Type)) - -(def: fresh-mappings Mappings (dict.new text.Hash)) - -(def: (java-type-to-lux-type mappings java-type) - (-> Mappings java/lang/reflect/Type (Meta Type)) - (cond (host.instance? TypeVariable java-type) - (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))] - (case (dict.get var-name mappings) - (#.Some var-type) - (macro/wrap var-type) - - #.None - (lang.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) - - _ - (macro/wrap Any))) - - (host.instance? Class java-type) - (let [java-type (:coerce (Class Object) java-type) - class-name (Class::getName [] java-type)] - (macro/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 macro.Monad - [paramsT (|> java-type - (ParameterizedType::getActualTypeArguments []) - array.to-list - (monad.map @ (java-type-to-lux-type mappings)))] - (macro/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw)) - paramsT))) - (lang.throw jvm-type-is-not-a-class raw))) - - (host.instance? GenericArrayType java-type) - (do macro.Monad - [innerT (|> (:coerce GenericArrayType java-type) - (GenericArrayType::getGenericComponentType []) - (java-type-to-lux-type mappings))] - (wrap (#.Primitive "#Array" (list innerT)))) - - ## else - (lang.throw cannot-convert-to-a-lux-type (jvm-type-name java-type)))) - -(def: (correspond-type-params class type) - (-> (Class Object) Type (Meta 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)) - (lang.throw cannot-correspond-type-with-a-class - (format "Class = " class-name "\n" - "Type = " (%type type))) - - (not (n/= num-class-params num-type-params)) - (lang.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 - (macro/wrap (|> params - (list.zip2 (list/map (TypeVariable::getName []) class-params)) - (dict.from-list text.Hash))) - )) - - _ - (lang.throw non-jvm-type type))) - -(def: (object//cast proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list valueC)) - (do macro.Monad - [toT macro.expected-type - to-name (check-jvm toT) - [valueT valueA] (typeA.with-inference - (analyse valueC)) - from-name (check-jvm valueT) - can-cast? (: (Meta Bool) - (case [from-name to-name] - (^template [ ] - (^or [ ] - [ ]) - (do @ - [_ (typeA.infer (#.Primitive to-name (list)))] - (wrap true))) - (["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 @ - [_ (lang.assert primitives-are-not-objects from-name - (not (dict.contains? from-name boxes))) - _ (lang.assert primitives-are-not-objects to-name - (not (dict.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 true)) - (do @ - [current-class (load-class current-name) - _ (lang.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 - (lang.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 (#analysisL.Extension proc (list (analysisL.text from-name) - (analysisL.text to-name) - valueA))) - (lang.throw cannot-cast (format "From class/primitive: " from-name "\n" - " To class/primitive: " to-name "\n" - " For value: " (%code valueC) "\n")))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: object-procs - /.Bundle - (<| (/.prefix "object") - (|> (dict.new text.Hash) - (/.install "null" object//null) - (/.install "null?" object//null?) - (/.install "synchronized" object//synchronized) - (/.install "throw" object//throw) - (/.install "class" object//class) - (/.install "instance?" object//instance?) - (/.install "cast" object//cast) - ))) - -(def: (find-field class-name field-name) - (-> Text Text (Meta [(Class Object) Field])) - (do macro.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]) - (lang.throw mistaken-field-owner - (format " Field: " field-name "\n" - " Owner Class: " (Class::getName [] owner) "\n" - "Target Class: " class-name "\n")))) - - (#e.Error _) - (lang.throw unknown-field (format class-name "#" field-name))))) - -(def: (static-field class-name field-name) - (-> Text Text (Meta [Type Bool])) - (do macro.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])]))) - (lang.throw not-a-static-field (format class-name "#" field-name))))) - -(def: (virtual-field class-name field-name objectT) - (-> Text Text Type (Meta [Type Bool])) - (do macro.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 (: (Meta Mappings) - (case objectT - (#.Primitive _class-name _class-params) - (do @ - [#let [num-params (list.size _class-params) - num-vars (list.size var-names)] - _ (lang.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) - (dict.from-list text.Hash)))) - - _ - (lang.throw non-object objectT))) - fieldT (java-type-to-lux-type mappings fieldJT)] - (wrap [fieldT (Modifier::isFinal [modifiers])])) - (lang.throw not-a-virtual-field (format class-name "#" field-name))))) - -(def: (static//get proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC fieldC)) - (case [classC fieldC] - [[_ (#.Text class)] [_ (#.Text field)]] - (do macro.Monad - [[fieldT final?] (static-field class field)] - (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field))))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +2 (list.size args)])))) - -(def: (static//put proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC fieldC valueC)) - (case [classC fieldC] - [[_ (#.Text class)] [_ (#.Text field)]] - (do macro.Monad - [_ (typeA.infer Any) - [fieldT final?] (static-field class field) - _ (lang.assert cannot-set-a-final-field (format class "#" field) - (not final?)) - valueA (typeA.with-type fieldT - (analyse valueC))] - (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) valueA)))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +3 (list.size args)])))) - -(def: (virtual//get proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC fieldC objectC)) - (case [classC fieldC] - [[_ (#.Text class)] [_ (#.Text field)]] - (do macro.Monad - [[objectT objectA] (typeA.with-inference - (analyse objectC)) - [fieldT final?] (virtual-field class field objectT)] - (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) objectA)))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +3 (list.size args)])))) - -(def: (virtual//put proc) - (-> Text ///.Analysis) - (function (_ analyse eval args) - (case args - (^ (list classC fieldC valueC objectC)) - (case [classC fieldC] - [[_ (#.Text class)] [_ (#.Text field)]] - (do macro.Monad - [[objectT objectA] (typeA.with-inference - (analyse objectC)) - _ (typeA.infer objectT) - [fieldT final?] (virtual-field class field objectT) - _ (lang.assert cannot-set-a-final-field (format class "#" field) - (not final?)) - valueA (typeA.with-type fieldT - (analyse valueC))] - (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) valueA objectA)))) - - _ - (lang.throw /.invalid-syntax [proc args])) - - _ - (lang.throw /.incorrect-extension-arity [proc +4 (list.size args)])))) - -(def: (java-type-to-parameter type) - (-> java/lang/reflect/Type (Meta Text)) - (cond (host.instance? Class type) - (macro/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)) - (macro/wrap "java.lang.Object") - - (host.instance? GenericArrayType type) - (do macro.Monad - [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))] - (wrap (format componentP "[]"))) - - ## else - (lang.throw cannot-convert-to-a-parameter (jvm-type-name 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 (Meta Bool)) - (do macro.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]) - - _ - true) - (case method-style - #Special - (not (or (Modifier::isInterface [(Class::getModifiers [] class)]) - (Modifier::isAbstract [modifiers]))) - - _ - true) - (n/= (list.size arg-classes) (list.size parameters)) - (list/fold (function (_ [expectedJC actualJC] prev) - (and prev - (text/= expectedJC actualJC))) - true - (list.zip2 arg-classes parameters)))))) - -(def: (check-constructor class arg-classes constructor) - (-> (Class Object) (List Text) (Constructor Object) (Meta Bool)) - (do macro.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))) - true - (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-to-type method-style method) - (-> Method-style Method (Meta [Type (List Type)])) - (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) - (dict.from-list text.Hash))))] - (do macro.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 a) - (#Pass a) - (#Hint a) - #Fail) - -(do-template [ ] - [(def: - (All [a] (-> (Evaluation a) (Maybe a))) - (|>> (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) (Meta [Type (List Type)])) - (do macro.Monad - [class (load-class class-name) - candidates (|> class - (Class::getDeclaredMethods []) - array.to-list - (monad.map @ (: (-> Method (Meta (Evaluation Method))) - (function (_ method) - (do @ - [passes? (check-method class method-name method-style arg-classes method)] - (wrap (cond passes? - (#Pass method) - - (text/= method-name (Method::getName [] method)) - (#Hint method) - - ## else - #Fail)))))))] - (case (list.search-all pass! candidates) - #.Nil - (lang.throw no-candidates [class-name method-name - (|> candidates - (list.search-all hint!) - (list/map (method-to-type method-style)))]) - - (#.Cons method #.Nil) - (method-to-type method-style method) - - candidates - (lang.throw too-many-candidates [class-name method-name - (list/map (method-to-type method-style) candidates)])))) - -(def: (constructor-to-type constructor) - (-> (Constructor Object) (Meta [Type (List Type)])) - (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) - (dict.from-list text.Hash))))] - (do macro.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) (Meta [Type (List Type)])) - (do macro.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)] - (wrap [passes? constructor])))))] - (case (list.search-all pass! candidates) - #.Nil - (lang.throw no-candidates [class-name ..constructor-method - (|> candidates - (list.search-all hint!) - (list/map constructor-to-type))]) - - (#.Cons constructor #.Nil) - (constructor-to-type constructor) - - candidates - (lang.throw too-many-candidates [class-name ..constructor-method - (list/map constructor-to-type candidates)])))) - -(def: (decorate-inputs typesT inputsA) - (-> (List Text) (List Analysis) (List Analysis)) - (|> inputsA - (list.zip2 (list/map analysisL.text typesT)) - (list/map (function (_ [type value]) - (analysisL.product-analysis (list type value)))))) - -(def: (invoke//static proc) - (-> Text ///.Analysis) - (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method) - (analysisL.text outputJC) (decorate-inputs argsT argsA))))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: (invoke//virtual proc) - (-> Text ///.Analysis) - (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method) - (analysisL.text outputJC) objectA (decorate-inputs argsT argsA))))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: (invoke//special proc) - (-> Text ///.Analysis) - (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method) - (analysisL.text outputJC) (decorate-inputs argsT argsA))))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: (invoke//interface proc) - (-> Text ///.Analysis) - (function (_ analyse eval 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 macro.Monad - [#let [argsT (list/map product.left argsTC)] - class (load-class class-name) - _ (lang.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 (#analysisL.Extension proc - (list& (analysisL.text class-name) (analysisL.text method) (analysisL.text outputJC) - (decorate-inputs argsT argsA))))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: (invoke//constructor proc) - (-> Text ///.Analysis) - (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (decorate-inputs argsT argsA))))) - - _ - (lang.throw /.invalid-syntax [proc args])))) - -(def: member-procs - /.Bundle - (<| (/.prefix "member") - (|> (dict.new text.Hash) - (dict.merge (<| (/.prefix "static") - (|> (dict.new text.Hash) - (/.install "get" static//get) - (/.install "put" static//put)))) - (dict.merge (<| (/.prefix "virtual") - (|> (dict.new text.Hash) - (/.install "get" virtual//get) - (/.install "put" virtual//put)))) - (dict.merge (<| (/.prefix "invoke") - (|> (dict.new text.Hash) - (/.install "static" invoke//static) - (/.install "virtual" invoke//virtual) - (/.install "special" invoke//special) - (/.install "interface" invoke//interface) - (/.install "constructor" invoke//constructor) - ))) - ))) - -(def: #export extensions - /.Bundle - (<| (/.prefix "jvm") - (|> (dict.new text.Hash) - (dict.merge conversion-procs) - (dict.merge int-procs) - (dict.merge long-procs) - (dict.merge float-procs) - (dict.merge double-procs) - (dict.merge char-procs) - (dict.merge array-procs) - (dict.merge object-procs) - (dict.merge member-procs) - ))) diff --git a/stdlib/source/lux/lang/compiler/extension/bundle.lux b/stdlib/source/lux/lang/compiler/extension/bundle.lux deleted file mode 100644 index 4e011d2ca..000000000 --- a/stdlib/source/lux/lang/compiler/extension/bundle.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [text] - text/format - (collection [list "list/" Functor] - ["dict" dictionary #+ Dictionary]))) - [//]) - -(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 (install name anonymous) - (All [s i o] - (-> Text (-> 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/lang/compiler/extension/synthesis.lux b/stdlib/source/lux/lang/compiler/extension/synthesis.lux deleted file mode 100644 index 48073d012..000000000 --- a/stdlib/source/lux/lang/compiler/extension/synthesis.lux +++ /dev/null @@ -1,9 +0,0 @@ -(.module: - lux - (lux (data [text] - (collection ["dict" dictionary #+ Dictionary]))) - [//]) - -(def: #export defaults - (Dictionary Text //.Synthesis) - (dict.new text.Hash)) diff --git a/stdlib/source/lux/lang/compiler/extension/translation.lux b/stdlib/source/lux/lang/compiler/extension/translation.lux deleted file mode 100644 index ae05fd61c..000000000 --- a/stdlib/source/lux/lang/compiler/extension/translation.lux +++ /dev/null @@ -1,9 +0,0 @@ -(.module: - lux - (lux (data [text] - (collection ["dict" dictionary #+ Dictionary]))) - [//]) - -(def: #export defaults - (Dictionary Text //.Translation) - (dict.new text.Hash)) diff --git a/stdlib/source/lux/lang/compiler/init.lux b/stdlib/source/lux/lang/compiler/init.lux deleted file mode 100644 index 92a066b7e..000000000 --- a/stdlib/source/lux/lang/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/lang/compiler/meta/archive.lux b/stdlib/source/lux/lang/compiler/meta/archive.lux deleted file mode 100644 index 53c3baa65..000000000 --- a/stdlib/source/lux/lang/compiler/meta/archive.lux +++ /dev/null @@ -1,117 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:] - [equivalence #+ Equivalence] - [monad #+ do]) - (data [error #+ Error] - [ident] - [text] - text/format - (collection ["dict" dictionary #+ Dictionary])) - (lang [type #+ :share]) - (type 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/lang/compiler/meta/cache.lux b/stdlib/source/lux/lang/compiler/meta/cache.lux deleted file mode 100644 index 7c6b558db..000000000 --- a/stdlib/source/lux/lang/compiler/meta/cache.lux +++ /dev/null @@ -1,162 +0,0 @@ -(.module: - [lux #- Module] - (lux (control [monad #+ Monad do] - ["ex" exception #+ exception:] - pipe) - (data [bool "bool/" Equivalence] - [maybe] - [error] - [product] - (format [binary #+ Binary]) - [text] - text/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 false) - (do @ - [_ (..delete System file)] - (wrap true))))))] - [(list.every? (bool/= true)) - (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 (bool.complement (set.member? wanted-modules))) - (monad.map @ (un-install System root))]))) - -## Load -(def: signature - (Binary Signature) - ($_ binary.seq binary.ident binary.text)) - -(def: descriptor - (Binary Descriptor) - ($_ binary.seq binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached))) - -(def: document - (All [a] (-> (Binary a) (Binary [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) (Binary 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) (Binary 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/lang/compiler/meta/cache/dependency.lux b/stdlib/source/lux/lang/compiler/meta/cache/dependency.lux deleted file mode 100644 index f489f04ed..000000000 --- a/stdlib/source/lux/lang/compiler/meta/cache/dependency.lux +++ /dev/null @@ -1,51 +0,0 @@ -(.module: - [lux #- Module] - (lux (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/lang/compiler/meta/io.lux b/stdlib/source/lux/lang/compiler/meta/io.lux deleted file mode 100644 index e440c16f9..000000000 --- a/stdlib/source/lux/lang/compiler/meta/io.lux +++ /dev/null @@ -1,18 +0,0 @@ -(.module: - [lux #- Module] - (lux (control monad - ["ex" exception #+ exception:]) - (data [error] - [text] - (text format - [encoding])) - (world [file #+ File System] - [blob #+ Blob]))) - -(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/lang/compiler/meta/io/archive.lux b/stdlib/source/lux/lang/compiler/meta/io/archive.lux deleted file mode 100644 index 534c9e20c..000000000 --- a/stdlib/source/lux/lang/compiler/meta/io/archive.lux +++ /dev/null @@ -1,70 +0,0 @@ -(.module: - [lux #- Module] - (lux (control monad - ["ex" exception #+ exception:]) - (data [error] - [text] - text/format) - (world [file #+ File System] - [blob #+ Blob])) - [/////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 Blob 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/lang/compiler/meta/io/context.lux b/stdlib/source/lux/lang/compiler/meta/io/context.lux deleted file mode 100644 index 327f52cf5..000000000 --- a/stdlib/source/lux/lang/compiler/meta/io/context.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - [lux #- Module Code] - (lux (control monad - ["ex" exception #+ Exception exception:]) - (data [error] - (text format - [encoding])) - (world [file #+ File System] - [blob #+ Blob])) - [/////host] - [// #+ Context Module]) - -(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]) - blob (:: System read file)] - (case (encoding.from-utf8 blob) - (#error.Success code) - (wrap [path code]) - - (#error.Error _) - (:: System throw cannot-read-module [name]))))) diff --git a/stdlib/source/lux/lang/compiler/synthesis.lux b/stdlib/source/lux/lang/compiler/synthesis.lux deleted file mode 100644 index 36db1fe5e..000000000 --- a/stdlib/source/lux/lang/compiler/synthesis.lux +++ /dev/null @@ -1,241 +0,0 @@ -(.module: - [lux #- i64 Scope] - (lux (control [monad #+ do]) - (data [error #+ Error] - (collection ["dict" dictionary #+ Dictionary]))) - [///reference #+ Register Variable Reference] - [// #+ Operation Compiler] - [//analysis #+ Environment Arity Analysis]) - -(type: #export Resolver (Dictionary Variable Variable)) - -(type: #export State - {#scope-arity Arity - #resolver Resolver - #direct? Bool - #locals Nat}) - -(def: #export fresh-resolver - Resolver - (dict.new ///reference.Hash)) - -(def: #export init - State - {#scope-arity +0 - #resolver fresh-resolver - #direct? false - #locals +0}) - -(type: #export Primitive - (#Bool Bool) - (#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 (Branch s) - (#Case s (Path' s)) - (#Let s Register s) - (#If s s 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))) - -(type: #export Path - (Path' Synthesis)) - -(def: #export path/pop - Path - #Pop) - -(do-template [ ] - [(template: #export ( content) - (#..Test ( content)))] - - [path/bool #..Bool] - [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)) - -(def: #export unit Text "") - -(type: #export Synthesizer - (Compiler ..State Analysis Synthesis)) - -(do-template [ ] - [(def: #export - (All [a] (-> (Operation ..State a) (Operation ..State a))) - (//.localized (set@ #direct? )))] - - [indirectly false] - [directly true] - ) - -(do-template [ ] - [(def: #export ( value) - (-> (All [a] (-> (Operation ..State a) (Operation ..State a)))) - (//.localized (set@ value)))] - - [with-scope-arity Arity #scope-arity] - [with-resolver Resolver #resolver] - [with-locals Nat #locals] - ) - -(def: #export (with-abstraction arity resolver) - (All [o] - (-> Arity Resolver - (-> (Operation ..State o) (Operation ..State o)))) - (//.with-state {#scope-arity arity - #resolver resolver - #direct? true - #locals arity})) - -(do-template [ ] - [(def: #export - (Operation ..State ) - (function (_ state) - (#error.Success [state (get@ state)])))] - - [scope-arity #scope-arity Arity] - [resolver #resolver Resolver] - [direct? #direct? Bool] - [locals #locals Nat] - ) - -(def: #export with-new-local - (All [a] (-> (Operation ..State a) (Operation ..State a))) - (<<| (do //.Monad - [locals ..locals]) - (..with-locals (inc locals)))) - -(do-template [ ] - [(template: #export ( content) - (#..Primitive ( content)))] - - [bool #..Bool] - [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) - (.<| #..Control - - - content))] - - [branch/case #..Branch #..Case] - [branch/let #..Branch #..Let] - [branch/if #..Branch #..If] - - [loop/scope #..Loop #..Scope] - [loop/recur #..Loop #..Recur] - - [function/abstraction #..Function #..Abstraction] - [function/apply #..Function #..Apply] - ) diff --git a/stdlib/source/lux/lang/compiler/synthesis/case.lux b/stdlib/source/lux/lang/compiler/synthesis/case.lux deleted file mode 100644 index 5fca60a99..000000000 --- a/stdlib/source/lux/lang/compiler/synthesis/case.lux +++ /dev/null @@ -1,177 +0,0 @@ -(.module: - lux - (lux (control [equivalence #+ Equivalence] - pipe - [monad #+ do]) - (data [product] - [bool "bool/" Equivalence] - [text "text/" Equivalence] - text/format - [number "frac/" Equivalence] - (collection [list "list/" Fold Monoid]))) - [///reference] - [///compiler #+ Operation "operation/" Monad] - [///analysis #+ Pattern Match Analysis] - [// #+ Path Synthesis] - [//function]) - -(def: (path' pattern bodyC) - (-> Pattern (Operation //.State Path) (Operation //.State Path)) - (case pattern - (#///analysis.Simple simple) - (case simple - #///analysis.Unit - bodyC - - (^template [ ] - ( value) - (operation/map (|>> (#//.Seq (#//.Test (|> value )))) - bodyC)) - ([#///analysis.Bool #//.Bool] - [#///analysis.Nat (<| #//.I64 .i64)] - [#///analysis.Int (<| #//.I64 .i64)] - [#///analysis.Rev (<| #//.I64 .i64)] - [#///analysis.Frac #//.F64] - [#///analysis.Text #//.Text])) - - (#///analysis.Bind register) - (<| (do ///compiler.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) - (-> //.Synthesizer Pattern Analysis (Operation //.State 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 - )) - ([#//.Bool bool/=] - [#//.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+]) - (-> //.Synthesizer Analysis Match (Operation //.State Synthesis)) - (do ///compiler.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/bool true) thenA] - (list [(///analysis.pattern/bool false) elseA])]) - (^ [[(///analysis.pattern/bool false) elseA] - (list [(///analysis.pattern/bool true) 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/lang/compiler/synthesis/expression.lux b/stdlib/source/lux/lang/compiler/synthesis/expression.lux deleted file mode 100644 index 6db9a8fd5..000000000 --- a/stdlib/source/lux/lang/compiler/synthesis/expression.lux +++ /dev/null @@ -1,99 +0,0 @@ -(.module: - [lux #- primitive] - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - (collection [list "list/" Functor] - ["dict" dictionary #+ Dictionary]))) - [///reference] - [///compiler "operation/" Monad] - [///analysis #+ Analysis] - [///extension #+ Extension] - [// #+ Synthesis] - [//function] - [//case]) - -(exception: #export (unknown-synthesis-extension {name Text}) - name) - -(def: (primitive analysis) - (-> ///analysis.Primitive //.Primitive) - (case analysis - #///analysis.Unit - (#//.Text //.unit) - - (^template [ ] - ( value) - ( value)) - ([#///analysis.Bool #//.Bool] - [#///analysis.Frac #//.F64] - [#///analysis.Text #//.Text]) - - (^template [ ] - ( value) - ( (.i64 value))) - ([#///analysis.Nat #//.I64] - [#///analysis.Int #//.I64] - [#///analysis.Rev #//.I64]))) - -(def: #export (synthesizer extensions) - (-> (Extension ///extension.Synthesis) //.Synthesizer) - (function (synthesize analysis) - (case analysis - (#///analysis.Primitive analysis') - (operation/wrap (#//.Primitive (..primitive analysis'))) - - (#///analysis.Structure composite) - (case (///analysis.variant analysis) - (#.Some variant) - (do ///compiler.Monad - [valueS (synthesize (get@ #///analysis.value variant))] - (wrap (#//.Structure (#//.Variant (set@ #///analysis.value valueS variant))))) - - _ - (do ///compiler.Monad - [tupleS (monad.map @ synthesize (///analysis.tuple analysis))] - (wrap (#//.Structure (#//.Tuple tupleS))))) - - (#///analysis.Apply _) - (//function.apply (|>> synthesize //.indirectly) analysis) - - (#///analysis.Function environmentA bodyA) - (//function.function synthesize environmentA bodyA) - - (#///analysis.Extension name args) - (case (dict.get name extensions) - #.None - (///compiler.throw unknown-synthesis-extension name) - - (#.Some extension) - (extension (|>> synthesize //.indirectly) args)) - - (#///analysis.Reference reference) - (case reference - (#///reference.Constant constant) - (operation/wrap (#//.Reference reference)) - - (#///reference.Variable var) - (do ///compiler.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 false 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+) - ))) diff --git a/stdlib/source/lux/lang/compiler/synthesis/function.lux b/stdlib/source/lux/lang/compiler/synthesis/function.lux deleted file mode 100644 index ae7b5c3b3..000000000 --- a/stdlib/source/lux/lang/compiler/synthesis/function.lux +++ /dev/null @@ -1,130 +0,0 @@ -(.module: - [lux #- function] - (lux (control [monad #+ do] - [state] - pipe - ["ex" exception #+ exception:]) - (data [maybe "maybe/" Monad] - [error] - (collection [list "list/" Functor Monoid Fold] - ["dict" dictionary #+ Dictionary]))) - [///reference #+ Variable] - [///compiler #+ Operation] - [///analysis #+ Environment Arity Analysis] - [// #+ Synthesis Synthesizer] - [//loop]) - -(def: #export nested? - (-> Arity Bool) - (n/> +1)) - -(def: #export (adjust up-arity after? var) - (-> Arity Bool 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) - (-> Synthesizer Synthesizer) - (.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 (//loop.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 //.State a))) - (|>> (case> (#.Some output) - (:: ///compiler.Monad wrap output) - - #.None - (///compiler.throw cannot-prepare-function-body [])))) - -(def: #export (function synthesize environment body) - (-> Synthesizer Environment Analysis (Operation //.State 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 true resolved) - - #.None - (adjust arity false 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/lang/compiler/synthesis/loop.lux b/stdlib/source/lux/lang/compiler/synthesis/loop.lux deleted file mode 100644 index e4722ee1f..000000000 --- a/stdlib/source/lux/lang/compiler/synthesis/loop.lux +++ /dev/null @@ -1,285 +0,0 @@ -(.module: - [lux #- loop] - (lux (control [monad #+ do] - ["p" parser]) - (data [maybe "maybe/" Monad] - (collection [list "list/" Functor])) - (macro [code] - [syntax])) - [///] - [///reference #+ Register Variable] - [///analysis #+ Environment] - [// #+ Path Abstraction Synthesis]) - -(type: #export (Transform a) - (-> a (Maybe a))) - -(def: (some? maybe) - (All [a] (-> (Maybe a) Bool)) - (case maybe - (#.Some _) true - #.None false)) - -(template: #export (self) - (#//.Reference (///reference.local +0))) - -(template: (recursive-apply args) - (#//.Apply (self) args)) - -(def: proper Bool true) -(def: improper Bool false) - -(def: (proper? exprS) - (-> Synthesis Bool) - (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/lang/compiler/translation.lux b/stdlib/source/lux/lang/compiler/translation.lux deleted file mode 100644 index 8791c8d5e..000000000 --- a/stdlib/source/lux/lang/compiler/translation.lux +++ /dev/null @@ -1,162 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:] - [monad #+ do]) - (data [maybe "maybe/" Functor] - [error #+ Error] - [text] - text/format - (collection [row #+ Row] - ["dict" dictionary #+ Dictionary])) - (world [file #+ File])) - [// #+ Operation Compiler] - [//synthesis #+ Synthesis]) - -(do-template [] - [(exception: #export () - "")] - - [no-active-buffer] - [no-anchor] - ) - -(exception: #export (cannot-interpret {message Text}) - message) - -(type: #export Context - {#scope-name Text - #inner-functions Nat}) - -(signature: #export (Host code) - (: (-> code (Error Any)) - execute!) - (: (-> code (Error Any)) - evaluate!)) - -(type: #export (Buffer code) (Row [Ident code])) - -(type: #export (Artifacts code) (Dictionary File (Buffer code))) - -(type: #export (State anchor code) - {#context Context - #anchor (Maybe anchor) - #host (Host code) - #buffer (Maybe (Buffer code)) - #artifacts (Artifacts code)}) - -(type: #export (Translator anchor code) - (Compiler (State anchor code) Synthesis code)) - -(def: #export (init host) - (All [anchor code] (-> (Host code) (..State anchor code))) - {#context {#scope-name "" - #inner-functions +0} - #anchor #.None - #host host - #buffer #.None - #artifacts (dict.new text.Hash)}) - -(def: #export (with-context expr) - (All [anchor code output] - (-> (Operation (..State anchor code) output) - (Operation (..State anchor code) [Text output]))) - (function (_ state) - (let [[old-scope old-inner] (get@ #context state) - new-scope (format old-scope "c___" (%i (.int old-inner)))] - (case (expr (set@ #context [new-scope +0] state)) - (#error.Success [state' output]) - (#error.Success [(set@ #context [old-scope (inc old-inner)] state') - [new-scope output]]) - - (#error.Error error) - (#error.Error error))))) - -(def: #export context - (All [anchor code] (Operation (..State anchor code) Text)) - (function (_ state) - (#error.Success [state - (|> state - (get@ #context) - (get@ #scope-name))]))) - -(do-template [ - - ] - [(def: #export - (All [anchor code output] ) - (function (_ body) - (function (_ state) - (case (body (set@ (#.Some ) state)) - (#error.Success [state' output]) - (#error.Success [(set@ (get@ state) state') - output]) - - (#error.Error error) - (#error.Error error))))) - - (def: #export - (All [anchor code] (Operation (..State anchor code) )) - (function (_ state) - (case (get@ state) - (#.Some output) - (#error.Success [state output]) - - #.None - (ex.throw []))))] - - [#anchor - (with-anchor anchor) - (-> anchor (Operation (..State anchor code) output) - (Operation (..State anchor code) output)) - anchor - anchor anchor no-anchor] - - [#buffer - with-buffer - (-> (Operation (..State anchor code) output) - (Operation (..State anchor code) output)) - row.empty - buffer (Buffer code) no-active-buffer] - ) - -(def: #export artifacts - (All [anchor code] - (Operation (..State anchor code) (Artifacts code))) - (function (_ state) - (#error.Success [state (get@ #artifacts state)]))) - -(do-template [] - [(def: #export ( code) - (All [anchor code] - (-> code (Operation (..State anchor code) Any))) - (function (_ state) - (case (:: (get@ #host state) code) - (#error.Error error) - (ex.throw cannot-interpret error) - - (#error.Success output) - (#error.Success [state output]))))] - - [execute!] - [evaluate!] - ) - -(def: #export (save! name code) - (All [anchor code] - (-> Ident code (Operation (..State anchor code) Any))) - (do //.Monad - [_ (execute! code)] - (function (_ state) - (#error.Success [(update@ #buffer - (maybe/map (row.add [name code])) - state) - []])))) - -(def: #export (save-buffer! target) - (All [anchor code] - (-> File (Operation (..State anchor code) Any))) - (do //.Monad - [buffer ..buffer] - (function (_ state) - (#error.Success [(update@ #artifacts (dict.put target buffer) state) - []])))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/case.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/case.jvm.lux deleted file mode 100644 index 39b5bdae1..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/case.jvm.lux +++ /dev/null @@ -1,170 +0,0 @@ -(.module: - [lux #- case let if] - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [number] - [text] - text/format - (collection [list "list/" Functor Fold] - [set #+ Set]))) - (///// [reference #+ Register] - (host ["_" scheme #+ Expression Computation Var]) - [compiler #+ "operation/" Monad] - (compiler [synthesis #+ Synthesis Path])) - [//runtime #+ Operation Translator] - [//reference]) - -(def: #export (let translate [valueS register bodyS]) - (-> Translator [Synthesis Register Synthesis] - (Operation Computation)) - (do compiler.Monad - [valueO (translate valueS) - bodyO (translate bodyS)] - (wrap (_.let (list [(//reference.local' register) valueO]) - bodyO)))) - -(def: #export (record-get translate valueS pathP) - (-> Translator Synthesis (List [Nat Bool]) - (Operation Expression)) - (do compiler.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]) - (-> Translator [Synthesis Synthesis Synthesis] - (Operation Computation)) - (do compiler.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) - (-> Translator 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/bool _.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 compiler.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))))]) - - _ - (compiler.throw unrecognized-path []))) - -(def: (pattern-matching translate pathP) - (-> Translator Path (Operation Computation)) - (do compiler.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]) - (-> Translator [Synthesis Path] (Operation Computation)) - (do compiler.Monad - [valueO (translate valueS)] - (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))] - [@savepoint (_.list/* (list))]))) - (pattern-matching translate pathP)))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/expression.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/expression.jvm.lux deleted file mode 100644 index a654fe4d0..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/expression.jvm.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do])) - (///// [compiler] - (compiler [synthesis] - [extension])) - [//runtime #+ Translator] - [//primitive] - [//structure] - [//reference] - [//function] - [//case] - [//loop]) - -(def: #export (translate synthesis) - Translator - (case synthesis - (^template [ ] - (^ ( value)) - ( value)) - ([synthesis.bool //primitive.bool] - [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))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/extension.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/extension.jvm.lux deleted file mode 100644 index 9fa0abc55..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/extension.jvm.lux +++ /dev/null @@ -1,32 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (collection ["dict" dictionary #+ Dictionary]))) - (///// [reference #+ Register Variable] - (host ["_" scheme #+ Computation]) - [compiler "operation/" Monad] - (compiler [synthesis #+ Synthesis])) - [//runtime #+ Operation Translator] - [/common] - ## [/host] - ) - -(exception: #export (unknown-extension {message Text}) - message) - -(def: extensions - /common.Bundle - (|> /common.extensions - ## (dict.merge /host.extensions) - )) - -(def: #export (extension translate name args) - (-> Translator Text (List Synthesis) - (Operation Computation)) - (<| (maybe.default (compiler.throw unknown-extension (%t name))) - (do maybe.Monad - [ext (dict.get name extensions)] - (wrap (ext translate args))))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/extension/common.jvm.lux deleted file mode 100644 index 11743b076..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/extension/common.jvm.lux +++ /dev/null @@ -1,376 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data ["e" error] - [product] - [text] - text/format - [number #+ hex] - (collection [list "list/" Functor] - ["dict" dictionary #+ Dictionary])) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:]) - [host]) - (////// (host ["_" scheme #+ Expression Computation]) - [compiler] - (compiler [synthesis #+ Synthesis])) - [///runtime #+ Operation Translator]) - -## [Types] -(type: #export Extension - (-> Translator (List Synthesis) (Operation Computation))) - -(type: #export Bundle - (Dictionary Text Extension)) - -(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] -(def: #export (install name unnamed) - (-> Text (-> Text Extension) - (-> Bundle Bundle)) - (dict.put name (unnamed name))) - -(def: #export (prefix prefix bundle) - (-> Text Bundle Bundle) - (|> bundle - dict.entries - (list/map (function (_ [key val]) [(format prefix " " key) val])) - (dict.from-list text.Hash))) - -(exception: #export (wrong-arity {extension Text} {expected Nat} {actual Nat}) - (ex.report ["Extension" (%t extension)] - ["Expected" (|> expected .int %i)] - ["Actual" (|> actual .int %i)])) - -(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) - (-> Text ..Extension)) - (function ((~ g!_) (~ g!name)) - (function ((~ g!_) (~ g!translate) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!input+))) - (do compiler.Monad - [(~+ (|> g!input+ - (list/map (function (_ g!input) - (list g!input (` ((~ g!translate) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) - - (~' _) - (compiler.throw wrong-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 (-> Text Extension)) - (function (_ extension-name) - (function (_ translate inputsS) - (do compiler.Monad - [inputsI (monad.map @ translate inputsS)] - (wrap (extension inputsI)))))) - -## [Extensions] -## [[Lux]] -(def: extensions/lux - Bundle - (|> (dict.new text.Hash) - (install "is?" (binary (product.uncurry _.eq?/2))) - (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: extensions/bit - Bundle - (<| (prefix "bit") - (|> (dict.new text.Hash) - (install "and" (binary bit//and)) - (install "or" (binary bit//or)) - (install "xor" (binary bit//xor)) - (install "left-shift" (binary bit//left-shift)) - (install "logical-right-shift" (binary bit//logical-right-shift)) - (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) - ))) - -## [[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: extensions/array - Bundle - (<| (prefix "array") - (|> (dict.new text.Hash) - (install "new" (unary array//new)) - (install "get" (binary array//get)) - (install "put" (trinary array//put)) - (install "remove" (binary array//remove)) - (install "size" (unary _.vector-length/1)) - ))) - -## [[Numbers]] -(host.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: extensions/int - Bundle - (<| (prefix "int") - (|> (dict.new text.Hash) - (install "+" (binary int//+)) - (install "-" (binary int//-)) - (install "*" (binary int//*)) - (install "/" (binary int///)) - (install "%" (binary int//%)) - (install "=" (binary int//=)) - (install "<" (binary int//<)) - (install "to-frac" (unary (|>> (_.//2 (_.float 1.0))))) - (install "char" (unary int//char))))) - -(def: extensions/frac - Bundle - (<| (prefix "frac") - (|> (dict.new text.Hash) - (install "+" (binary frac//+)) - (install "-" (binary frac//-)) - (install "*" (binary frac//*)) - (install "/" (binary frac///)) - (install "%" (binary frac//%)) - (install "=" (binary frac//=)) - (install "<" (binary frac//<)) - (install "smallest" (nullary frac//smallest)) - (install "min" (nullary frac//min)) - (install "max" (nullary frac//max)) - (install "to-int" (unary _.exact/1)) - (install "encode" (unary _.number->string/1)) - (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: extensions/text - Bundle - (<| (prefix "text") - (|> (dict.new text.Hash) - (install "=" (binary text//=)) - (install "<" (binary text//<)) - (install "concat" (binary (product.uncurry _.string-append/2))) - (install "size" (unary _.string-length/1)) - (install "char" (binary text//char)) - (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: extensions/math - Bundle - (<| (prefix "math") - (|> (dict.new text.Hash) - (install "cos" (unary (math-func "cos"))) - (install "sin" (unary (math-func "sin"))) - (install "tan" (unary (math-func "tan"))) - (install "acos" (unary (math-func "acos"))) - (install "asin" (unary (math-func "asin"))) - (install "atan" (unary (math-func "atan"))) - (install "exp" (unary (math-func "exp"))) - (install "log" (unary (math-func "log"))) - (install "ceil" (unary (math-func "ceiling"))) - (install "floor" (unary (math-func "floor"))) - (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: extensions/io - Bundle - (<| (prefix "io") - (|> (dict.new text.Hash) - (install "log" (unary (|>> io//log ..void))) - (install "error" (unary _.raise/1)) - (install "exit" (unary _.exit/1)) - (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: extensions/atom - Bundle - (<| (prefix "atom") - (|> (dict.new text.Hash) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "compare-and-swap" (trinary atom//compare-and-swap))))) - -## [[Box]] -(def: (box//write [valueO boxO]) - Binary - (///runtime.box//write valueO boxO)) - -(def: extensions/box - Bundle - (<| (prefix "box") - (|> (dict.new text.Hash) - (install "new" (unary atom//new)) - (install "read" (unary atom//read)) - (install "write" (binary box//write))))) - -## [[Processes]] -(def: (process//parallelism-level []) - Nullary - (_.int 1)) - -(def: extensions/process - Bundle - (<| (prefix "process") - (|> (dict.new text.Hash) - (install "parallelism-level" (nullary process//parallelism-level)) - (install "schedule" (binary (product.uncurry ///runtime.process//schedule))) - ))) - -## [Bundles] -(def: #export extensions - Bundle - (<| (prefix "lux") - (|> extensions/lux - (dict.merge extensions/bit) - (dict.merge extensions/int) - (dict.merge extensions/frac) - (dict.merge extensions/text) - (dict.merge extensions/array) - (dict.merge extensions/math) - (dict.merge extensions/io) - (dict.merge extensions/atom) - (dict.merge extensions/box) - (dict.merge extensions/process) - ))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/function.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/function.jvm.lux deleted file mode 100644 index 1ac433ec4..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/function.jvm.lux +++ /dev/null @@ -1,85 +0,0 @@ -(.module: - [lux #- function] - (lux (control [monad #+ do] - pipe) - (data [product] - text/format - (collection [list "list/" Functor]))) - (///// [reference #+ Register Variable] - [name] - (host ["_" scheme #+ Expression Computation Var]) - [compiler "operation/" Monad] - (compiler [analysis #+ Variant Tuple Environment Arity Abstraction Application Analysis] - [synthesis #+ Synthesis])) - [///] - [//runtime #+ Operation Translator] - [//primitive] - [//reference]) - -(def: #export (apply translate [functionS argsS+]) - (-> Translator (Application Synthesis) (Operation Computation)) - (do compiler.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]) - (-> Translator (Abstraction Synthesis) (Operation Computation)) - (do compiler.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/lang/compiler/translation/scheme/loop.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/loop.jvm.lux deleted file mode 100644 index f77f7cf10..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/loop.jvm.lux +++ /dev/null @@ -1,36 +0,0 @@ -(.module: - [lux #- Scope] - (lux (control [monad #+ do]) - (data [product] - [text] - text/format - (collection [list "list/" Functor])) - [macro]) - (///// (host ["_" scheme #+ Computation Var]) - [compiler] - (compiler [synthesis #+ Scope Synthesis])) - [///] - [//runtime #+ Operation Translator] - [//reference]) - -(def: @scope (_.var "scope")) - -(def: #export (scope translate [start initsS+ bodyS]) - (-> Translator (Scope Synthesis) (Operation Computation)) - (do compiler.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+) - (-> Translator (List Synthesis) (Operation Computation)) - (do compiler.Monad - [@scope ///.anchor - argsO+ (monad.map @ translate argsS+)] - (wrap (_.apply/* @scope argsO+)))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/primitive.jvm.lux deleted file mode 100644 index e78df5b74..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/primitive.jvm.lux +++ /dev/null @@ -1,22 +0,0 @@ -(.module: - [lux #- i64] - [/// #+ State] - (///// [compiler #+ "operation/" Monad] - (host ["_" scheme #+ Expression])) - [//runtime #+ Operation]) - -(def: #export bool - (-> Bool (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/lang/compiler/translation/scheme/reference.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/reference.jvm.lux deleted file mode 100644 index e1cb6a642..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/reference.jvm.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - lux - (lux (control pipe) - (data text/format)) - (///// [reference #+ Register Variable Reference] - [name] - (host ["_" scheme #+ Expression Var]) - [compiler "operation/" Monad] - (compiler [analysis #+ Variant Tuple] - [synthesis #+ Synthesis])) - [//runtime #+ Operation Translator] - [//primitive]) - -(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/lang/compiler/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/runtime.jvm.lux deleted file mode 100644 index 89707cdc4..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/runtime.jvm.lux +++ /dev/null @@ -1,362 +0,0 @@ -(.module: - lux - (lux (control ["p" parser "p/" Monad] - [monad #+ do]) - (data [number #+ hex] - text/format - (collection [list "list/" Monad])) - [function] - (macro [code] - ["s" syntax #+ syntax:])) - [/// #+ State] - (///// [name] - (host ["_" scheme #+ Expression Computation Var]) - [compiler] - (compiler [analysis #+ Variant] - [synthesis]))) - -(type: #export Operation - (compiler.Operation (State Var Expression))) - -(type: #export Translator - (///.Translator Var Expression)) - -(def: prefix Text "LuxRuntime") - -(def: unit (_.string synthesis.unit)) - -(def: #export variant-tag "lux-variant") - -(def: (flag value) - (-> Bool 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 false ..unit])) - -(def: #export some - (-> Expression Computation) - (|>> [+0 true] ..variant)) - -(def: #export left - (-> Expression Computation) - (|>> [+0 false] ..variant)) - -(def: #export right - (-> Expression Computation) - (|>> [+0 true] ..variant)) - -(def: declaration - (s.Syntax [Text (List Text)]) - (p.either (p.seq s.local-symbol (p/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 true))) - (_.bool false))))) - -(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 compiler.Monad - [_ (///.save! ["" ..prefix] ..runtime)] - (///.save-buffer! "")))) diff --git a/stdlib/source/lux/lang/compiler/translation/scheme/structure.jvm.lux b/stdlib/source/lux/lang/compiler/translation/scheme/structure.jvm.lux deleted file mode 100644 index c3b93e7a1..000000000 --- a/stdlib/source/lux/lang/compiler/translation/scheme/structure.jvm.lux +++ /dev/null @@ -1,29 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do])) - (///// (host ["_" scheme #+ Expression]) - [compiler] - (compiler [analysis #+ Variant Tuple] - [synthesis #+ Synthesis])) - [//runtime #+ Operation Translator] - [//primitive]) - -(def: #export (tuple translate elemsS+) - (-> Translator (Tuple Synthesis) (Operation Expression)) - (case elemsS+ - #.Nil - (//primitive.text synthesis.unit) - - (#.Cons singletonS #.Nil) - (translate singletonS) - - _ - (do compiler.Monad - [elemsT+ (monad.map @ translate elemsS+)] - (wrap (_.vector/* elemsT+))))) - -(def: #export (variant translate [lefts right? valueS]) - (-> Translator (Variant Synthesis) (Operation Expression)) - (do compiler.Monad - [valueT (translate valueS)] - (wrap (//runtime.variant [lefts right? valueT])))) diff --git a/stdlib/source/lux/lang/host.lux b/stdlib/source/lux/lang/host.lux deleted file mode 100644 index 218de67a4..000000000 --- a/stdlib/source/lux/lang/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/lang/host/scheme.lux b/stdlib/source/lux/lang/host/scheme.lux deleted file mode 100644 index 93d1b2017..000000000 --- a/stdlib/source/lux/lang/host/scheme.lux +++ /dev/null @@ -1,302 +0,0 @@ -(.module: - [lux #- Code' Code int or and if function cond when let] - (lux (control pipe) - (data [text] - text/format - [number] - (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 - (-> Bool Computation) - (|>> (case> true "#t" - false "#f") - :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/lang/module.lux b/stdlib/source/lux/lang/module.lux
deleted file mode 100644
index dbb1cc0ea..000000000
--- a/stdlib/source/lux/lang/module.lux
+++ /dev/null
@@ -1,240 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                pipe)
-       (data [text "text/" Equivalence]
-             text/format
-             ["e" error]
-             (collection [list "list/" Fold Functor]
-                         (dictionary [plist])))
-       [macro])
-  [//compiler]
-  (//compiler [analysis]))
-
-(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 (Meta Any))
-  (do macro.Monad
-    [self-name macro.current-module-name
-     self macro.current-module]
-    (case (get@ #.module-annotations self)
-      #.None
-      (function (_ compiler)
-        (#e.Success [(update@ #.modules
-                              (plist.put self-name (set@ #.module-annotations (#.Some annotations) self))
-                              compiler)
-                     []]))
-      
-      (#.Some old)
-      (//compiler.throw cannot-set-module-annotations-more-than-once [self-name old annotations]))))
-
-(def: #export (import module)
-  (-> Text (Meta Any))
-  (do macro.Monad
-    [self-name macro.current-module-name]
-    (function (_ compiler)
-      (#e.Success [(update@ #.modules
-                            (plist.update self-name (update@ #.imports (|>> (#.Cons module))))
-                            compiler)
-                   []]))))
-
-(def: #export (alias alias module)
-  (-> Text Text (Meta Any))
-  (do macro.Monad
-    [self-name macro.current-module-name]
-    (function (_ compiler)
-      (#e.Success [(update@ #.modules
-                            (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
-                                                                                 (|>> (#.Cons [alias module])))))
-                            compiler)
-                   []]))))
-
-(def: #export (exists? module)
-  (-> Text (Meta Bool))
-  (function (_ compiler)
-    (|> compiler
-        (get@ #.modules)
-        (plist.get module)
-        (case> (#.Some _) true #.None false)
-        [compiler] #e.Success)))
-
-(def: #export (define name definition)
-  (-> Text Definition (Meta []))
-  (do macro.Monad
-    [self-name macro.current-module-name
-     self macro.current-module]
-    (function (_ compiler)
-      (case (plist.get name (get@ #.definitions self))
-        #.None
-        (#e.Success [(update@ #.modules
-                              (plist.put self-name
-                                         (update@ #.definitions
-                                                  (: (-> (List [Text Definition]) (List [Text Definition]))
-                                                     (|>> (#.Cons [name definition])))
-                                                  self))
-                              compiler)
-                     []])
-
-        (#.Some already-existing)
-        ((//compiler.throw cannot-define-more-than-once [self-name name]) compiler)))))
-
-(def: #export (create hash name)
-  (-> Nat Text (Meta []))
-  (function (_ compiler)
-    (let [module (new hash)]
-      (#e.Success [(update@ #.modules
-                            (plist.put name module)
-                            compiler)
-                   []]))))
-
-(def: #export (with-module hash name action)
-  (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
-  (do macro.Monad
-    [_ (create hash name)
-     output (analysis.with-current-module name
-              action)
-     module (macro.find-module name)]
-    (wrap [module output])))
-
-(do-template [  ]
-  [(def: #export ( module-name)
-     (-> Text (Meta Any))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (plist.get module-name))
-         (#.Some module)
-         (let [active? (case (get@ #.module-state module)
-                         #.Active true
-                         _     false)]
-           (if active?
-             (#e.Success [(update@ #.modules
-                                   (plist.put module-name (set@ #.module-state  module))
-                                   compiler)
-                          []])
-             ((//compiler.throw can-only-change-state-of-active-module [module-name ])
-              compiler)))
-
-         #.None
-         ((//compiler.throw unknown-module module-name) compiler))))
-   
-   (def: #export ( module-name)
-     (-> Text (Meta Bool))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (plist.get module-name))
-         (#.Some module)
-         (#e.Success [compiler
-                      (case (get@ #.module-state module)
-                         true
-                        _     false)])
-
-         #.None
-         ((//compiler.throw unknown-module module-name) compiler))))]
-
-  [set-active   active?   #.Active]
-  [set-compiled compiled? #.Compiled]
-  [set-cached   cached?   #.Cached]
-  )
-
-(do-template [  ]
-  [(def: ( module-name)
-     (-> Text (Meta ))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (plist.get module-name))
-         (#.Some module)
-         (#e.Success [compiler (get@  module)])
-
-         #.None
-         ((//compiler.throw unknown-module module-name) compiler))))]
-
-  [tags  #.tags        (List [Text [Nat (List Ident) Bool Type]])]
-  [types #.types       (List [Text [(List Ident) Bool Type]])]
-  [hash  #.module-hash Nat]
-  )
-
-(def: (ensure-undeclared-tags module-name tags)
-  (-> Text (List Tag) (Meta Any))
-  (do macro.Monad
-    [bindings (..tags module-name)
-     _ (monad.map @
-                  (function (_ tag)
-                    (case (plist.get tag bindings)
-                      #.None
-                      (wrap [])
-
-                      (#.Some _)
-                      (//compiler.throw cannot-declare-tag-twice [module-name tag])))
-                  tags)]
-    (wrap [])))
-
-(def: #export (declare-tags tags exported? type)
-  (-> (List Tag) Bool Type (Meta Any))
-  (do macro.Monad
-    [self-name macro.current-module-name
-     [type-module type-name] (case type
-                               (#.Named type-ident _)
-                               (wrap type-ident)
-
-                               _
-                               (//compiler.throw cannot-declare-tags-for-unnamed-type [tags type]))
-     _ (ensure-undeclared-tags self-name tags)
-     _ (//compiler.assert cannot-declare-tags-for-foreign-type [tags type]
-                          (text/= self-name type-module))]
-    (function (_ compiler)
-      (case (|> compiler (get@ #.modules) (plist.get self-name))
-        (#.Some module)
-        (let [namespaced-tags (list/map (|>> [self-name]) tags)]
-          (#e.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]))))
-                                compiler)
-                       []]))
-        #.None
-        ((//compiler.throw unknown-module self-name) compiler)))))
diff --git a/stdlib/source/lux/lang/name.lux b/stdlib/source/lux/lang/name.lux
deleted file mode 100644
index 1053eb76f..000000000
--- a/stdlib/source/lux/lang/name.lux
+++ /dev/null
@@ -1,47 +0,0 @@
-(.module:
-  lux
-  (lux (data [maybe]
-             [text]
-             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/lang/reference.lux b/stdlib/source/lux/lang/reference.lux
deleted file mode 100644
index 43c8f0d48..000000000
--- a/stdlib/source/lux/lang/reference.lux
+++ /dev/null
@@ -1,66 +0,0 @@
-(.module:
-  lux
-  (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])
-
-      _
-      false)))
-
-(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 Bool)
-  (|>> ..variable
-       (case> (^ (..local +0))
-              true
-
-              _
-              false)))
diff --git a/stdlib/source/lux/lang/scope.lux b/stdlib/source/lux/lang/scope.lux
deleted file mode 100644
index 9cb1de1c2..000000000
--- a/stdlib/source/lux/lang/scope.lux
+++ /dev/null
@@ -1,188 +0,0 @@
-(.module:
-  lux
-  (lux (control monad)
-       (data [text "text/" Equivalence]
-             text/format
-             [maybe "maybe/" Monad]
-             [product]
-             ["e" error]
-             (collection [list "list/" Functor Fold Monoid]
-                         (dictionary [plist])))
-       [macro])
-  [//reference #+ Register Variable])
-
-(type: Locals (Bindings Text [Type Register]))
-(type: Foreign (Bindings Text [Type Variable]))
-
-(def: (is-local? name scope)
-  (-> Text Scope Bool)
-  (|> scope
-      (get@ [#.locals #.mappings])
-      (plist.contains? name)))
-
-(def: (get-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: (is-captured? name scope)
-  (-> Text Scope Bool)
-  (|> scope
-      (get@ [#.captured #.mappings])
-      (plist.contains? name)))
-
-(def: (get-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: (is-ref? name scope)
-  (-> Text Scope Bool)
-  (or (is-local? name scope)
-      (is-captured? name scope)))
-
-(def: (get-ref name scope)
-  (-> Text Scope (Maybe [Type Variable]))
-  (case (get-local name scope)
-    (#.Some type)
-    (#.Some type)
-
-    _
-    (get-captured name scope)))
-
-(def: #export (find name)
-  (-> Text (Meta (Maybe [Type Variable])))
-  (function (_ compiler)
-    (let [[inner outer] (|> compiler
-                            (get@ #.scopes)
-                            (list.split-with (|>> (is-ref? name) not)))]
-      (case outer
-        #.Nil
-        (#.Right [compiler #.None])
-
-        (#.Cons top-outer _)
-        (let [[ref-type init-ref] (maybe.default (undefined)
-                                                 (get-ref 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 compiler)
-                    (#.Some [ref-type ref])]))
-        ))))
-
-(def: #export (with-local [name type] action)
-  (All [a] (-> [Text Type] (Meta a) (Meta a)))
-  (function (_ compiler)
-    (case (get@ #.scopes compiler)
-      (#.Cons head tail)
-      (let [old-mappings (get@ [#.locals #.mappings] head)
-            new-var-id (get@ [#.locals #.counter] head)
-            new-head (update@ #.locals
-                              (: (-> Locals Locals)
-                                 (|>> (update@ #.counter inc)
-                                      (update@ #.mappings (plist.put name [type new-var-id]))))
-                              head)]
-        (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler)
-                          action)
-          (#e.Success [compiler' output])
-          (case (get@ #.scopes compiler')
-            (#.Cons head' tail')
-            (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
-                                  tail')]
-              (#e.Success [(set@ #.scopes scopes' compiler')
-                           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 (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [parent-name (case (get@ #.scopes compiler)
-                        #.Nil
-                        (list)
-                        
-                        (#.Cons top _)
-                        (get@ #.name top))]
-      (case (action (update@ #.scopes
-                             (|>> (#.Cons (scope parent-name name)))
-                             compiler))
-        (#e.Error error)
-        (#e.Error error)
-
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.scopes
-                              (|>> list.tail (maybe.default (list)))
-                              compiler')
-                     output])
-        ))
-    ))
-
-(def: #export next-local
-  (Meta Register)
-  (function (_ compiler)
-    (case (get@ #.scopes compiler)
-      #.Nil
-      (#e.Error "Cannot get next reference when there is no scope.")
-      
-      (#.Cons top _)
-      (#e.Success [compiler (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/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux
deleted file mode 100644
index b9214ca11..000000000
--- a/stdlib/source/lux/lang/syntax.lux
+++ /dev/null
@@ -1,626 +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]
-  (lux (control monad
-                ["p" parser "p/" Monad]
-                ["ex" exception #+ exception:])
-       (data ["e" error]
-             [number]
-             [product]
-             [maybe]
-             [text]
-             (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 "_") (p/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? false]
-                             (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)))
-                                                    false)
-                                             (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))))
-                                                      false))
-                                             ## Must handle escaped
-                                             ## chars separately.
-                                             (do @
-                                               [[chars-consumed char] escaped-char^]
-                                               (recur (format text-read char)
-                                                      (|> where
-                                                          (update@ #.column (n/+ chars-consumed)))
-                                                      false))
-                                             ## 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))
-                                                true)))))]
-    (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 [ ]
-                      ["" ]
-                      (#.Bool ))
-                    (["true"  true]
-                     ["false" false])
-                    
-                    _
-                    (#.Symbol value))]])))
-
-(exception: #export (end-of-file {module Text})
-  module)
-
-(exception: #export (unrecognized-input {[file line column] Cursor})
-  (format "  File: " file "\n"
-          "  Line: " (%n line) "\n"
-          "Column: " (%n column) "\n"))
-
-(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/lang/type.lux b/stdlib/source/lux/lang/type.lux
deleted file mode 100644
index b7e04afa4..000000000
--- a/stdlib/source/lux/lang/type.lux
+++ /dev/null
@@ -1,389 +0,0 @@
-(.module: {#.doc "Basic functionality for working with types."}
-  [lux #- function]
-  (lux (control [equivalence #+ Equivalence]
-                [monad #+ do Monad]
-                ["p" parser])
-       (data [text "text/" Monoid Equivalence]
-             [ident "ident/" Equivalence Codec]
-             [number "nat/" Codec]
-             [maybe]
-             (collection [list #+ "list/" Functor Monoid Fold]))
-       [macro]
-       (macro [code]
-              ["s" syntax #+ Syntax syntax:])
-       ))
-
-## [Utils]
-(def: (beta-reduce env type)
-  (-> (List Type) Type Type)
-  (case type
-    (#.Primitive name params)
-    (#.Primitive name (list/map (beta-reduce env) params))
-    
-    (^template []
-      ( left right)
-      ( (beta-reduce env left) (beta-reduce env right)))
-    ([#.Sum]      [#.Product]
-     [#.Function] [#.Apply])
-    
-    (^template []
-      ( old-env def)
-      (case old-env
-        #.Nil
-        ( env def)
-
-        _
-        ( (list/map (beta-reduce env) old-env) def)))
-    ([#.UnivQ]
-     [#.ExQ])
-    
-    (#.Parameter idx)
-    (maybe.default (error! (text/compose "Unknown type var: " (nat/encode idx)))
-                   (list.nth idx env))
-    
-    _
-    type
-    ))
-
-## [Structures]
-(structure: #export _ (Equivalence Type)
-  (def: (= x y)
-    (case [x y]
-      [(#.Primitive xname xparams) (#.Primitive yname yparams)]
-      (and (text/= xname yname)
-           (n/= (list.size yparams) (list.size xparams))
-           (list/fold (.function (_ [x y] prev) (and prev (= x y)))
-                      true
-                      (list.zip2 xparams yparams)))
-
-      (^template []
-        [( xid) ( yid)]
-        (n/= yid xid))
-      ([#.Var] [#.Ex] [#.Parameter])
-
-      (^or [(#.Function xleft xright) (#.Function yleft yright)]
-           [(#.Apply xleft xright) (#.Apply yleft yright)])
-      (and (= xleft yleft)
-           (= xright yright))
-
-      [(#.Named xname xtype) (#.Named yname ytype)]
-      (and (ident/= xname yname)
-           (= xtype ytype))
-
-      (^template []
-        [( xL xR) ( yL yR)]
-        (and (= xL yL) (= xR yR)))
-      ([#.Sum] [#.Product])
-      
-      (^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)]
-           [(#.ExQ xenv xbody) (#.ExQ yenv ybody)])
-      (and (n/= (list.size yenv) (list.size xenv))
-           (= xbody ybody)
-           (list/fold (.function (_ [x y] prev) (and prev (= x y)))
-                      true
-                      (list.zip2 xenv yenv)))
-
-      _
-      false
-      )))
-
-## [Values]
-(do-template [ ]
-  [(def: #export ( type)
-     (-> Type [Nat Type])
-     (loop [num-args +0
-            type type]
-       (case type
-         ( env sub-type)
-         (recur (inc num-args) sub-type)
-
-         _
-         [num-args type])))]
-
-  [flatten-univ-q #.UnivQ]
-  [flatten-ex-q   #.ExQ]
-  )
-
-(def: #export (flatten-function type)
-  (-> Type [(List Type) Type])
-  (case type
-    (#.Function in out')
-    (let [[ins out] (flatten-function out')]
-      [(list& in ins) out])
-
-    _
-    [(list) type]))
-
-(def: #export (flatten-application type)
-  (-> Type [Type (List Type)])
-  (case type
-    (#.Apply arg func')
-    (let [[func args] (flatten-application func')]
-      [func (list/compose args (list arg))])
-
-    _
-    [type (list)]))
-
-(do-template [ ]
-  [(def: #export ( type)
-     (-> Type (List Type))
-     (case type
-       ( left right)
-       (list& left ( right))
-
-       _
-       (list type)))]
-
-  [flatten-variant #.Sum]
-  [flatten-tuple   #.Product]
-  )
-
-(def: #export (apply params func)
-  (-> (List Type) Type (Maybe Type))
-  (case params
-    #.Nil
-    (#.Some func)
-
-    (#.Cons param params')
-    (case func
-      (^template []
-        ( env body)
-        (|> body
-            (beta-reduce (list& func param env))
-            (apply params')))
-      ([#.UnivQ] [#.ExQ])
-
-      (#.Apply A F)
-      (apply (list& A params) F)
-
-      (#.Named name unnamed)
-      (apply params unnamed)
-      
-      _
-      #.None)))
-
-(def: #export (to-code type)
-  (-> Type Code)
-  (case type
-    (#.Primitive name params)
-    (` (#.Primitive (~ (code.text name))
-                    (.list (~+ (list/map to-code params)))))
-
-    (^template []
-      ( idx)
-      (` ( (~ (code.nat idx)))))
-    ([#.Var] [#.Ex] [#.Parameter])
-
-    (^template []
-      ( left right)
-      (` ( (~ (to-code left))
-                (~ (to-code right)))))
-    ([#.Sum] [#.Product] [#.Function] [#.Apply])
-
-    (#.Named name sub-type)
-    (code.symbol name)
-
-    (^template []
-      ( env body)
-      (` ( (.list (~+ (list/map to-code env)))
-                (~ (to-code body)))))
-    ([#.UnivQ] [#.ExQ])
-    ))
-
-(def: #export (to-text type)
-  (-> Type Text)
-  (case type
-    (#.Primitive name params)
-    (case params
-      #.Nil
-      ($_ text/compose "(primitive " name ")")
-
-      _
-      ($_ text/compose "(primitive " name " " (|> params (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")"))
-
-    (^template [   ]
-      ( _)
-      ($_ text/compose 
-          (|> ( type)
-              (list/map to-text)
-              list.reverse
-              (list.interpose " ")
-              (list/fold text/compose ""))
-          ))
-    ([#.Sum  "(| " ")" flatten-variant]
-     [#.Product "["   "]" flatten-tuple])
-
-    (#.Function input output)
-    (let [[ins out] (flatten-function type)]
-      ($_ text/compose  "(-> "
-          (|> ins
-              (list/map to-text)
-              list.reverse
-              (list.interpose " ")
-              (list/fold text/compose ""))
-          " " (to-text out) ")"))
-
-    (#.Parameter idx)
-    (nat/encode idx)
-
-    (#.Var id)
-    ($_ text/compose "⌈v:" (nat/encode id) "⌋")
-
-    (#.Ex id)
-    ($_ text/compose "⟨e:" (nat/encode id) "⟩")
-
-    (#.Apply param fun)
-    (let [[type-func type-args] (flatten-application type)]
-      ($_ text/compose  "(" (to-text type-func) " " (|> type-args (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")"))
-
-    (^template [ ]
-      ( env body)
-      ($_ text/compose "("  " {" (|> env (list/map to-text) (text.join-with " ")) "} " (to-text body) ")"))
-    ([#.UnivQ "All"]
-     [#.ExQ "Ex"])
-
-    (#.Named [module name] type)
-    ($_ text/compose module "." name)
-    ))
-
-(def: #export (un-alias type)
-  (-> Type Type)
-  (case type
-    (#.Named _ (#.Named ident type'))
-    (un-alias (#.Named ident type'))
-
-    _
-    type))
-
-(def: #export (un-name type)
-  (-> Type Type)
-  (case type
-    (#.Named ident type')
-    (un-name type')
-
-    _
-    type))
-
-(do-template [  ]
-  [(def: #export ( types)
-     (-> (List Type) Type)
-     (case types
-       #.Nil
-       
-
-       (#.Cons type #.Nil)
-       type
-
-       (#.Cons type types')
-       ( type ( types'))))]
-
-  [variant Nothing #.Sum]
-  [tuple   Any     #.Product]
-  )
-
-(def: #export (function inputs output)
-  (-> (List Type) Type Type)
-  (case inputs
-    #.Nil
-    output
-
-    (#.Cons input inputs')
-    (#.Function input (function inputs' output))))
-
-(def: #export (application params quant)
-  (-> (List Type) Type Type)
-  (case params
-    #.Nil
-    quant
-
-    (#.Cons param params')
-    (application params' (#.Apply param quant))))
-
-(do-template [ ]
-  [(def: #export ( size body)
-     (-> Nat Type Type)
-     (case size
-       +0 body
-       _  (|> body ( (dec size)) ( (list)))))]
-
-  [univ-q #.UnivQ]
-  [ex-q   #.ExQ]
-  )
-
-(def: #export (quantified? type)
-  (-> Type Bool)
-  (case type
-    (#.Named [module name] _type)
-    (quantified? _type)
-
-    (#.Apply A F)
-    (maybe.default false
-                   (do maybe.Monad
-                     [applied (apply (list A) F)]
-                     (wrap (quantified? applied))))
-    
-    (^or (#.UnivQ _) (#.ExQ _))
-    true
-
-    _
-    false))
-
-(def: #export (array level elem-type)
-  (-> Nat Type Type)
-  (case level
-    +0 elem-type
-    _ (|> elem-type (array (dec level)) (list) (#.Primitive "#Array"))))
-
-(syntax: #export (:log! {input (p.alt s.symbol
-                                      s.any)})
-  (case input
-    (#.Left valueN)
-    (do @
-      [cursor macro.cursor
-       valueT (macro.find-type valueN)
-       #let [_ (log! ($_ text/compose
-                         ":log!" " @ " (.cursor-description cursor) "\n"
-                         (ident/encode valueN) " : " (..to-text valueT) "\n"))]]
-      (wrap (list (' []))))
-
-    (#.Right valueC)
-    (macro.with-gensyms [g!value]
-      (wrap (list (` (.let [(~ g!value) (~ valueC)]
-                       (..:log! (~ g!value)))))))))
-
-(def: type-parameters
-  (Syntax (List Text))
-  (s.tuple (p.some s.local-symbol)))
-
-(syntax: #export (:cast {type-vars type-parameters}
-                        input
-                        output
-                        {value (p.maybe s.any)})
-  (let [casterC (` (: (All [(~+ (list/map code.local-symbol type-vars))]
-                        (-> (~ input) (~ output)))
-                      (|>> :assume)))]
-    (case value
-      #.None
-      (wrap (list casterC))
-      
-      (#.Some value)
-      (wrap (list (` ((~ casterC) (~ value))))))))
-
-(type: Typed
-  {#type Code
-   #expression Code})
-
-(def: typed
-  (Syntax Typed)
-  (s.record (p.seq s.any s.any)))
-
-(syntax: #export (:share {type-vars type-parameters}
-                         {exemplar typed}
-                         {computation typed})
-  (macro.with-gensyms [g!_]
-    (let [shareC (` (: (All [(~+ (list/map code.local-symbol type-vars))]
-                         (-> (~ (get@ #type exemplar))
-                             (~ (get@ #type computation))))
-                       (.function ((~ g!_) (~ g!_))
-                         (:assume (~ (get@ #expression computation))))))]
-      (wrap (list (` ((~ shareC) (~ (get@ #expression exemplar)))))))))
diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux
deleted file mode 100644
index 84b9f808d..000000000
--- a/stdlib/source/lux/lang/type/check.lux
+++ /dev/null
@@ -1,681 +0,0 @@
-(.module: {#.doc "Type-checking functionality."}
-  lux
-  (lux (control [functor #+ Functor]
-                [apply #+ Apply]
-                [monad #+ do Monad]
-                ["ex" exception #+ exception:])
-       (data [text "text/" Monoid Equivalence]
-             [number "nat/" Codec]
-             [maybe]
-             [product]
-             (collection [list]
-                         [set #+ Set])
-             ["e" error])
-       (lang [type "type/" Equivalence])
-       ))
-
-(exception: #export (unknown-type-var {id Nat})
-  (nat/encode id))
-
-(exception: #export (unbound-type-var {id Nat})
-  (nat/encode id))
-
-(exception: #export (invalid-type-application {funcT Type} {argT Type})
-  (type.to-text (#.Apply argT funcT)))
-
-(exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type})
-  (ex.report ["Var" (nat/encode id)]
-             ["Wanted Type" (type.to-text type)]
-             ["Current Type" (type.to-text bound)]))
-
-(exception: #export (type-check-failed {expected Type} {actual Type})
-  (ex.report ["Expected" (type.to-text expected)]
-             ["Actual" (type.to-text actual)]))
-
-(type: #export Var Nat)
-
-(type: #export Assumption
-  {#subsumption [Type Type]
-   #verdict Bool})
-
-(type: #export (Check a)
-  (-> Type-Context (e.Error [Type-Context a])))
-
-(type: #export Type-Vars
-  (List [Var (Maybe Type)]))
-
-(structure: #export _ (Functor Check)
-  (def: (map f fa)
-    (function (_ context)
-      (case (fa context)
-        (#e.Error error)
-        (#e.Error error)
-
-        (#e.Success [context' output])
-        (#e.Success [context' (f output)])
-        ))))
-
-(structure: #export _ (Apply Check)
-  (def: functor Functor)
-
-  (def: (apply ff fa)
-    (function (_ context)
-      (case (ff context)
-        (#e.Success [context' f])
-        (case (fa context')
-          (#e.Success [context'' a])
-          (#e.Success [context'' (f a)])
-
-          (#e.Error error)
-          (#e.Error error))
-
-        (#e.Error error)
-        (#e.Error error)
-        )))
-  )
-
-(structure: #export _ (Monad Check)
-  (def: functor Functor)
-
-  (def: (wrap x)
-    (function (_ context)
-      (#e.Success [context x])))
-
-  (def: (join ffa)
-    (function (_ context)
-      (case (ffa context)
-        (#e.Success [context' fa])
-        (case (fa context')
-          (#e.Success [context'' a])
-          (#e.Success [context'' a])
-
-          (#e.Error error)
-          (#e.Error error))
-
-        (#e.Error error)
-        (#e.Error error)
-        )))
-  )
-
-(open: "check/" Monad)
-
-(def: (var::get id plist)
-  (-> Var Type-Vars (Maybe (Maybe Type)))
-  (case plist
-    #.Nil
-    #.None
-
-    (#.Cons [var-id var-type]
-            plist')
-    (if (n/= id var-id)
-      (#.Some var-type)
-      (var::get id plist'))
-    ))
-
-(def: (var::new id plist)
-  (-> Var Type-Vars Type-Vars)
-  (#.Cons [id #.None] plist))
-
-(def: (var::put id value plist)
-  (-> Var (Maybe Type) Type-Vars Type-Vars)
-  (case plist
-    #.Nil
-    (list [id value])
-
-    (#.Cons [var-id var-type]
-            plist')
-    (if (n/= id var-id)
-      (#.Cons [var-id value]
-              plist')
-      (#.Cons [var-id var-type]
-              (var::put id value plist')))
-    ))
-
-(def: (var::remove id plist)
-  (-> Var Type-Vars Type-Vars)
-  (case plist
-    #.Nil
-    #.Nil
-
-    (#.Cons [var-id var-type]
-            plist')
-    (if (n/= id var-id)
-      plist'
-      (#.Cons [var-id var-type]
-              (var::remove id plist')))
-    ))
-
-## [[Logic]]
-(def: #export (run context proc)
-  (All [a] (-> Type-Context (Check a) (e.Error a)))
-  (case (proc context)
-    (#e.Error error)
-    (#e.Error error)
-
-    (#e.Success [context' output])
-    (#e.Success output)))
-
-(def: #export (throw exception message)
-  (All [e a] (-> (ex.Exception e) e (Check a)))
-  (function (_ context)
-    (ex.throw exception message)))
-
-(def: #export existential
-  {#.doc "A producer of existential types."}
-  (Check [Nat Type])
-  (function (_ context)
-    (let [id (get@ #.ex-counter context)]
-      (#e.Success [(update@ #.ex-counter inc context)
-                   [id (#.Ex id)]]))))
-
-(do-template [   ]
-  [(def: #export ( id)
-     (-> Var (Check ))
-     (function (_ context)
-       (case (|> context (get@ #.var-bindings) (var::get id))
-         (^or (#.Some (#.Some (#.Var _)))
-              (#.Some #.None))
-         (#e.Success [context ])
-         
-         (#.Some (#.Some bound))
-         (#e.Success [context ])
-
-         #.None
-         (ex.throw unknown-type-var id))))]
-
-  [bound? Bool false true]
-  [read (Maybe Type) #.None (#.Some bound)]
-  )
-
-(def: (peek id)
-  (-> Var (Check Type))
-  (function (_ context)
-    (case (|> context (get@ #.var-bindings) (var::get id))
-      (#.Some (#.Some bound))
-      (#e.Success [context bound])
-
-      (#.Some #.None)
-      (ex.throw unbound-type-var id)
-
-      #.None
-      (ex.throw unknown-type-var id))))
-
-(def: #export (write type id)
-  (-> Type Var (Check Any))
-  (function (_ context)
-    (case (|> context (get@ #.var-bindings) (var::get id))
-      (#.Some (#.Some bound))
-      (ex.throw cannot-rebind-var [id type bound])
-      
-      (#.Some #.None)
-      (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
-                   []])
-
-      #.None
-      (ex.throw unknown-type-var id))))
-
-(def: (update type id)
-  (-> Type Var (Check Any))
-  (function (_ context)
-    (case (|> context (get@ #.var-bindings) (var::get id))
-      (#.Some _)
-      (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
-                   []])
-      
-      #.None
-      (ex.throw unknown-type-var id))))
-
-(def: #export var
-  (Check [Var Type])
-  (function (_ context)
-    (let [id (get@ #.var-counter context)]
-      (#e.Success [(|> context
-                       (update@ #.var-counter inc)
-                       (update@ #.var-bindings (var::new id)))
-                   [id (#.Var id)]]))))
-
-(def: get-bindings
-  (Check (List [Var (Maybe Type)]))
-  (function (_ context)
-    (#e.Success [context
-                 (get@ #.var-bindings context)])))
-
-(def: (set-bindings value)
-  (-> (List [Var (Maybe Type)]) (Check Any))
-  (function (_ context)
-    (#e.Success [(set@ #.var-bindings value context)
-                 []])))
-
-(def: (apply-type! funcT argT)
-  (-> Type Type (Check Type))
-  (case funcT
-    (#.Var func-id)
-    (do Monad
-      [?funcT' (read func-id)]
-      (case ?funcT'
-        #.None
-        (throw invalid-type-application [funcT argT])
-
-        (#.Some funcT')
-        (apply-type! funcT' argT)))
-
-    _
-    (function (_ context)
-      (case (type.apply (list argT) funcT)
-        #.None
-        (ex.throw invalid-type-application [funcT argT])
-
-        (#.Some output)
-        (#e.Success [context output])))))
-
-(type: #export Ring (Set Var))
-
-(def: empty-ring Ring (set.new number.Hash))
-
-(def: #export (ring id)
-  (-> Var (Check Ring))
-  (function (_ context)
-    (loop [current id
-           output (set.add id empty-ring)]
-      (case (|> context (get@ #.var-bindings) (var::get current))
-        (#.Some (#.Some type))
-        (case type
-          (#.Var post)
-          (if (n/= id post)
-            (#e.Success [context output])
-            (recur post (set.add post output)))
-          
-          _
-          (#e.Success [context empty-ring]))
-
-        (#.Some #.None)
-        (#e.Success [context output])
-        
-        #.None
-        (ex.throw unknown-type-var current)))))
-
-(def: #export fresh-context
-  Type-Context
-  {#.var-counter +0
-   #.ex-counter +0
-   #.var-bindings (list)
-   })
-
-(def: (attempt op)
-  (All [a] (-> (Check a) (Check (Maybe a))))
-  (function (_ context)
-    (case (op context)
-      (#e.Success [context' output])
-      (#e.Success [context' (#.Some output)])
-
-      (#e.Error _)
-      (#e.Success [context #.None]))))
-
-(def: #export (fail message)
-  (All [a] (-> Text (Check a)))
-  (function (_ context)
-    (#e.Error message)))
-
-(def: #export (assert message test)
-  (-> Text Bool (Check Any))
-  (function (_ context)
-    (if test
-      (#e.Success [context []])
-      (#e.Error message))))
-
-(def: (either left right)
-  (All [a] (-> (Check a) (Check a) (Check a)))
-  (function (_ context)
-    (case (left context)
-      (#e.Success [context' output])
-      (#e.Success [context' output])
-
-      (#e.Error _)
-      (right context))))
-
-(def: (assumed? [e a] assumptions)
-  (-> [Type Type] (List Assumption) (Maybe Bool))
-  (:: maybe.Monad map product.right
-      (list.find (function (_ [[fe fa] status])
-                   (and (type/= e fe)
-                        (type/= a fa)))
-                 assumptions)))
-
-(def: (assume! ea status assumptions)
-  (-> [Type Type] Bool (List Assumption) (List Assumption))
-  (#.Cons [ea status] assumptions))
-
-(def: (on id type then else)
-  (All [a]
-    (-> Var Type (Check a) (-> Type (Check a))
-        (Check a)))
-  ($_ either
-      (do Monad
-        [_ (write type id)]
-        then)
-      (do Monad
-        [ring (ring id)
-         _ (assert "" (n/> +1 (set.size ring)))
-         _ (monad.map @ (update type) (set.to-list ring))]
-        then)
-      (do Monad
-        [?bound (read id)]
-        (else (maybe.default (#.Var id) ?bound)))))
-
-(def: (link-2 left right)
-  (-> Var Var (Check Any))
-  (do Monad
-    [_ (write (#.Var right) left)]
-    (write (#.Var left) right)))
-
-(def: (link-3 interpose to from)
-  (-> Var Var Var (Check Any))
-  (do Monad
-    [_ (update (#.Var interpose) from)]
-    (update (#.Var to) interpose)))
-
-(def: (check-vars check' assumptions idE idA)
-  (-> (-> Type Type (List Assumption) (Check (List Assumption)))
-      (List Assumption)
-      Var Var
-      (Check (List Assumption)))
-  (if (n/= idE idA)
-    (check/wrap assumptions)
-    (do Monad
-      [ebound (attempt (peek idE))
-       abound (attempt (peek idA))]
-      (case [ebound abound]
-        ## Link the 2 variables circularily
-        [#.None #.None]
-        (do @
-          [_ (link-2 idE idA)]
-          (wrap assumptions))
-
-        ## Interpose new variable between 2 existing links
-        [(#.Some etype) #.None]
-        (case etype
-          (#.Var targetE)
-          (do @
-            [_ (link-3 idA targetE idE)]
-            (wrap assumptions))
-
-          _
-          (check' etype (#.Var idA) assumptions))
-
-        ## Interpose new variable between 2 existing links
-        [#.None (#.Some atype)]
-        (case atype
-          (#.Var targetA)
-          (do @
-            [_ (link-3 idE targetA idA)]
-            (wrap assumptions))
-
-          _
-          (check' (#.Var idE) atype assumptions))
-
-        [(#.Some etype) (#.Some atype)]
-        (case [etype atype]
-          [(#.Var targetE) (#.Var targetA)]
-          (do @
-            [ringE (ring idE)
-             ringA (ring idA)]
-            (if (:: set.Equivalence = ringE ringA)
-              (wrap assumptions)
-              ## Fuse 2 rings
-              (do @
-                [_ (monad.fold @ (function (_ interpose to)
-                                   (do @
-                                     [_ (link-3 interpose to idE)]
-                                     (wrap interpose)))
-                               targetE
-                               (set.to-list ringA))]
-                (wrap assumptions))))
-          
-          [(#.Var targetE) _]
-          (do @
-            [ring (ring idE)
-             _ (monad.map @ (update atype) (set.to-list ring))]
-            (wrap assumptions))
-          
-          [_ (#.Var targetA)]
-          (do @
-            [ring (ring idA)
-             _ (monad.map @ (update etype) (set.to-list ring))]
-            (wrap assumptions))
-          
-          _
-          (check' etype atype assumptions))))))
-
-(def: (with-error-stack on-error check)
-  (All [a] (-> (-> Any Text) (Check a) (Check a)))
-  (function (_ context)
-    (case (check context)
-      (#e.Error error)
-      (#e.Error (case error
-                  ""
-                  (on-error [])
-
-                  _
-                  ($_ text/compose
-                      (on-error [])
-                      "\n\n-----------------------------------------\n\n"
-                      error)))
-
-      output
-      output)))
-
-(def: (check-apply check' assumptions [eAT eFT] [aAT aFT])
-  (-> (-> Type Type (List Assumption) (Check (List Assumption))) (List Assumption)
-      [Type Type] [Type Type]
-      (Check (List Assumption)))
-  (case [eFT aFT]
-    (^or [(#.UnivQ _ _) (#.Ex _)] [(#.UnivQ _ _) (#.Var _)])
-    (do Monad
-      [eFT' (apply-type! eFT eAT)]
-      (check' eFT' (#.Apply aAT aFT) assumptions))
-
-    (^or [(#.Ex _) (#.UnivQ _ _)] [(#.Var _) (#.UnivQ _ _)])
-    (do Monad
-      [aFT' (apply-type! aFT aAT)]
-      (check' (#.Apply eAT eFT) aFT' assumptions))
-
-    (^or [(#.Ex _) _] [_ (#.Ex _)])
-    (do Monad
-      [assumptions (check' eFT aFT assumptions)]
-      (check' eAT aAT assumptions))
-
-    [(#.Var id) _]
-    (do Monad
-      [?rFT (read id)]
-      (case ?rFT
-        (#.Some rFT)
-        (check' (#.Apply eAT rFT) (#.Apply aAT aFT) assumptions)
-
-        _
-        (do Monad
-          [assumptions (check' eFT aFT assumptions)
-           e' (apply-type! aFT eAT)
-           a' (apply-type! aFT aAT)]
-          (check' e' a' assumptions))))
-
-    [_ (#.Var id)]
-    (do Monad
-      [?rFT (read id)]
-      (case ?rFT
-        (#.Some rFT)
-        (check' (#.Apply eAT eFT) (#.Apply aAT rFT) assumptions)
-
-        _
-        (do Monad
-          [assumptions (check' eFT aFT assumptions)
-           e' (apply-type! eFT eAT)
-           a' (apply-type! eFT aAT)]
-          (check' e' a' assumptions))))
-
-    _
-    (fail "")))
-
-(def: #export (check' expected actual assumptions)
-  {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
-  (-> Type Type (List Assumption) (Check (List Assumption)))
-  (if (is? expected actual)
-    (check/wrap assumptions)
-    (with-error-stack
-      (function (_ _) (ex.construct type-check-failed [expected actual]))
-      (case [expected actual]
-        [(#.Var idE) (#.Var idA)]
-        (check-vars check' assumptions idE idA)
-        
-        [(#.Var id) _]
-        (on id actual
-            (check/wrap assumptions)
-            (function (_ bound)
-              (check' bound actual assumptions)))
-        
-        [_ (#.Var id)]
-        (on id expected
-            (check/wrap assumptions)
-            (function (_ bound)
-              (check' expected bound assumptions)))
-
-        (^template [ ]
-          [(#.Apply A1 ) (#.Apply A2 )]
-          (check-apply check' assumptions [A1 ] [A2 ]))
-        ([F1 (#.Ex ex)]
-         [(#.Ex ex) F2]
-         [F1 (#.Var id)]
-         [(#.Var id) F2])
-        
-        [(#.Apply A F) _]
-        (let [fx-pair [expected actual]]
-          (case (assumed? fx-pair assumptions)
-            (#.Some ?)
-            (if ?
-              (check/wrap assumptions)
-              (fail ""))
-
-            #.None
-            (do Monad
-              [expected' (apply-type! F A)]
-              (check' expected' actual (assume! fx-pair true assumptions)))))
-
-        [_ (#.Apply A F)]
-        (do Monad
-          [actual' (apply-type! F A)]
-          (check' expected actual' assumptions))
-
-        (^template [ ]
-          [( _) _]
-          (do Monad
-            [[_ paramT] 
-             expected' (apply-type! expected paramT)]
-            (check' expected' actual assumptions)))
-        ([#.UnivQ ..existential]
-         [#.ExQ ..var])
-
-        (^template [ ]
-          [_ ( _)]
-          (do Monad
-            [[_ paramT] 
-             actual' (apply-type! actual paramT)]
-            (check' expected actual' assumptions)))
-        ([#.UnivQ ..var]
-         [#.ExQ ..existential])
-
-        [(#.Primitive e-name e-params) (#.Primitive a-name a-params)]
-        (if (and (text/= e-name a-name)
-                 (n/= (list.size e-params)
-                      (list.size a-params)))
-          (do Monad
-            [assumptions (monad.fold Monad
-                                     (function (_ [e a] assumptions) (check' e a assumptions))
-                                     assumptions
-                                     (list.zip2 e-params a-params))]
-            (check/wrap assumptions))
-          (fail ""))
-
-        (^template []
-          [( eL eR) ( aL aR)]
-          (do Monad
-            [assumptions (check' eL aL assumptions)]
-            (check' eR aR assumptions)))
-        ([#.Sum]
-         [#.Product])
-        
-        [(#.Function eI eO) (#.Function aI aO)]
-        (do Monad
-          [assumptions (check' aI eI assumptions)]
-          (check' eO aO assumptions))
-
-        [(#.Ex e!id) (#.Ex a!id)]
-        (if (n/= e!id a!id)
-          (check/wrap assumptions)
-          (fail ""))
-
-        [(#.Named _ ?etype) _]
-        (check' ?etype actual assumptions)
-
-        [_ (#.Named _ ?atype)]
-        (check' expected ?atype assumptions)
-
-        _
-        (fail "")))))
-
-(def: #export (check expected actual)
-  {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
-  (-> Type Type (Check Any))
-  (do Monad
-    [assumptions (check' expected actual (list))]
-    (wrap [])))
-
-(def: #export (checks? expected actual)
-  {#.doc "A simple type-checking function that just returns a yes/no answer."}
-  (-> Type Type Bool)
-  (case (run fresh-context (check expected actual))
-    (#e.Error error)
-    false
-
-    (#e.Success _)
-    true))
-
-(def: #export get-context
-  (Check Type-Context)
-  (function (_ context)
-    (#e.Success [context context])))
-
-(def: #export (clean inputT)
-  (-> Type (Check Type))
-  (case inputT
-    (#.Primitive name paramsT+)
-    (do Monad
-      [paramsT+' (monad.map @ clean paramsT+)]
-      (wrap (#.Primitive name paramsT+')))
-
-    (^or (#.Parameter _) (#.Ex _) (#.Named _))
-    (:: Monad wrap inputT)
-
-    (^template []
-      ( leftT rightT)
-      (do Monad
-        [leftT' (clean leftT)
-         rightT' (clean rightT)]
-        (wrap ( leftT' rightT'))))
-    ([#.Sum] [#.Product] [#.Function] [#.Apply])
-
-    (#.Var id)
-    (do Monad
-      [?actualT (read id)]
-      (case ?actualT
-        (#.Some actualT)
-        (clean actualT)
-
-        _
-        (wrap inputT)))
-
-    (^template []
-      ( envT+ unquantifiedT)
-      (do Monad
-        [envT+' (monad.map @ clean envT+)]
-        (wrap ( envT+' unquantifiedT))))
-    ([#.UnivQ] [#.ExQ])
-    ))
diff --git a/stdlib/source/lux/language.lux b/stdlib/source/lux/language.lux
new file mode 100644
index 000000000..bc6e2c9ec
--- /dev/null
+++ b/stdlib/source/lux/language.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/language/compiler.lux b/stdlib/source/lux/language/compiler.lux
new file mode 100644
index 000000000..2e88938de
--- /dev/null
+++ b/stdlib/source/lux/language/compiler.lux
@@ -0,0 +1,79 @@
+(.module:
+  lux
+  (lux (control [state]
+                ["ex" exception #+ Exception exception:]
+                [monad #+ do])
+       (data [product]
+             [error #+ Error]
+             [text]
+             text/format)
+       [function]
+       (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 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 (localized transform)
+  (All [s o]
+    (-> (-> s s)
+        (-> (Operation s o) (Operation s o))))
+  (function (_ operation)
+    (function (_ state)
+      (case (operation (transform state))
+        (#error.Error error)
+        (#error.Error error)
+
+        (#error.Success [state' output])
+        (#error.Success [state output])))))
+
+(def: #export (with-state state)
+  (All [s o] (-> s (-> (Operation s o) (Operation s o))))
+  (localized (function.constant state)))
+
+(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
new file mode 100644
index 000000000..87a4cbe4f
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis.lux
@@ -0,0 +1,281 @@
+(.module:
+  [lux #- nat int rev]
+  (lux (data [product]
+             [error]
+             [text "text/" Equivalence]
+             (collection [list "list/" Fold]))
+       [function])
+  [///reference #+ Register Variable Reference]
+  [//])
+
+(type: #export #rec Primitive
+  #Unit
+  (#Bool Bool)
+  (#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))
+
+(type: #export Operation
+  (//.Operation .Lux))
+
+(type: #export Compiler
+  (//.Compiler .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))]
+
+  [bool Bool #Bool]
+  [nat  Nat  #Nat]
+  [int  Int  #Int]
+  [rev  Rev  #Rev]
+  [frac Frac #Frac]
+  [text Text #Text]
+  )
+
+(type: #export (Variant a)
+  {#lefts Nat
+   #right? Bool
+   #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 Bool)
+  (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? false
+                    #value valueA}))
+         
+         ( (#Sum (#.Right valueA)))
+         (#.Some {#lefts lefts
+                  #right? true
+                  #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/bool #..Bool]
+  [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 (_ compiler)
+    (let [old-source (get@ #.source compiler)]
+      (case (action (set@ #.source source compiler))
+        (#error.Error error)
+        (#error.Error error)
+
+        (#error.Success [compiler' output])
+        (#error.Success [(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 (_ compiler)
+    (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler))
+      (#error.Success [compiler' output])
+      (case (get@ #.scopes compiler')
+        #.Nil
+        (#error.Error "Impossible error: Drained scopes!")
+
+        (#.Cons head tail)
+        (#error.Success [(set@ #.scopes tail compiler')
+                         [head output]]))
+
+      (#error.Error error)
+      (#error.Error error))))
+
+(def: #export (with-current-module name action)
+  (All [a] (-> Text (Operation a) (Operation a)))
+  (function (_ compiler)
+    (case (action (set@ #.current-module (#.Some name) compiler))
+      (#error.Success [compiler' output])
+      (#error.Success [(set@ #.current-module
+                             (get@ #.current-module compiler)
+                             compiler')
+                       output])
+
+      (#error.Error error)
+      (#error.Error error))))
+
+(def: #export (with-cursor cursor action)
+  (All [a] (-> Cursor (Operation a) (Operation a)))
+  (if (text/= "" (product.left cursor))
+    action
+    (function (_ compiler)
+      (let [old-cursor (get@ #.cursor compiler)]
+        (case (action (set@ #.cursor cursor compiler))
+          (#error.Success [compiler' output])
+          (#error.Success [(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
new file mode 100644
index 000000000..fc1e83d4a
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/case.lux
@@ -0,0 +1,290 @@
+(.module:
+  [lux #- case]
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [product]
+             [error]
+             [maybe]
+             text/format
+             (collection [list "list/" Fold Monoid Functor]))
+       [macro]
+       (macro [code]))
+  (//// [type]
+        (type ["tc" check])
+        [scope])
+  [///]
+  [// #+ Pattern Analysis Operation Compiler]
+  [//type]
+  [//structure]
+  [/coverage])
+
+(exception: #export (cannot-match-type-with-pattern {type Type} {pattern Code})
+  (ex.report ["Type" (%type type)]
+             ["Pattern" (%code pattern)]))
+
+(exception: #export (sum-type-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-type-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-type caseT)
+  (-> Type (Operation Type))
+  (loop [envs (: (List (List Type))
+                 (list))
+         caseT caseT]
+    (.case caseT
+      (#.Var id)
+      (do ///.Monad
+        [?caseT' (//type.with-env
+                   (tc.read id))]
+        (.case ?caseT'
+          (#.Some caseT')
+          (recur envs caseT')
+
+          _
+          (///.throw cannot-simplify-type-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
+                       tc.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 tc.Monad
+                      [?funct' (tc.read funcT-id)]
+                      (.case ?funct'
+                        (#.Some funct')
+                        (wrap funct')
+
+                        _
+                        (tc.throw cannot-simplify-type-for-pattern-matching caseT))))]
+          (recur envs (#.Apply inputT funcT')))
+
+        _
+        (.case (type.apply (list inputT) funcT)
+          (#.Some outputT)
+          (recur envs outputT)
+
+          #.None
+          (///.throw cannot-simplify-type-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
+           (tc.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))
+    ([Bool (#.Bool pattern-value) (#//.Bool 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-type inputT)]
+        (.case inputT'
+          (#.Product _)
+          (let [sub-types (type.flatten-tuple inputT')
+                num-sub-types (maybe.default (list.size sub-types)
+                                             num-tags)
+                num-sub-patterns (list.size sub-patterns)
+                matches (cond (n/< num-sub-types num-sub-patterns)
+                              (let [[prefix suffix] (list.split (dec num-sub-patterns) sub-types)]
+                                (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
+
+                              (n/> num-sub-types num-sub-patterns)
+                              (let [[prefix suffix] (list.split (dec num-sub-types) sub-patterns)]
+                                (list.zip2 sub-types (list/compose prefix (list (code.tuple suffix)))))
+                              
+                              ## (n/= num-sub-types num-sub-patterns)
+                              (list.zip2 sub-types 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-type-with-pattern [inputT pattern])
+          )))
+
+    [cursor (#.Record record)]
+    (do ///.Monad
+      [record (//structure.normalize record)
+       [members recordT] (//structure.order record)
+       _ (//type.with-env
+           (tc.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-type 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 case-type)
+                      (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 case-type (` [(~+ values)]) next))]
+                (wrap [(//.sum-pattern num-cases idx testP)
+                       nextA]))
+
+              _
+              (///.throw sum-type-has-no-case [idx inputT])))
+
+          _
+          (///.throw cannot-match-type-with-pattern [inputT pattern]))))
+
+    (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
+    (//.with-cursor cursor
+      (do ///.Monad
+        [tag (macro.normalize tag)
+         [idx group variantT] (macro.resolve-tag tag)
+         _ (//type.with-env
+             (tc.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
new file mode 100644
index 000000000..70c9fa80f
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/case/coverage.lux
@@ -0,0 +1,321 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                equivalence)
+       (data [bool "bool/" 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? false
+         #///.value valueP})
+      
+      (#.Right valueP)
+      {#///.lefts lefts
+       #///.right? true
+       #///.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 booleans
+## and variants.
+(type: #export #rec Coverage
+  #Partial
+  (#Bool Bool)
+  (#Variant (Maybe Nat) (Dictionary Nat Coverage))
+  (#Seq Coverage Coverage)
+  (#Alt Coverage Coverage)
+  #Exhaustive)
+
+(def: #export (exhaustive? coverage)
+  (-> Coverage Bool)
+  (case coverage
+    (#Exhaustive _)
+    true
+
+    _
+    false))
+
+(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])
+
+    ## Bools are the exception, since there is only "true" and
+    ## "false", which means it is possible for boolean
+    ## pattern-matching to become exhaustive if complementary parts meet.
+    (#///.Simple (#///.Bool value))
+    (operation/wrap (#Bool 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)
+  (-> Bool Bool Bool)
+  (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]
+      true
+
+      [(#Bool sideR) (#Bool sideS)]
+      (bool/= 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))))
+
+      _
+      false)))
+
+(open: "C/" 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 boolean coverages are exhaustive if they compliment one another.
+    (^multi [(#Bool sideA) (#Bool 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 [(C/= leftSF leftA) (C/= rightSF rightA)]
+      ## There is nothing the addition adds to the coverage.
+      [true true]
+      redundant-pattern
+
+      ## The 2 sequences cannot possibly be merged.
+      [false false]
+      (error/wrap (#Alt so-far addition))
+
+      ## Same prefix
+      [true false]
+      (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
+      [false true]
+      (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]
+            (C/= left single))
+    redundant-pattern
+
+    ## The right part is not necessary, since it can always match the left.
+    (^multi [single (#Seq left right)]
+            (C/= 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 (C/= 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
new file mode 100644
index 000000000..2ef2cae5b
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/expression.lux
@@ -0,0 +1,121 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [product]
+             text/format)
+       [macro])
+  [//// #+ Eval]
+  ## (//// [".L" macro]
+  ##       [".L" extension])
+  [///]
+  [// #+ Analysis Operation Compiler]
+  [//type]
+  [//primitive]
+  [//structure]
+  [//reference])
+
+(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 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))
+            ([#.Bool //primitive.bool]
+             [#.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)))
+            (undefined)
+            ## (do ///.Monad
+            ##   [extension (extensionL.find-analysis extension-name)]
+            ##   (extension compile eval 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
+            ##                 (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
new file mode 100644
index 000000000..fc925b68b
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/function.lux
@@ -0,0 +1,99 @@
+(.module:
+  [lux #- function]
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (data [maybe]
+             [text]
+             text/format
+             (collection [list "list/" Fold Monoid Monad]))
+       [macro]
+       (macro [code])
+       (language [type]
+                 (type ["tc" check])
+                 [".L" scope]))
+  [///]
+  [// #+ Analysis Compiler]
+  [//type]
+  [//inference])
+
+(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 (Meta Analysis))
+  (do macro.Monad
+    [functionT 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 tc.existential]
+           [#.ExQ tc.var])
+          
+          (#.Var id)
+          (do @
+            [?expectedT' (//type.with-env
+                           (tc.read id))]
+            (case ?expectedT'
+              (#.Some expectedT')
+              (recur expectedT')
+
+              ## Inference
+              _
+              (do @
+                [[input-id inputT] (//type.with-env tc.var)
+                 [output-id outputT] (//type.with-env tc.var)
+                 #let [functionT (#.Function inputT outputT)]
+                 functionA (recur functionT)
+                 _ (//type.with-env
+                     (tc.check expectedT functionT))]
+                (wrap functionA))
+              ))
+
+          (#.Function inputT outputT)
+          (<| (:: @ map (.function (_ [scope bodyA])
+                          (#//.Function (scopeL.environment scope) bodyA)))
+              //.with-scope
+              ## Functions have access not only to their argument, but
+              ## also to themselves, through a local variable.
+              (scopeL.with-local [function-name expectedT])
+              (scopeL.with-local [arg-name inputT])
+              (//type.with-type outputT)
+              (analyse body))
+          
+          _
+          (///.fail "")
+          )))))
+
+(def: #export (apply analyse functionT functionA args)
+  (-> Compiler Type Analysis (List Code) (Meta Analysis))
+  (<| (///.with-stack cannot-apply [functionT args])
+      (do macro.Monad
+        [[applyT argsA] (//inference.general analyse functionT args)])
+      (wrap (//.apply [functionA argsA]))))
diff --git a/stdlib/source/lux/language/compiler/analysis/inference.lux b/stdlib/source/lux/language/compiler/analysis/inference.lux
new file mode 100644
index 000000000..a89ed40f8
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/inference.lux
@@ -0,0 +1,254 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [maybe]
+             [text]
+             text/format
+             (collection [list "list/" Functor]))
+       [macro])
+  (//// [type]
+        (type ["tc" check]))
+  [/// #+ "operation/" Monad]
+  [// #+ 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: new-named-type
+  (Operation Type)
+  (do ///.Monad
+    [[module line column] macro.cursor
+     [ex-id _] (//type.with-env tc.existential)]
+    (wrap (#.Primitive (format "{New Type @ " (%t module)
+                               "," (%n line)
+                               "," (%n column)
+                               "} " (%n ex-id))
+                       (list)))))
+
+## 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 tc.var)]
+        (general analyse (maybe.assume (type.apply (list varT) inferT)) args))
+
+      (#.ExQ _)
+      (do ///.Monad
+        [[var-id varT] (//type.with-env tc.var)
+         output (general analyse
+                         (maybe.assume (type.apply (list varT) inferT))
+                         args)
+         bound? (//type.with-env
+                  (tc.bound? var-id))
+         _ (if bound?
+             (wrap [])
+             (do @
+               [newT new-named-type]
+               (//type.with-env
+                 (tc.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 (tc.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/primitive.lux b/stdlib/source/lux/language/compiler/analysis/primitive.lux
new file mode 100644
index 000000000..5f6604926
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/primitive.lux
@@ -0,0 +1,28 @@
+(.module:
+  [lux #- nat int rev]
+  (lux (control monad)
+       [macro])
+  [// #+ Analysis]
+  (// [".A" type]))
+
+## [Analysers]
+(do-template [  ]
+  [(def: #export ( value)
+     (->  (Meta Analysis))
+     (do macro.Monad
+       [_ (typeA.infer )]
+       (wrap (#//.Primitive ( value)))))]
+
+  [bool Bool #//.Bool]
+  [nat  Nat  #//.Nat]
+  [int  Int  #//.Int]
+  [rev  Rev  #//.Rev]
+  [frac Frac #//.Frac]
+  [text Text #//.Text]
+  )
+
+(def: #export unit
+  (Meta Analysis)
+  (do macro.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
new file mode 100644
index 000000000..bfc4e9faa
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/reference.lux
@@ -0,0 +1,77 @@
+(.module:
+  lux
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       [macro]
+       (macro [code])
+       (language (type ["tc" check]))
+       (data [text "text/" Equivalence]
+             text/format))
+  [///]
+  [// #+ Analysis Operation]
+  [//type]
+  [////reference]
+  [////scope])
+
+(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 _] (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]) (macro.normalize def-name)
+           current macro.current-module-name]
+          (if (text/= current ::module)
+            
+            (if (macro.export? def-anns)
+              (do @
+                [imported! (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 macro.current-module-name]
+          (definition [this-module simple-name]))))
+
+    _
+    (definition reference)))
diff --git a/stdlib/source/lux/language/compiler/analysis/structure.lux b/stdlib/source/lux/language/compiler/analysis/structure.lux
new file mode 100644
index 000000000..087ffa8c5
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/structure.lux
@@ -0,0 +1,354 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [ident]
+             [number]
+             [product]
+             [maybe]
+             (collection [list "list/" Functor]
+                         ["dict" dictionary #+ Dictionary])
+             text/format)
+       [macro]
+       (macro [code]))
+  (//// [type]
+        (type ["tc" check]))
+  [///]
+  [// #+ Tag Analysis Operation Compiler]
+  [//type]
+  [//primitive]
+  [//inference])
+
+(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 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
+                         (tc.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 tc.existential]
+         [#.ExQ tc.var])
+
+        (#.Apply inputT funT)
+        (case funT
+          (#.Var funT-id)
+          (do @
+            [?funT' (//type.with-env (tc.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 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 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
+                         (tc.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
+                   (tc.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 tc.existential]
+         [#.ExQ tc.var])
+
+        (#.Apply inputT funT)
+        (case funT
+          (#.Var funT-id)
+          (do @
+            [?funT' (//type.with-env (tc.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 (macro.normalize tag)
+     [idx group variantT] (macro.resolve-tag tag)
+     expectedT 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 (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 (macro.normalize head-k)
+       [_ tag-set recordT] (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 (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 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
new file mode 100644
index 000000000..bc2ccccfe
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/analysis/type.lux
@@ -0,0 +1,61 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [error])
+       [macro]
+       (language (type ["tc" check])))
+  [///]
+  [// #+ Operation])
+
+(def: #export (with-type expected action)
+  (All [a] (-> Type (Operation a) (Operation a)))
+  (function (_ compiler)
+    (case (action (set@ #.expected (#.Some expected) compiler))
+      (#error.Success [compiler' output])
+      (let [old-expected (get@ #.expected compiler)]
+        (#error.Success [(set@ #.expected old-expected compiler')
+                         output]))
+
+      (#error.Error error)
+      (#error.Error error))))
+
+(def: #export (with-env action)
+  (All [a] (-> (tc.Check a) (Operation a)))
+  (function (_ compiler)
+    (case (action (get@ #.type-context compiler))
+      (#error.Error error)
+      ((///.fail error) compiler)
+
+      (#error.Success [context' output])
+      (#error.Success [(set@ #.type-context context' compiler)
+                       output]))))
+
+(def: #export (with-fresh-env action)
+  (All [a] (-> (Operation a) (Operation a)))
+  (function (_ compiler)
+    (let [old (get@ #.type-context compiler)]
+      (case (action (set@ #.type-context tc.fresh-context compiler))
+        (#error.Success [compiler' output])
+        (#error.Success [(set@ #.type-context old compiler')
+                         output])
+
+        output
+        output))))
+
+(def: #export (infer actualT)
+  (-> Type (Operation Any))
+  (do ///.Monad
+    [expectedT 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
new file mode 100644
index 000000000..a878e1615
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/default/cache.lux
@@ -0,0 +1,33 @@
+(.module:
+  lux
+  (lux (data (format [binary #+ Binary]))))
+
+(def: definition
+  (Binary Definition)
+  ($_ binary.seq binary.type binary.code binary.any))
+
+(def: alias
+  (Binary [Text Text])
+  (binary.seq binary.text binary.text))
+
+## TODO: Remove #module-hash, #imports & #module-state ASAP.
+## TODO: Not just from this parser, but from the lux.Module type.
+(def: #export module
+  (Binary Module)
+  ($_ binary.seq
+      ## #module-hash
+      (binary.ignore +0)
+      ## #module-aliases
+      (binary.list ..alias)
+      ## #definitions
+      (binary.list (binary.seq binary.text ..definition))
+      ## #imports
+      (binary.list binary.text)
+      ## #tags
+      (binary.ignore (list))
+      ## #types
+      (binary.ignore (list))
+      ## #module-annotations
+      (binary.maybe binary.code)
+      ## #module-state
+      (binary.ignore #.Cached)))
diff --git a/stdlib/source/lux/language/compiler/default/repl/type.lux b/stdlib/source/lux/language/compiler/default/repl/type.lux
new file mode 100644
index 000000000..bb210bf7f
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/default/repl/type.lux
@@ -0,0 +1,197 @@
+(.module:
+  lux
+  (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]
+       [macro]
+       (macro [code]
+              [poly #+ Poly])
+       (language [type])))
+
+(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.this Any)]
+            (wrap (function.constant "[]")))
+          
+          (~~ (do-template [ ]
+                [(do p.Monad
+                   [_ (poly.like )]
+                   (wrap (|>> (:coerce ) )))]
+
+                [Bool %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.like )]
+                   (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.this List) poly.any))
+             elemR (poly.local (list elemT) representation)]
+            (wrap (|>> (:coerce (List Any)) (%list elemR))))
+
+          (do p.Monad
+            [[_ elemT] (poly.apply (p.seq (poly.this 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
new file mode 100644
index 000000000..e23e9b511
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension.lux
@@ -0,0 +1,64 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [error #+ Error]
+             [text]
+             (collection ["dict" dictionary #+ Dictionary])))
+  [// #+ Operation Compiler])
+
+(type: #export (Extension i)
+  (#Base i)
+  (#Extension [Text (List (Extension i))]))
+
+(with-expansions [ (as-is (Dictionary Text (-> Text (Handler s i o))))]
+  (type: #export (Handler s i o)
+    (-> (Compiler [s ] (Extension i) (Extension o))
+        (Compiler [s ] (List (Extension i)) (Extension o))))
+
+  (type: #export (Bundle s i o)
+    ))
+
+(do-template []
+  [(exception: #export ( {name Text})
+     (ex.report ["Name" name]))]
+
+  [unknown-extension]
+  [cannot-overwrite-existing-extension]
+  )
+
+(def: #export (extend compiler)
+  (All [s i o]
+    (-> (Compiler s i o)
+        (Compiler [s (Bundle s i o)]
+                  (Extension i)
+                  (Extension o))))
+  (function (compiler' input (^@ stateE [stateB bundle]))
+    (case input
+      (#Base input')
+      (do error.Monad
+        [[stateB' output] (compiler input' stateB)]
+        (wrap [[stateB' bundle] (#Base output)]))
+      
+      (#Extension name parameters)
+      (case (dict.get name bundle)
+        (#.Some handler)
+        (do error.Monad
+          [[stateE' output] (handler name compiler' parameters stateE)]
+          (wrap [stateE' output]))
+        
+        #.None
+        (ex.throw unknown-extension name)))))
+
+(def: #export (install name handler)
+  (All [s i o]
+    (-> Text (-> Text (Handler s i o))
+        (Operation [s (Bundle s i o)] Any)))
+  (function (_ (^@ stateE [_ bundle]))
+    (if (dict.contains? name bundle)
+      (ex.throw cannot-overwrite-existing-extension name)
+      (ex.return [stateE (dict.put name handler bundle)]))))
+
+(def: #export fresh
+  Bundle
+  (dict.new text.Hash))
diff --git a/stdlib/source/lux/language/compiler/extension/analysis.lux b/stdlib/source/lux/language/compiler/extension/analysis.lux
new file mode 100644
index 000000000..9f48c79b4
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/analysis.lux
@@ -0,0 +1,18 @@
+(.module:
+  lux
+  (lux (data [text]
+             (collection [list "list/" Functor]
+                         ["dict" dictionary #+ Dictionary])))
+  [///analysis #+ Analysis State]
+  [///synthesis #+ Synthesis]
+  [//]
+  [/common]
+  [/host])
+
+(def: #export defaults
+  (//.Bundle State Analysis Synthesis)
+  (|> /common.extensions
+      (dict.merge /host.extensions)
+      dict.entries
+      (list/map (function (_ [name proc]) [name (proc name)]))
+      (dict.from-list text.Hash)))
diff --git a/stdlib/source/lux/language/compiler/extension/analysis/common.lux b/stdlib/source/lux/language/compiler/extension/analysis/common.lux
new file mode 100644
index 000000000..a0525cf12
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/analysis/common.lux
@@ -0,0 +1,375 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                [thread #+ Box])
+       (concurrency [atom #+ Atom])
+       (data [text]
+             text/format
+             (collection [list "list/" Functor]
+                         [array]
+                         ["dict" dictionary #+ Dictionary]))
+       [language]
+       (language (type ["tc" check]))
+       [io #+ IO])
+  [////]
+  (//// [analysis #+ Analysis]
+        (analysis [".A" type]
+                  [".A" case]
+                  [".A" function]))
+  [///]
+  [///bundle])
+
+(type: Handler
+  (///.Handler .Lux .Code Analysis))
+
+## [Utils]
+(def: (simple extension inputsT+ outputT)
+  (-> Text (List Type) Type ..Handler)
+  (let [num-expected (list.size inputsT+)]
+    (function (_ 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 (#///.Extension extension argsA)))
+          (language.throw ///bundle.incorrect-arity [extension num-expected num-actual]))))))
+
+(def: #export (nullary valueT extension)
+  (-> Type Text ..Handler)
+  (simple extension (list) valueT))
+
+(def: #export (unary inputT outputT extension)
+  (-> Type Type Text ..Handler)
+  (simple extension (list inputT) outputT))
+
+(def: #export (binary subjectT paramT outputT extension)
+  (-> Type Type Type Text ..Handler)
+  (simple extension (list subjectT paramT) outputT))
+
+(def: #export (trinary subjectT param0T param1T outputT extension)
+  (-> Type Type Type Type Text ..Handler)
+  (simple extension (list subjectT param0T param1T) outputT))
+
+## [Analysers]
+## "lux is" represents reference/pointer equality.
+(def: (lux//is extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((binary varT varT Bool extension)
+       analyse args))))
+
+## "lux try" provides a simple way to interact with the host platform's
+## error-handling facilities.
+(def: (lux//try extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (case args
+      (^ (list opC))
+      (do ////.Monad
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Either Text varT)))
+         opA (typeA.with-type (type (IO varT))
+               (analyse opC))]
+        (wrap (#///.Extension extension (list opA))))
+      
+      _
+      (language.throw ///bundle.incorrect-arity [extension +1 (list.size args)]))))
+
+(def: (lux//in-module extension)
+  (-> Text ..Handler)
+  (function (_ analyse argsC+)
+    (case argsC+
+      (^ (list [_ (#.Text module-name)] exprC))
+      (language.with-current-module module-name
+        (analyse exprC))
+      
+      _
+      (language.throw ///bundle.invalid-syntax [extension]))))
+
+## (do-template [ ]
+##   [(def: ( extension)
+##      (-> Text ..Handler)
+##      (function (_ analyse args)
+##        (case args
+##          (^ (list typeC valueC))
+##          (do ////.Monad
+##            [actualT (eval Type typeC)
+##             _ (typeA.infer (:coerce Type actualT))]
+##            (typeA.with-type 
+##              (analyse valueC)))
+
+##          _
+##          (language.throw ///bundle.incorrect-arity [extension +2 (list.size args)]))))]
+
+##   [lux//check  (:coerce Type actualT)]
+##   [lux//coerce Any]
+##   )
+
+(def: (lux//check//type extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (case args
+      (^ (list valueC))
+      (do ////.Monad
+        [_ (typeA.infer Type)
+         valueA (typeA.with-type Type
+                  (analyse valueC))]
+        (wrap valueA))
+      
+      _
+      (language.throw ///bundle.incorrect-arity [extension +1 (list.size args)]))))
+
+(def: bundle/lux
+  ///.Bundle
+  (|> ///.fresh
+      (///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")
+      (|> ///.fresh
+          (///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")
+      (|> ///.fresh
+          (///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")
+      (|> ///.fresh
+          (///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 Bool))
+          (///bundle.install "<" (binary Int Int Bool))
+          (///bundle.install "min" (nullary Int))
+          (///bundle.install "max" (nullary Int))
+          (///bundle.install "to-nat" (unary Int Nat))
+          (///bundle.install "to-frac" (unary Int Frac))
+          (///bundle.install "char" (unary Int Text)))))
+
+(def: bundle/frac
+  ///.Bundle
+  (<| (///bundle.prefix "frac")
+      (|> ///.fresh
+          (///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 Bool))
+          (///bundle.install "<" (binary Frac Frac Bool))
+          (///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")
+      (|> ///.fresh
+          (///bundle.install "=" (binary Text Text Bool))
+          (///bundle.install "<" (binary Text Text Bool))
+          (///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 "hash" (unary Text Nat))
+          (///bundle.install "replace-once" (trinary Text Text Text Text))
+          (///bundle.install "replace-all" (trinary Text Text Text Text))
+          (///bundle.install "char" (binary Text Nat (type (Maybe Nat))))
+          (///bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text))))
+          )))
+
+(def: (array//get extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((binary (type (Array varT)) Nat (type (Maybe varT)) extension)
+       analyse args))))
+
+(def: (array//put extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((trinary (type (Array varT)) Nat varT (type (Array varT)) extension)
+       analyse args))))
+
+(def: (array//remove extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((binary (type (Array varT)) Nat (type (Array varT)) extension)
+       analyse args))))
+
+(def: bundle/array
+  ///.Bundle
+  (<| (///bundle.prefix "array")
+      (|> ///.fresh
+          (///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")
+      (|> ///.fresh
+          (///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 extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (case args
+      (^ (list initC))
+      (do ////.Monad
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Atom varT)))
+         initA (typeA.with-type varT
+                 (analyse initC))]
+        (wrap (#///.Extension extension (list initA))))
+      
+      _
+      (language.throw ///bundle.incorrect-arity [extension +1 (list.size args)]))))
+
+(def: (atom-read extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((unary (type (Atom varT)) varT extension)
+       analyse args))))
+
+(def: (atom//compare-and-swap extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[var-id varT] (typeA.with-env tc.var)]
+      ((trinary (type (Atom varT)) varT varT Bool extension)
+       analyse args))))
+
+(def: bundle/atom
+  ///.Bundle
+  (<| (///bundle.prefix "atom")
+      (|> ///.fresh
+          (///bundle.install "new" atom-new)
+          (///bundle.install "read" atom-read)
+          (///bundle.install "compare-and-swap" atom//compare-and-swap)
+          )))
+
+(def: (box//new extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (case args
+      (^ (list initC))
+      (do ////.Monad
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer (type (All [!] (Box ! varT))))
+         initA (typeA.with-type varT
+                 (analyse initC))]
+        (wrap (#///.Extension extension (list initA))))
+      
+      _
+      (language.throw ///bundle.incorrect-arity [extension +1 (list.size args)]))))
+
+(def: (box//read extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[thread-id threadT] (typeA.with-env tc.var)
+       [var-id varT] (typeA.with-env tc.var)]
+      ((unary (type (Box threadT varT)) varT extension)
+       analyse args))))
+
+(def: (box//write extension)
+  (-> Text ..Handler)
+  (function (_ analyse args)
+    (do ////.Monad
+      [[thread-id threadT] (typeA.with-env tc.var)
+       [var-id varT] (typeA.with-env tc.var)]
+      ((binary varT (type (Box threadT varT)) Any extension)
+       analyse args))))
+
+(def: bundle/box
+  ///.Bundle
+  (<| (///bundle.prefix "box")
+      (|> ///.fresh
+          (///bundle.install "new" box//new)
+          (///bundle.install "read" box//read)
+          (///bundle.install "write" box//write)
+          )))
+
+(def: bundle/process
+  ///.Bundle
+  (<| (///bundle.prefix "process")
+      (|> ///.fresh
+          (///bundle.install "parallelism" (nullary Nat))
+          (///bundle.install "schedule" (binary Nat (type (IO Any)) Any))
+          )))
+
+(def: #export bundle
+  ///.Bundle
+  (<| (///bundle.prefix "lux")
+      (|> ///.fresh
+          (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
new file mode 100644
index 000000000..c11a6d5f4
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/analysis/host.jvm.lux
@@ -0,0 +1,1268 @@
+(.module:
+  [lux #- char int]
+  (lux (control [monad #+ do]
+                ["p" parser]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [maybe]
+             [product]
+             [bool "bool/" Equivalence]
+             [text "text/" Equivalence]
+             (text format
+                   ["l" lexer])
+             (collection [list "list/" Fold Functor Monoid]
+                         [array]
+                         ["dict" dictionary #+ Dictionary]))
+       [macro "macro/" Monad]
+       (macro [code]
+              ["s" syntax])
+       [language]
+       (language [type]
+                 (type ["tc" check]))
+       [host])
+  ["/" //common]
+  (//// [".L" analysis #+ Analysis]
+        (analysis [".A" type]
+                  [".A" inference]))
+  [///]
+  )
+
+(host.import: #long java/lang/reflect/Type
+  (getTypeName [] String))
+
+(def: jvm-type-name
+  (-> java/lang/reflect/Type Text)
+  (java/lang/reflect/Type::getTypeName []))
+
+(exception: #export (jvm-type-is-not-a-class {jvm-type java/lang/reflect/Type})
+  (jvm-type-name jvm-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]
+
+  [cannot-convert-to-a-class]
+  [cannot-convert-to-a-parameter]
+  [cannot-convert-to-a-lux-type]
+  [unknown-type-var]
+  [type-parameter-mismatch]
+  [cannot-correspond-type-with-a-class]
+  )
+
+(do-template []
+  [(exception: #export ( {class Text} {method Text} {hints (List [Type (List Type)])})
+     (ex.report ["Class" class]
+                ["Method" method]
+                ["Hints" (|> hints
+                             (list/map (|>> %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: conversion-procs
+  /.Bundle
+  (<| (/.prefix "convert")
+      (|> (dict.new text.Hash)
+          (/.install "double-to-float" (/.unary Double Float))
+          (/.install "double-to-int" (/.unary Double Integer))
+          (/.install "double-to-long" (/.unary Double Long))
+          (/.install "float-to-double" (/.unary Float Double))
+          (/.install "float-to-int" (/.unary Float Integer))
+          (/.install "float-to-long" (/.unary Float Long))
+          (/.install "int-to-byte" (/.unary Integer Byte))
+          (/.install "int-to-char" (/.unary Integer Character))
+          (/.install "int-to-double" (/.unary Integer Double))
+          (/.install "int-to-float" (/.unary Integer Float))
+          (/.install "int-to-long" (/.unary Integer Long))
+          (/.install "int-to-short" (/.unary Integer Short))
+          (/.install "long-to-double" (/.unary Long Double))
+          (/.install "long-to-float" (/.unary Long Float))
+          (/.install "long-to-int" (/.unary Long Integer))
+          (/.install "long-to-short" (/.unary Long Short))
+          (/.install "long-to-byte" (/.unary Long Byte))
+          (/.install "char-to-byte" (/.unary Character Byte))
+          (/.install "char-to-short" (/.unary Character Short))
+          (/.install "char-to-int" (/.unary Character Integer))
+          (/.install "char-to-long" (/.unary Character Long))
+          (/.install "byte-to-long" (/.unary Byte Long))
+          (/.install "short-to-long" (/.unary Short Long))
+          )))
+
+(do-template [  ]
+  [(def: 
+     /.Bundle
+     (<| (/.prefix )
+         (|> (dict.new text.Hash)
+             (/.install "+" (/.binary   ))
+             (/.install "-" (/.binary   ))
+             (/.install "*" (/.binary   ))
+             (/.install "/" (/.binary   ))
+             (/.install "%" (/.binary   ))
+             (/.install "=" (/.binary   Boolean))
+             (/.install "<" (/.binary   Boolean))
+             (/.install "and" (/.binary   ))
+             (/.install "or" (/.binary   ))
+             (/.install "xor" (/.binary   ))
+             (/.install "shl" (/.binary  Integer ))
+             (/.install "shr" (/.binary  Integer ))
+             (/.install "ushr" (/.binary  Integer ))
+             )))]
+
+  [int-procs  "int"  Integer]
+  [long-procs "long" Long]
+  )
+
+(do-template [  ]
+  [(def: 
+     /.Bundle
+     (<| (/.prefix )
+         (|> (dict.new text.Hash)
+             (/.install "+" (/.binary   ))
+             (/.install "-" (/.binary   ))
+             (/.install "*" (/.binary   ))
+             (/.install "/" (/.binary   ))
+             (/.install "%" (/.binary   ))
+             (/.install "=" (/.binary   Boolean))
+             (/.install "<" (/.binary   Boolean))
+             )))]
+
+  [float-procs  "float"  Float]
+  [double-procs "double" Double]
+  )
+
+(def: char-procs
+  /.Bundle
+  (<| (/.prefix "char")
+      (|> (dict.new text.Hash)
+          (/.install "=" (/.binary Character Character Boolean))
+          (/.install "<" (/.binary Character Character Boolean))
+          )))
+
+(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"])
+      (dict.from-list text.Hash)))
+
+(def: (array//length proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list arrayC))
+      (do macro.Monad
+        [_ (typeA.infer Nat)
+         [var-id varT] (typeA.with-env tc.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))]
+        (wrap (#analysisL.Extension proc (list arrayA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +1 (list.size args)]))))
+
+(def: (array//new proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list lengthC))
+      (do macro.Monad
+        [lengthA (typeA.with-type Nat
+                   (analyse lengthC))
+         expectedT macro.expected-type
+         [level elem-class] (: (Meta [Nat Text])
+                               (loop [analysisT expectedT
+                                      level +0]
+                                 (case analysisT
+                                   (#.Apply inputT funcT)
+                                   (case (type.apply (list inputT) funcT)
+                                     (#.Some outputT)
+                                     (recur outputT level)
+
+                                     #.None
+                                     (language.throw non-array expectedT))
+
+                                   (^ (#.Primitive "#Array" (list elemT)))
+                                   (recur elemT (inc level))
+
+                                   (#.Primitive class _)
+                                   (wrap [level class])
+                                   
+                                   _
+                                   (language.throw non-array expectedT))))
+         _ (if (n/> +0 level)
+             (wrap [])
+             (language.throw non-array expectedT))]
+        (wrap (#analysisL.Extension proc (list (analysisL.nat (dec level))
+                                               (analysisL.text elem-class)
+                                               lengthA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +1 (list.size args)]))))
+
+(def: (check-jvm objectT)
+  (-> Type (Meta Text))
+  (case objectT
+    (#.Primitive name _)
+    (macro/wrap name)
+
+    (#.Named name unnamed)
+    (check-jvm unnamed)
+
+    (#.Var id)
+    (macro/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
+      (language.throw non-object objectT))
+
+    _
+    (language.throw non-object objectT)))
+
+(def: (check-object objectT)
+  (-> Type (Meta Text))
+  (do macro.Monad
+    [name (check-jvm objectT)]
+    (if (dict.contains? name boxes)
+      (language.throw primitives-are-not-objects name)
+      (macro/wrap name))))
+
+(def: (box-array-element-type elemT)
+  (-> Type (Meta [Type Text]))
+  (case elemT
+    (#.Primitive name #.Nil)
+    (let [boxed-name (|> (dict.get name boxes)
+                         (maybe.default name))]
+      (macro/wrap [(#.Primitive boxed-name #.Nil)
+                   boxed-name]))
+
+    (#.Primitive name _)
+    (if (dict.contains? name boxes)
+      (language.throw primitives-cannot-have-type-parameters name)
+      (macro/wrap [elemT name]))
+
+    _
+    (language.throw invalid-type-for-array-element (%type elemT))))
+
+(def: (array//read proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list arrayC idxC))
+      (do macro.Monad
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer varT)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (tc.read var-id))
+         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (typeA.with-type Nat
+                (analyse idxC))]
+        (wrap (#analysisL.Extension proc (list (analysisL.text elem-class) idxA arrayA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +2 (list.size args)]))))
+
+(def: (array//write proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list arrayC idxC valueC))
+      (do macro.Monad
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Array varT)))
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (tc.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 (#analysisL.Extension proc (list (analysisL.text elem-class) idxA valueA arrayA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +3 (list.size args)]))))
+
+(def: array-procs
+  /.Bundle
+  (<| (/.prefix "array")
+      (|> (dict.new text.Hash)
+          (/.install "length" array//length)
+          (/.install "new" array//new)
+          (/.install "read" array//read)
+          (/.install "write" array//write)
+          )))
+
+(def: (object//null proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list))
+      (do macro.Monad
+        [expectedT macro.expected-type
+         _ (check-object expectedT)]
+        (wrap (#analysisL.Extension proc (list))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +0 (list.size args)]))))
+
+(def: (object//null? proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list objectC))
+      (do macro.Monad
+        [_ (typeA.infer Bool)
+         [objectT objectA] (typeA.with-inference
+                             (analyse objectC))
+         _ (check-object objectT)]
+        (wrap (#analysisL.Extension proc (list objectA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +1 (list.size args)]))))
+
+(def: (object//synchronized proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list monitorC exprC))
+      (do macro.Monad
+        [[monitorT monitorA] (typeA.with-inference
+                               (analyse monitorC))
+         _ (check-object monitorT)
+         exprA (analyse exprC)]
+        (wrap (#analysisL.Extension proc (list monitorA exprA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +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 (Meta (Class Object)))
+  (do macro.Monad
+    []
+    (case (Class::forName [name])
+      (#e.Success [class])
+      (wrap class)
+
+      (#e.Error error)
+      (language.throw unknown-class name))))
+
+(def: (sub-class? super sub)
+  (-> Text Text (Meta Bool))
+  (do macro.Monad
+    [super (load-class super)
+     sub (load-class sub)]
+    (wrap (Class::isAssignableFrom [sub] super))))
+
+(def: (object//throw proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list exceptionC))
+      (do macro.Monad
+        [_ (typeA.infer Nothing)
+         [exceptionT exceptionA] (typeA.with-inference
+                                   (analyse exceptionC))
+         exception-class (check-object exceptionT)
+         ? (sub-class? "java.lang.Throwable" exception-class)
+         _ (: (Meta Any)
+              (if ?
+                (wrap [])
+                (language.throw non-throwable exception-class)))]
+        (wrap (#analysisL.Extension proc (list exceptionA))))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +1 (list.size args)]))))
+
+(def: (object//class proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC))
+      (case classC
+        [_ (#.Text class)]
+        (do macro.Monad
+          [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
+           _ (load-class class)]
+          (wrap (#analysisL.Extension proc (list (analysisL.text class)))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +1 (list.size args)]))))
+
+(def: (object//instance? proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC objectC))
+      (case classC
+        [_ (#.Text class)]
+        (do macro.Monad
+          [_ (typeA.infer Bool)
+           [objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           object-class (check-object objectT)
+           ? (sub-class? class object-class)]
+          (if ?
+            (wrap (#analysisL.Extension proc (list (analysisL.text class))))
+            (language.throw cannot-possibly-be-an-instance (format object-class " !<= "  class))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +2 (list.size args)]))))
+
+(def: (java-type-to-class type)
+  (-> java/lang/reflect/Type (Meta Text))
+  (cond (host.instance? Class type)
+        (macro/wrap (Class::getName [] (:coerce Class type)))
+
+        (host.instance? ParameterizedType type)
+        (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType type)))
+
+        ## else
+        (language.throw cannot-convert-to-a-class (jvm-type-name type))))
+
+(type: Mappings
+  (Dictionary Text Type))
+
+(def: fresh-mappings Mappings (dict.new text.Hash))
+
+(def: (java-type-to-lux-type mappings java-type)
+  (-> Mappings java/lang/reflect/Type (Meta Type))
+  (cond (host.instance? TypeVariable java-type)
+        (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))]
+          (case (dict.get var-name mappings)
+            (#.Some var-type)
+            (macro/wrap var-type)
+            
+            #.None
+            (language.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)
+            
+            _
+            (macro/wrap Any)))
+
+        (host.instance? Class java-type)
+        (let [java-type (:coerce (Class Object) java-type)
+              class-name (Class::getName [] java-type)]
+          (macro/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 macro.Monad
+              [paramsT (|> java-type
+                           (ParameterizedType::getActualTypeArguments [])
+                           array.to-list
+                           (monad.map @ (java-type-to-lux-type mappings)))]
+              (macro/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw))
+                                       paramsT)))
+            (language.throw jvm-type-is-not-a-class raw)))
+
+        (host.instance? GenericArrayType java-type)
+        (do macro.Monad
+          [innerT (|> (:coerce GenericArrayType java-type)
+                      (GenericArrayType::getGenericComponentType [])
+                      (java-type-to-lux-type mappings))]
+          (wrap (#.Primitive "#Array" (list innerT))))
+
+        ## else
+        (language.throw cannot-convert-to-a-lux-type (jvm-type-name java-type))))
+
+(def: (correspond-type-params class type)
+  (-> (Class Object) Type (Meta 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))
+            (language.throw cannot-correspond-type-with-a-class
+                            (format "Class = " class-name "\n"
+                                    "Type = " (%type type)))
+
+            (not (n/= num-class-params num-type-params))
+            (language.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
+            (macro/wrap (|> params
+                            (list.zip2 (list/map (TypeVariable::getName []) class-params))
+                            (dict.from-list text.Hash)))
+            ))
+
+    _
+    (language.throw non-jvm-type type)))
+
+(def: (object//cast proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list valueC))
+      (do macro.Monad
+        [toT macro.expected-type
+         to-name (check-jvm toT)
+         [valueT valueA] (typeA.with-inference
+                           (analyse valueC))
+         from-name (check-jvm valueT)
+         can-cast? (: (Meta Bool)
+                      (case [from-name to-name]
+                        (^template [ ]
+                          (^or [ ]
+                               [ ])
+                          (do @
+                            [_ (typeA.infer (#.Primitive to-name (list)))]
+                            (wrap true)))
+                        (["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 @
+                          [_ (language.assert primitives-are-not-objects from-name
+                                              (not (dict.contains? from-name boxes)))
+                           _ (language.assert primitives-are-not-objects to-name
+                                              (not (dict.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 true))
+                              (do @
+                                [current-class (load-class current-name)
+                                 _ (language.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
+                                  (language.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 (#analysisL.Extension proc (list (analysisL.text from-name)
+                                                 (analysisL.text to-name)
+                                                 valueA)))
+          (language.throw cannot-cast (format "From class/primitive: " from-name "\n"
+                                              "  To class/primitive: " to-name "\n"
+                                              "           For value: " (%code valueC) "\n"))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: object-procs
+  /.Bundle
+  (<| (/.prefix "object")
+      (|> (dict.new text.Hash)
+          (/.install "null" object//null)
+          (/.install "null?" object//null?)
+          (/.install "synchronized" object//synchronized)
+          (/.install "throw" object//throw)
+          (/.install "class" object//class)
+          (/.install "instance?" object//instance?)
+          (/.install "cast" object//cast)
+          )))
+
+(def: (find-field class-name field-name)
+  (-> Text Text (Meta [(Class Object) Field]))
+  (do macro.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])
+          (language.throw mistaken-field-owner
+                          (format "       Field: " field-name "\n"
+                                  " Owner Class: " (Class::getName [] owner) "\n"
+                                  "Target Class: " class-name "\n"))))
+
+      (#e.Error _)
+      (language.throw unknown-field (format class-name "#" field-name)))))
+
+(def: (static-field class-name field-name)
+  (-> Text Text (Meta [Type Bool]))
+  (do macro.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])])))
+      (language.throw not-a-static-field (format class-name "#" field-name)))))
+
+(def: (virtual-field class-name field-name objectT)
+  (-> Text Text Type (Meta [Type Bool]))
+  (do macro.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 (: (Meta Mappings)
+                     (case objectT
+                       (#.Primitive _class-name _class-params)
+                       (do @
+                         [#let [num-params (list.size _class-params)
+                                num-vars (list.size var-names)]
+                          _ (language.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)
+                                   (dict.from-list text.Hash))))
+
+                       _
+                       (language.throw non-object objectT)))
+         fieldT (java-type-to-lux-type mappings fieldJT)]
+        (wrap [fieldT (Modifier::isFinal [modifiers])]))
+      (language.throw not-a-virtual-field (format class-name "#" field-name)))))
+
+(def: (static//get proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC fieldC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad
+          [[fieldT final?] (static-field class field)]
+          (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field)))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +2 (list.size args)]))))
+
+(def: (static//put proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC fieldC valueC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad
+          [_ (typeA.infer Any)
+           [fieldT final?] (static-field class field)
+           _ (language.assert cannot-set-a-final-field (format class "#" field)
+                              (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) valueA))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +3 (list.size args)]))))
+
+(def: (virtual//get proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC fieldC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad
+          [[objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           [fieldT final?] (virtual-field class field objectT)]
+          (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) objectA))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +3 (list.size args)]))))
+
+(def: (virtual//put proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC fieldC valueC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad
+          [[objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           _ (typeA.infer objectT)
+           [fieldT final?] (virtual-field class field objectT)
+           _ (language.assert cannot-set-a-final-field (format class "#" field)
+                              (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysisL.Extension proc (list (analysisL.text class) (analysisL.text field) valueA objectA))))
+
+        _
+        (language.throw /.invalid-syntax [proc args]))
+
+      _
+      (language.throw /.incorrect-extension-arity [proc +4 (list.size args)]))))
+
+(def: (java-type-to-parameter type)
+  (-> java/lang/reflect/Type (Meta Text))
+  (cond (host.instance? Class type)
+        (macro/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))
+        (macro/wrap "java.lang.Object")
+
+        (host.instance? GenericArrayType type)
+        (do macro.Monad
+          [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))]
+          (wrap (format componentP "[]")))
+
+        ## else
+        (language.throw cannot-convert-to-a-parameter (jvm-type-name 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 (Meta Bool))
+  (do macro.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])
+
+                 _
+                 true)
+               (case method-style
+                 #Special
+                 (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
+                          (Modifier::isAbstract [modifiers])))
+
+                 _
+                 true)
+               (n/= (list.size arg-classes) (list.size parameters))
+               (list/fold (function (_ [expectedJC actualJC] prev)
+                            (and prev
+                                 (text/= expectedJC actualJC)))
+                          true
+                          (list.zip2 arg-classes parameters))))))
+
+(def: (check-constructor class arg-classes constructor)
+  (-> (Class Object) (List Text) (Constructor Object) (Meta Bool))
+  (do macro.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)))
+                          true
+                          (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-to-type method-style method)
+  (-> Method-style Method (Meta [Type (List Type)]))
+  (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)
+                          (dict.from-list text.Hash))))]
+    (do macro.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 a)
+  (#Pass a)
+  (#Hint a)
+  #Fail)
+
+(do-template [ ]
+  [(def: 
+     (All [a] (-> (Evaluation a) (Maybe a)))
+     (|>> (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) (Meta [Type (List Type)]))
+  (do macro.Monad
+    [class (load-class class-name)
+     candidates (|> class
+                    (Class::getDeclaredMethods [])
+                    array.to-list
+                    (monad.map @ (: (-> Method (Meta (Evaluation Method)))
+                                    (function (_ method)
+                                      (do @
+                                        [passes? (check-method class method-name method-style arg-classes method)]
+                                        (wrap (cond passes?
+                                                    (#Pass method)
+
+                                                    (text/= method-name (Method::getName [] method))
+                                                    (#Hint method)
+
+                                                    ## else
+                                                    #Fail)))))))]
+    (case (list.search-all pass! candidates)
+      #.Nil
+      (language.throw no-candidates [class-name method-name
+                                     (|> candidates
+                                         (list.search-all hint!)
+                                         (list/map (method-to-type method-style)))])
+      
+      (#.Cons method #.Nil)
+      (method-to-type method-style method)
+
+      candidates
+      (language.throw too-many-candidates [class-name method-name
+                                           (list/map (method-to-type method-style) candidates)]))))
+
+(def: (constructor-to-type constructor)
+  (-> (Constructor Object) (Meta [Type (List Type)]))
+  (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)
+                          (dict.from-list text.Hash))))]
+    (do macro.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) (Meta [Type (List Type)]))
+  (do macro.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)]
+                                     (wrap [passes? constructor])))))]
+    (case (list.search-all pass! candidates)
+      #.Nil
+      (language.throw no-candidates [class-name ..constructor-method
+                                     (|> candidates
+                                         (list.search-all hint!)
+                                         (list/map constructor-to-type))])
+      
+      (#.Cons constructor #.Nil)
+      (constructor-to-type constructor)
+
+      candidates
+      (language.throw too-many-candidates [class-name ..constructor-method
+                                           (list/map constructor-to-type candidates)]))))
+
+(def: (decorate-inputs typesT inputsA)
+  (-> (List Text) (List Analysis) (List Analysis))
+  (|> inputsA
+      (list.zip2 (list/map analysisL.text typesT))
+      (list/map (function (_ [type value])
+                  (analysisL.product-analysis (list type value))))))
+
+(def: (invoke//static proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method)
+                                                (analysisL.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//virtual proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method)
+                                                (analysisL.text outputJC) objectA (decorate-inputs argsT argsA)))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//special proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (analysisL.text method)
+                                                (analysisL.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//interface proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval 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 macro.Monad
+        [#let [argsT (list/map product.left argsTC)]
+         class (load-class class-name)
+         _ (language.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 (#analysisL.Extension proc
+                                    (list& (analysisL.text class-name) (analysisL.text method) (analysisL.text outputJC)
+                                           (decorate-inputs argsT argsA)))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//constructor proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval 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 macro.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 (#analysisL.Extension proc (list& (analysisL.text class) (decorate-inputs argsT argsA)))))
+
+      _
+      (language.throw /.invalid-syntax [proc args]))))
+
+(def: member-procs
+  /.Bundle
+  (<| (/.prefix "member")
+      (|> (dict.new text.Hash)
+          (dict.merge (<| (/.prefix "static")
+                          (|> (dict.new text.Hash)
+                              (/.install "get" static//get)
+                              (/.install "put" static//put))))
+          (dict.merge (<| (/.prefix "virtual")
+                          (|> (dict.new text.Hash)
+                              (/.install "get" virtual//get)
+                              (/.install "put" virtual//put))))
+          (dict.merge (<| (/.prefix "invoke")
+                          (|> (dict.new text.Hash)
+                              (/.install "static" invoke//static)
+                              (/.install "virtual" invoke//virtual)
+                              (/.install "special" invoke//special)
+                              (/.install "interface" invoke//interface)
+                              (/.install "constructor" invoke//constructor)
+                              )))
+          )))
+
+(def: #export extensions
+  /.Bundle
+  (<| (/.prefix "jvm")
+      (|> (dict.new text.Hash)
+          (dict.merge conversion-procs)
+          (dict.merge int-procs)
+          (dict.merge long-procs)
+          (dict.merge float-procs)
+          (dict.merge double-procs)
+          (dict.merge char-procs)
+          (dict.merge array-procs)
+          (dict.merge object-procs)
+          (dict.merge member-procs)
+          )))
diff --git a/stdlib/source/lux/language/compiler/extension/bundle.lux b/stdlib/source/lux/language/compiler/extension/bundle.lux
new file mode 100644
index 000000000..4e011d2ca
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/bundle.lux
@@ -0,0 +1,31 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [text]
+             text/format
+             (collection [list "list/" Functor]
+                         ["dict" dictionary #+ Dictionary])))
+  [//])
+
+(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 (install name anonymous)
+  (All [s i o]
+    (-> Text (-> 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
new file mode 100644
index 000000000..48073d012
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/synthesis.lux
@@ -0,0 +1,9 @@
+(.module:
+  lux
+  (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
new file mode 100644
index 000000000..ae05fd61c
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/extension/translation.lux
@@ -0,0 +1,9 @@
+(.module:
+  lux
+  (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
new file mode 100644
index 000000000..92a066b7e
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/init.lux
@@ -0,0 +1,51 @@
+(.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
new file mode 100644
index 000000000..b8c38928c
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/archive.lux
@@ -0,0 +1,117 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                [equivalence #+ Equivalence]
+                [monad #+ do])
+       (data [error #+ Error]
+             [ident]
+             [text]
+             text/format
+             (collection ["dict" dictionary #+ Dictionary]))
+       (language [type #+ :share])
+       (type 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
new file mode 100644
index 000000000..7c6b558db
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/cache.lux
@@ -0,0 +1,162 @@
+(.module:
+  [lux #- Module]
+  (lux (control [monad #+ Monad do]
+                ["ex" exception #+ exception:]
+                pipe)
+       (data [bool "bool/" Equivalence]
+             [maybe]
+             [error]
+             [product]
+             (format [binary #+ Binary])
+             [text]
+             text/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 false)
+                                 (do @
+                                   [_ (..delete System file)]
+                                   (wrap true))))))]
+             [(list.every? (bool/= true))
+              (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 (bool.complement (set.member? wanted-modules)))
+            (monad.map @ (un-install System root))])))
+
+## Load
+(def: signature
+  (Binary Signature)
+  ($_ binary.seq binary.ident binary.text))
+
+(def: descriptor
+  (Binary Descriptor)
+  ($_ binary.seq binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))
+
+(def: document
+  (All [a] (-> (Binary a) (Binary [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) (Binary 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) (Binary 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
new file mode 100644
index 000000000..f489f04ed
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/cache/dependency.lux
@@ -0,0 +1,51 @@
+(.module:
+  [lux #- Module]
+  (lux (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
new file mode 100644
index 000000000..e440c16f9
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/io.lux
@@ -0,0 +1,18 @@
+(.module:
+  [lux #- Module]
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (data [error]
+             [text]
+             (text format
+                   [encoding]))
+       (world [file #+ File System]
+              [blob #+ Blob])))
+
+(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
new file mode 100644
index 000000000..534c9e20c
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/io/archive.lux
@@ -0,0 +1,70 @@
+(.module:
+  [lux #- Module]
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (data [error]
+             [text]
+             text/format)
+       (world [file #+ File System]
+              [blob #+ Blob]))
+  [/////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 Blob 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
new file mode 100644
index 000000000..327f52cf5
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/meta/io/context.lux
@@ -0,0 +1,89 @@
+(.module:
+  [lux #- Module Code]
+  (lux (control monad
+                ["ex" exception #+ Exception exception:])
+       (data [error]
+             (text format
+                   [encoding]))
+       (world [file #+ File System]
+              [blob #+ Blob]))
+  [/////host]
+  [// #+ Context Module])
+
+(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])
+       blob (:: System read file)]
+      (case (encoding.from-utf8 blob)
+        (#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
new file mode 100644
index 000000000..36db1fe5e
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/synthesis.lux
@@ -0,0 +1,241 @@
+(.module:
+  [lux #- i64 Scope]
+  (lux (control [monad #+ do])
+       (data [error #+ Error]
+             (collection ["dict" dictionary #+ Dictionary])))
+  [///reference #+ Register Variable Reference]
+  [// #+ Operation Compiler]
+  [//analysis #+ Environment Arity Analysis])
+
+(type: #export Resolver (Dictionary Variable Variable))
+
+(type: #export State
+  {#scope-arity Arity
+   #resolver Resolver
+   #direct? Bool
+   #locals Nat})
+
+(def: #export fresh-resolver
+  Resolver
+  (dict.new ///reference.Hash))
+
+(def: #export init
+  State
+  {#scope-arity +0
+   #resolver fresh-resolver
+   #direct? false
+   #locals +0})
+
+(type: #export Primitive
+  (#Bool Bool)
+  (#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 (Branch s)
+  (#Case s (Path' s))
+  (#Let s Register s)
+  (#If s s 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)))
+
+(type: #export Path
+  (Path' Synthesis))
+
+(def: #export path/pop
+  Path
+  #Pop)
+
+(do-template [ ]
+  [(template: #export ( content)
+     (#..Test ( content)))]
+
+  [path/bool #..Bool]
+  [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))
+
+(def: #export unit Text "")
+
+(type: #export Synthesizer
+  (Compiler ..State Analysis Synthesis))
+
+(do-template [ ]
+  [(def: #export 
+     (All [a] (-> (Operation ..State a) (Operation ..State a)))
+     (//.localized (set@ #direct? )))]
+
+  [indirectly false]
+  [directly   true]
+  )
+
+(do-template [  ]
+  [(def: #export ( value)
+     (->  (All [a] (-> (Operation ..State a) (Operation ..State a))))
+     (//.localized (set@  value)))]
+
+  [with-scope-arity Arity    #scope-arity]
+  [with-resolver    Resolver #resolver]
+  [with-locals      Nat      #locals]
+  )
+
+(def: #export (with-abstraction arity resolver)
+  (All [o]
+    (-> Arity Resolver
+        (-> (Operation ..State o) (Operation ..State o))))
+  (//.with-state {#scope-arity arity
+                  #resolver resolver
+                  #direct? true
+                  #locals arity}))
+
+(do-template [  ]
+  [(def: #export 
+     (Operation ..State )
+     (function (_ state)
+       (#error.Success [state (get@  state)])))]
+
+  [scope-arity #scope-arity Arity]
+  [resolver    #resolver    Resolver]
+  [direct?     #direct?     Bool]
+  [locals      #locals      Nat]
+  )
+
+(def: #export with-new-local
+  (All [a] (-> (Operation ..State a) (Operation ..State a)))
+  (<<| (do //.Monad
+         [locals ..locals])
+       (..with-locals (inc locals))))
+
+(do-template [ ]
+  [(template: #export ( content)
+     (#..Primitive ( content)))]
+
+  [bool #..Bool]
+  [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)
+     (.<| #..Control
+          
+          
+          content))]
+
+  [branch/case          #..Branch   #..Case]
+  [branch/let           #..Branch   #..Let]
+  [branch/if            #..Branch   #..If]
+
+  [loop/scope           #..Loop     #..Scope]
+  [loop/recur           #..Loop     #..Recur]
+
+  [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
new file mode 100644
index 000000000..5fca60a99
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/synthesis/case.lux
@@ -0,0 +1,177 @@
+(.module:
+  lux
+  (lux (control [equivalence #+ Equivalence]
+                pipe
+                [monad #+ do])
+       (data [product]
+             [bool "bool/" Equivalence]
+             [text "text/" Equivalence]
+             text/format
+             [number "frac/" Equivalence]
+             (collection [list "list/" Fold Monoid])))
+  [///reference]
+  [///compiler #+ Operation "operation/" Monad]
+  [///analysis #+ Pattern Match Analysis]
+  [// #+ Path Synthesis]
+  [//function])
+
+(def: (path' pattern bodyC)
+  (-> Pattern (Operation //.State Path) (Operation //.State Path))
+  (case pattern
+    (#///analysis.Simple simple)
+    (case simple
+      #///analysis.Unit
+      bodyC
+      
+      (^template [ ]
+        ( value)
+        (operation/map (|>> (#//.Seq (#//.Test (|> value ))))
+                       bodyC))
+      ([#///analysis.Bool #//.Bool]
+       [#///analysis.Nat  (<| #//.I64 .i64)]
+       [#///analysis.Int  (<| #//.I64 .i64)]
+       [#///analysis.Rev  (<| #//.I64 .i64)]
+       [#///analysis.Frac #//.F64]
+       [#///analysis.Text #//.Text]))
+    
+    (#///analysis.Bind register)
+    (<| (do ///compiler.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)
+  (-> //.Synthesizer Pattern Analysis (Operation //.State 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
+          ))
+      ([#//.Bool bool/=]
+       [#//.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+])
+  (-> //.Synthesizer Analysis Match (Operation //.State Synthesis))
+  (do ///compiler.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/bool true) thenA]
+                                      (list [(///analysis.pattern/bool false) elseA])])
+                                  (^ [[(///analysis.pattern/bool false) elseA]
+                                      (list [(///analysis.pattern/bool true) 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
new file mode 100644
index 000000000..6db9a8fd5
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/synthesis/expression.lux
@@ -0,0 +1,99 @@
+(.module:
+  [lux #- primitive]
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [maybe]
+             (collection [list "list/" Functor]
+                         ["dict" dictionary #+ Dictionary])))
+  [///reference]
+  [///compiler "operation/" Monad]
+  [///analysis #+ Analysis]
+  [///extension #+ Extension]
+  [// #+ Synthesis]
+  [//function]
+  [//case])
+
+(exception: #export (unknown-synthesis-extension {name Text})
+  name)
+
+(def: (primitive analysis)
+  (-> ///analysis.Primitive //.Primitive)
+  (case analysis
+    #///analysis.Unit
+    (#//.Text //.unit)
+    
+    (^template [ ]
+      ( value)
+      ( value))
+    ([#///analysis.Bool #//.Bool]
+     [#///analysis.Frac #//.F64]
+     [#///analysis.Text #//.Text])
+
+    (^template [ ]
+      ( value)
+      ( (.i64 value)))
+    ([#///analysis.Nat #//.I64]
+     [#///analysis.Int #//.I64]
+     [#///analysis.Rev #//.I64])))
+
+(def: #export (synthesizer extensions)
+  (-> (Extension ///extension.Synthesis) //.Synthesizer)
+  (function (synthesize analysis)
+    (case analysis
+      (#///analysis.Primitive analysis')
+      (operation/wrap (#//.Primitive (..primitive analysis')))
+
+      (#///analysis.Structure composite)
+      (case (///analysis.variant analysis)
+        (#.Some variant)
+        (do ///compiler.Monad
+          [valueS (synthesize (get@ #///analysis.value variant))]
+          (wrap (#//.Structure (#//.Variant (set@ #///analysis.value valueS variant)))))
+
+        _
+        (do ///compiler.Monad
+          [tupleS (monad.map @ synthesize (///analysis.tuple analysis))]
+          (wrap (#//.Structure (#//.Tuple tupleS)))))
+
+      (#///analysis.Apply _)
+      (//function.apply (|>> synthesize //.indirectly) analysis)
+
+      (#///analysis.Function environmentA bodyA)
+      (//function.function synthesize environmentA bodyA)
+
+      (#///analysis.Extension name args)
+      (case (dict.get name extensions)
+        #.None
+        (///compiler.throw unknown-synthesis-extension name)
+        
+        (#.Some extension)
+        (extension (|>> synthesize //.indirectly) args))
+
+      (#///analysis.Reference reference)
+      (case reference
+        (#///reference.Constant constant)
+        (operation/wrap (#//.Reference reference))
+
+        (#///reference.Variable var)
+        (do ///compiler.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 false 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+)
+      )))
diff --git a/stdlib/source/lux/language/compiler/synthesis/function.lux b/stdlib/source/lux/language/compiler/synthesis/function.lux
new file mode 100644
index 000000000..ae7b5c3b3
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/synthesis/function.lux
@@ -0,0 +1,130 @@
+(.module:
+  [lux #- function]
+  (lux (control [monad #+ do]
+                [state]
+                pipe
+                ["ex" exception #+ exception:])
+       (data [maybe "maybe/" Monad]
+             [error]
+             (collection [list "list/" Functor Monoid Fold]
+                         ["dict" dictionary #+ Dictionary])))
+  [///reference #+ Variable]
+  [///compiler #+ Operation]
+  [///analysis #+ Environment Arity Analysis]
+  [// #+ Synthesis Synthesizer]
+  [//loop])
+
+(def: #export nested?
+  (-> Arity Bool)
+  (n/> +1))
+
+(def: #export (adjust up-arity after? var)
+  (-> Arity Bool 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)
+  (-> Synthesizer Synthesizer)
+  (.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 (//loop.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 //.State a)))
+  (|>> (case> (#.Some output)
+              (:: ///compiler.Monad wrap output)
+
+              #.None
+              (///compiler.throw cannot-prepare-function-body []))))
+
+(def: #export (function synthesize environment body)
+  (-> Synthesizer Environment Analysis (Operation //.State 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 true resolved)
+
+                                          #.None
+                                          (adjust arity false 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
new file mode 100644
index 000000000..e4722ee1f
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/synthesis/loop.lux
@@ -0,0 +1,285 @@
+(.module:
+  [lux #- loop]
+  (lux (control [monad #+ do]
+                ["p" parser])
+       (data [maybe "maybe/" Monad]
+             (collection [list "list/" Functor]))
+       (macro [code]
+              [syntax]))
+  [///]
+  [///reference #+ Register Variable]
+  [///analysis #+ Environment]
+  [// #+ Path Abstraction Synthesis])
+
+(type: #export (Transform a)
+  (-> a (Maybe a)))
+
+(def: (some? maybe)
+  (All [a] (-> (Maybe a) Bool))
+  (case maybe
+    (#.Some _) true
+    #.None     false))
+
+(template: #export (self)
+  (#//.Reference (///reference.local +0)))
+
+(template: (recursive-apply args)
+  (#//.Apply (self) args))
+
+(def: proper Bool true)
+(def: improper Bool false)
+
+(def: (proper? exprS)
+  (-> Synthesis Bool)
+  (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
new file mode 100644
index 000000000..8791c8d5e
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation.lux
@@ -0,0 +1,162 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                [monad #+ do])
+       (data [maybe "maybe/" Functor]
+             [error #+ Error]
+             [text]
+             text/format
+             (collection [row #+ Row]
+                         ["dict" dictionary #+ Dictionary]))
+       (world [file #+ File]))
+  [// #+ Operation Compiler]
+  [//synthesis #+ Synthesis])
+
+(do-template []
+  [(exception: #export ()
+     "")]
+
+  [no-active-buffer]
+  [no-anchor]
+  )
+
+(exception: #export (cannot-interpret {message Text})
+  message)
+
+(type: #export Context
+  {#scope-name Text
+   #inner-functions Nat})
+
+(signature: #export (Host code)
+  (: (-> code (Error Any))
+     execute!)
+  (: (-> code (Error Any))
+     evaluate!))
+
+(type: #export (Buffer code) (Row [Ident code]))
+
+(type: #export (Artifacts code) (Dictionary File (Buffer code)))
+
+(type: #export (State anchor code)
+  {#context Context
+   #anchor (Maybe anchor)
+   #host (Host code)
+   #buffer (Maybe (Buffer code))
+   #artifacts (Artifacts code)})
+
+(type: #export (Translator anchor code)
+  (Compiler (State anchor code) Synthesis code))
+
+(def: #export (init host)
+  (All [anchor code] (-> (Host code) (..State anchor code)))
+  {#context {#scope-name ""
+             #inner-functions +0}
+   #anchor #.None
+   #host host
+   #buffer #.None
+   #artifacts (dict.new text.Hash)})
+
+(def: #export (with-context expr)
+  (All [anchor code output]
+    (-> (Operation (..State anchor code) output)
+        (Operation (..State anchor code) [Text output])))
+  (function (_ state)
+    (let [[old-scope old-inner] (get@ #context state)
+          new-scope (format old-scope "c___" (%i (.int old-inner)))]
+      (case (expr (set@ #context [new-scope +0] state))
+        (#error.Success [state' output])
+        (#error.Success [(set@ #context [old-scope (inc old-inner)] state')
+                         [new-scope output]])
+
+        (#error.Error error)
+        (#error.Error error)))))
+
+(def: #export context
+  (All [anchor code] (Operation (..State anchor code) Text))
+  (function (_ state)
+    (#error.Success [state
+                     (|> state
+                         (get@ #context)
+                         (get@ #scope-name))])))
+
+(do-template [
+                
+                ]
+  [(def: #export 
+     (All [anchor code output] )
+     (function (_ body)
+       (function (_ state)
+         (case (body (set@  (#.Some ) state))
+           (#error.Success [state' output])
+           (#error.Success [(set@  (get@  state) state')
+                            output])
+
+           (#error.Error error)
+           (#error.Error error)))))
+
+   (def: #export 
+     (All [anchor code] (Operation (..State anchor code) ))
+     (function (_ state)
+       (case (get@  state)
+         (#.Some output)
+         (#error.Success [state output])
+
+         #.None
+         (ex.throw  []))))]
+
+  [#anchor
+   (with-anchor anchor)
+   (-> anchor (Operation (..State anchor code) output)
+       (Operation (..State anchor code) output))
+   anchor
+   anchor anchor no-anchor]
+
+  [#buffer
+   with-buffer
+   (-> (Operation (..State anchor code) output)
+       (Operation (..State anchor code) output))
+   row.empty
+   buffer (Buffer code) no-active-buffer]
+  )
+
+(def: #export artifacts
+  (All [anchor code]
+    (Operation (..State anchor code) (Artifacts code)))
+  (function (_ state)
+    (#error.Success [state (get@ #artifacts state)])))
+
+(do-template []
+  [(def: #export ( code)
+     (All [anchor code]
+       (-> code (Operation (..State anchor code) Any)))
+     (function (_ state)
+       (case (:: (get@ #host state)  code)
+         (#error.Error error)
+         (ex.throw cannot-interpret error)
+         
+         (#error.Success output)
+         (#error.Success [state output]))))]
+
+  [execute!]
+  [evaluate!]
+  )
+
+(def: #export (save! name code)
+  (All [anchor code]
+    (-> Ident code (Operation (..State anchor code) Any)))
+  (do //.Monad
+    [_ (execute! code)]
+    (function (_ state)
+      (#error.Success [(update@ #buffer
+                                (maybe/map (row.add [name code]))
+                                state)
+                       []]))))
+
+(def: #export (save-buffer! target)
+  (All [anchor code]
+    (-> File (Operation (..State anchor code) Any)))
+  (do //.Monad
+    [buffer ..buffer]
+    (function (_ state)
+      (#error.Success [(update@ #artifacts (dict.put target buffer) state)
+                       []]))))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux
new file mode 100644
index 000000000..39b5bdae1
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/case.jvm.lux
@@ -0,0 +1,170 @@
+(.module:
+  [lux #- case let if]
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [number]
+             [text]
+             text/format
+             (collection [list "list/" Functor Fold]
+                         [set #+ Set])))
+  (///// [reference #+ Register]
+         (host ["_" scheme #+ Expression Computation Var])
+         [compiler #+ "operation/" Monad]
+         (compiler [synthesis #+ Synthesis Path]))
+  [//runtime #+ Operation Translator]
+  [//reference])
+
+(def: #export (let translate [valueS register bodyS])
+  (-> Translator [Synthesis Register Synthesis]
+      (Operation Computation))
+  (do compiler.Monad
+    [valueO (translate valueS)
+     bodyO (translate bodyS)]
+    (wrap (_.let (list [(//reference.local' register) valueO])
+            bodyO))))
+
+(def: #export (record-get translate valueS pathP)
+  (-> Translator Synthesis (List [Nat Bool])
+      (Operation Expression))
+  (do compiler.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])
+  (-> Translator [Synthesis Synthesis Synthesis]
+      (Operation Computation))
+  (do compiler.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)
+  (-> Translator 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/bool _.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 compiler.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))))])
+    
+    _
+    (compiler.throw unrecognized-path [])))
+
+(def: (pattern-matching translate pathP)
+  (-> Translator Path (Operation Computation))
+  (do compiler.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])
+  (-> Translator [Synthesis Path] (Operation Computation))
+  (do compiler.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
new file mode 100644
index 000000000..a654fe4d0
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/expression.jvm.lux
@@ -0,0 +1,54 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]))
+  (///// [compiler]
+         (compiler [synthesis]
+                   [extension]))
+  [//runtime #+ Translator]
+  [//primitive]
+  [//structure]
+  [//reference]
+  [//function]
+  [//case]
+  [//loop])
+
+(def: #export (translate synthesis)
+  Translator
+  (case synthesis
+    (^template [ ]
+      (^ ( value))
+      ( value))
+    ([synthesis.bool //primitive.bool]
+     [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)))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux
new file mode 100644
index 000000000..9fa0abc55
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/extension.jvm.lux
@@ -0,0 +1,32 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [maybe]
+             text/format
+             (collection ["dict" dictionary #+ Dictionary])))
+  (///// [reference #+ Register Variable]
+         (host ["_" scheme #+ Computation])
+         [compiler "operation/" Monad]
+         (compiler [synthesis #+ Synthesis]))
+  [//runtime #+ Operation Translator]
+  [/common]
+  ## [/host]
+  )
+
+(exception: #export (unknown-extension {message Text})
+  message)
+
+(def: extensions
+  /common.Bundle
+  (|> /common.extensions
+      ## (dict.merge /host.extensions)
+      ))
+
+(def: #export (extension translate name args)
+  (-> Translator Text (List Synthesis)
+      (Operation Computation))
+  (<| (maybe.default (compiler.throw unknown-extension (%t name)))
+      (do maybe.Monad
+        [ext (dict.get name extensions)]
+        (wrap (ext translate args)))))
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
new file mode 100644
index 000000000..11743b076
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/extension/common.jvm.lux
@@ -0,0 +1,376 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [product]
+             [text]
+             text/format
+             [number #+ hex]
+             (collection [list "list/" Functor]
+                         ["dict" dictionary #+ Dictionary]))
+       [macro #+ with-gensyms]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host])
+  (////// (host ["_" scheme #+ Expression Computation])
+          [compiler]
+          (compiler [synthesis #+ Synthesis]))
+  [///runtime #+ Operation Translator])
+
+## [Types]
+(type: #export Extension
+  (-> Translator (List Synthesis) (Operation Computation)))
+
+(type: #export Bundle
+  (Dictionary Text Extension))
+
+(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]
+(def: #export (install name unnamed)
+  (-> Text (-> Text Extension)
+      (-> Bundle Bundle))
+  (dict.put name (unnamed name)))
+
+(def: #export (prefix prefix bundle)
+  (-> Text Bundle Bundle)
+  (|> bundle
+      dict.entries
+      (list/map (function (_ [key val]) [(format prefix " " key) val]))
+      (dict.from-list text.Hash)))
+
+(exception: #export (wrong-arity {extension Text} {expected Nat} {actual Nat})
+  (ex.report ["Extension" (%t extension)]
+             ["Expected" (|> expected .int %i)]
+             ["Actual" (|> actual .int %i)]))
+
+(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)
+                           (-> Text ..Extension))
+                       (function ((~ g!_) (~ g!name))
+                         (function ((~ g!_) (~ g!translate) (~ g!inputs))
+                           (case (~ g!inputs)
+                             (^ (list (~+ g!input+)))
+                             (do compiler.Monad
+                               [(~+ (|> g!input+
+                                        (list/map (function (_ g!input)
+                                                    (list g!input (` ((~ g!translate) (~ g!input))))))
+                                        list.concat))]
+                               ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
+
+                             (~' _)
+                             (compiler.throw wrong-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 (-> Text Extension))
+  (function (_ extension-name)
+    (function (_ translate inputsS)
+      (do compiler.Monad
+        [inputsI (monad.map @ translate inputsS)]
+        (wrap (extension inputsI))))))
+
+## [Extensions]
+## [[Lux]]
+(def: extensions/lux
+  Bundle
+  (|> (dict.new text.Hash)
+      (install "is?" (binary (product.uncurry _.eq?/2)))
+      (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: extensions/bit
+  Bundle
+  (<| (prefix "bit")
+      (|> (dict.new text.Hash)
+          (install "and" (binary bit//and))
+          (install "or" (binary bit//or))
+          (install "xor" (binary bit//xor))
+          (install "left-shift" (binary bit//left-shift))
+          (install "logical-right-shift" (binary bit//logical-right-shift))
+          (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
+          )))
+
+## [[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: extensions/array
+  Bundle
+  (<| (prefix "array")
+      (|> (dict.new text.Hash)
+          (install "new" (unary array//new))
+          (install "get" (binary array//get))
+          (install "put" (trinary array//put))
+          (install "remove" (binary array//remove))
+          (install "size" (unary _.vector-length/1))
+          )))
+
+## [[Numbers]]
+(host.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: extensions/int
+  Bundle
+  (<| (prefix "int")
+      (|> (dict.new text.Hash)
+          (install "+" (binary int//+))
+          (install "-" (binary int//-))
+          (install "*" (binary int//*))
+          (install "/" (binary int///))
+          (install "%" (binary int//%))
+          (install "=" (binary int//=))
+          (install "<" (binary int//<))
+          (install "to-frac" (unary (|>> (_.//2 (_.float 1.0)))))
+          (install "char" (unary int//char)))))
+
+(def: extensions/frac
+  Bundle
+  (<| (prefix "frac")
+      (|> (dict.new text.Hash)
+          (install "+" (binary frac//+))
+          (install "-" (binary frac//-))
+          (install "*" (binary frac//*))
+          (install "/" (binary frac///))
+          (install "%" (binary frac//%))
+          (install "=" (binary frac//=))
+          (install "<" (binary frac//<))
+          (install "smallest" (nullary frac//smallest))
+          (install "min" (nullary frac//min))
+          (install "max" (nullary frac//max))
+          (install "to-int" (unary _.exact/1))
+          (install "encode" (unary _.number->string/1))
+          (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: extensions/text
+  Bundle
+  (<| (prefix "text")
+      (|> (dict.new text.Hash)
+          (install "=" (binary text//=))
+          (install "<" (binary text//<))
+          (install "concat" (binary (product.uncurry _.string-append/2)))
+          (install "size" (unary _.string-length/1))
+          (install "char" (binary text//char))
+          (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: extensions/math
+  Bundle
+  (<| (prefix "math")
+      (|> (dict.new text.Hash)
+          (install "cos" (unary (math-func "cos")))
+          (install "sin" (unary (math-func "sin")))
+          (install "tan" (unary (math-func "tan")))
+          (install "acos" (unary (math-func "acos")))
+          (install "asin" (unary (math-func "asin")))
+          (install "atan" (unary (math-func "atan")))
+          (install "exp" (unary (math-func "exp")))
+          (install "log" (unary (math-func "log")))
+          (install "ceil" (unary (math-func "ceiling")))
+          (install "floor" (unary (math-func "floor")))
+          (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: extensions/io
+  Bundle
+  (<| (prefix "io")
+      (|> (dict.new text.Hash)
+          (install "log" (unary (|>> io//log ..void)))
+          (install "error" (unary _.raise/1))
+          (install "exit" (unary _.exit/1))
+          (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: extensions/atom
+  Bundle
+  (<| (prefix "atom")
+      (|> (dict.new text.Hash)
+          (install "new" (unary atom//new))
+          (install "read" (unary atom//read))
+          (install "compare-and-swap" (trinary atom//compare-and-swap)))))
+
+## [[Box]]
+(def: (box//write [valueO boxO])
+  Binary
+  (///runtime.box//write valueO boxO))
+
+(def: extensions/box
+  Bundle
+  (<| (prefix "box")
+      (|> (dict.new text.Hash)
+          (install "new" (unary atom//new))
+          (install "read" (unary atom//read))
+          (install "write" (binary box//write)))))
+
+## [[Processes]]
+(def: (process//parallelism-level [])
+  Nullary
+  (_.int 1))
+
+(def: extensions/process
+  Bundle
+  (<| (prefix "process")
+      (|> (dict.new text.Hash)
+          (install "parallelism-level" (nullary process//parallelism-level))
+          (install "schedule" (binary (product.uncurry ///runtime.process//schedule)))
+          )))
+
+## [Bundles]
+(def: #export extensions
+  Bundle
+  (<| (prefix "lux")
+      (|> extensions/lux
+          (dict.merge extensions/bit)
+          (dict.merge extensions/int)
+          (dict.merge extensions/frac)
+          (dict.merge extensions/text)
+          (dict.merge extensions/array)
+          (dict.merge extensions/math)
+          (dict.merge extensions/io)
+          (dict.merge extensions/atom)
+          (dict.merge extensions/box)
+          (dict.merge extensions/process)
+          )))
diff --git a/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux b/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux
new file mode 100644
index 000000000..1ac433ec4
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/function.jvm.lux
@@ -0,0 +1,85 @@
+(.module:
+  [lux #- function]
+  (lux (control [monad #+ do]
+                pipe)
+       (data [product]
+             text/format
+             (collection [list "list/" Functor])))
+  (///// [reference #+ Register Variable]
+         [name]
+         (host ["_" scheme #+ Expression Computation Var])
+         [compiler "operation/" Monad]
+         (compiler [analysis #+ Variant Tuple Environment Arity Abstraction Application Analysis]
+                   [synthesis #+ Synthesis]))
+  [///]
+  [//runtime #+ Operation Translator]
+  [//primitive]
+  [//reference])
+
+(def: #export (apply translate [functionS argsS+])
+  (-> Translator (Application Synthesis) (Operation Computation))
+  (do compiler.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])
+  (-> Translator (Abstraction Synthesis) (Operation Computation))
+  (do compiler.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
new file mode 100644
index 000000000..f77f7cf10
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/loop.jvm.lux
@@ -0,0 +1,36 @@
+(.module:
+  [lux #- Scope]
+  (lux (control [monad #+ do])
+       (data [product]
+             [text]
+             text/format
+             (collection [list "list/" Functor]))
+       [macro])
+  (///// (host ["_" scheme #+ Computation Var])
+         [compiler]
+         (compiler [synthesis #+ Scope Synthesis]))
+  [///]
+  [//runtime #+ Operation Translator]
+  [//reference])
+
+(def: @scope (_.var "scope"))
+
+(def: #export (scope translate [start initsS+ bodyS])
+  (-> Translator (Scope Synthesis) (Operation Computation))
+  (do compiler.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+)
+  (-> Translator (List Synthesis) (Operation Computation))
+  (do compiler.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
new file mode 100644
index 000000000..e78df5b74
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/primitive.jvm.lux
@@ -0,0 +1,22 @@
+(.module:
+  [lux #- i64]
+  [/// #+ State]
+  (///// [compiler #+ "operation/" Monad]
+         (host ["_" scheme #+ Expression]))
+  [//runtime #+ Operation])
+
+(def: #export bool
+  (-> Bool (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
new file mode 100644
index 000000000..e1cb6a642
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/reference.jvm.lux
@@ -0,0 +1,54 @@
+(.module:
+  lux
+  (lux (control pipe)
+       (data text/format))
+  (///// [reference #+ Register Variable Reference]
+         [name]
+         (host ["_" scheme #+ Expression Var])
+         [compiler "operation/" Monad]
+         (compiler [analysis #+ Variant Tuple]
+                   [synthesis #+ Synthesis]))
+  [//runtime #+ Operation Translator]
+  [//primitive])
+
+(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
new file mode 100644
index 000000000..89707cdc4
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/runtime.jvm.lux
@@ -0,0 +1,362 @@
+(.module:
+  lux
+  (lux (control ["p" parser "p/" Monad]
+                [monad #+ do])
+       (data [number #+ hex]
+             text/format
+             (collection [list "list/" Monad]))
+       [function]
+       (macro [code]
+              ["s" syntax #+ syntax:]))
+  [/// #+ State]
+  (///// [name]
+         (host ["_" scheme #+ Expression Computation Var])
+         [compiler]
+         (compiler [analysis #+ Variant]
+                   [synthesis])))
+
+(type: #export Operation
+  (compiler.Operation (State Var Expression)))
+
+(type: #export Translator
+  (///.Translator Var Expression))
+
+(def: prefix Text "LuxRuntime")
+
+(def: unit (_.string synthesis.unit))
+
+(def: #export variant-tag "lux-variant")
+
+(def: (flag value)
+  (-> Bool 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 false ..unit]))
+
+(def: #export some
+  (-> Expression Computation)
+  (|>> [+0 true] ..variant))
+
+(def: #export left
+  (-> Expression Computation)
+  (|>> [+0 false] ..variant))
+
+(def: #export right
+  (-> Expression Computation)
+  (|>> [+0 true] ..variant))
+
+(def: declaration
+  (s.Syntax [Text (List Text)])
+  (p.either (p.seq s.local-symbol (p/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 true)))
+        (_.bool false)))))
+
+(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 compiler.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
new file mode 100644
index 000000000..c3b93e7a1
--- /dev/null
+++ b/stdlib/source/lux/language/compiler/translation/scheme/structure.jvm.lux
@@ -0,0 +1,29 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]))
+  (///// (host ["_" scheme #+ Expression])
+         [compiler]
+         (compiler [analysis #+ Variant Tuple]
+                   [synthesis #+ Synthesis]))
+  [//runtime #+ Operation Translator]
+  [//primitive])
+
+(def: #export (tuple translate elemsS+)
+  (-> Translator (Tuple Synthesis) (Operation Expression))
+  (case elemsS+
+    #.Nil
+    (//primitive.text synthesis.unit)
+
+    (#.Cons singletonS #.Nil)
+    (translate singletonS)
+
+    _
+    (do compiler.Monad
+      [elemsT+ (monad.map @ translate elemsS+)]
+      (wrap (_.vector/* elemsT+)))))
+
+(def: #export (variant translate [lefts right? valueS])
+  (-> Translator (Variant Synthesis) (Operation Expression))
+  (do compiler.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
new file mode 100644
index 000000000..218de67a4
--- /dev/null
+++ b/stdlib/source/lux/language/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/language/host/scheme.lux b/stdlib/source/lux/language/host/scheme.lux
new file mode 100644
index 000000000..93d1b2017
--- /dev/null
+++ b/stdlib/source/lux/language/host/scheme.lux
@@ -0,0 +1,302 @@
+(.module:
+  [lux #- Code' Code int or and if function cond when let]
+  (lux (control pipe)
+       (data [text]
+             text/format
+             [number]
+             (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
+    (-> Bool Computation)
+    (|>> (case> true "#t"
+                false "#f")
+         :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/module.lux b/stdlib/source/lux/language/module.lux
new file mode 100644
index 000000000..dbb1cc0ea
--- /dev/null
+++ b/stdlib/source/lux/language/module.lux
@@ -0,0 +1,240 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                pipe)
+       (data [text "text/" Equivalence]
+             text/format
+             ["e" error]
+             (collection [list "list/" Fold Functor]
+                         (dictionary [plist])))
+       [macro])
+  [//compiler]
+  (//compiler [analysis]))
+
+(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 (Meta Any))
+  (do macro.Monad
+    [self-name macro.current-module-name
+     self macro.current-module]
+    (case (get@ #.module-annotations self)
+      #.None
+      (function (_ compiler)
+        (#e.Success [(update@ #.modules
+                              (plist.put self-name (set@ #.module-annotations (#.Some annotations) self))
+                              compiler)
+                     []]))
+      
+      (#.Some old)
+      (//compiler.throw cannot-set-module-annotations-more-than-once [self-name old annotations]))))
+
+(def: #export (import module)
+  (-> Text (Meta Any))
+  (do macro.Monad
+    [self-name macro.current-module-name]
+    (function (_ compiler)
+      (#e.Success [(update@ #.modules
+                            (plist.update self-name (update@ #.imports (|>> (#.Cons module))))
+                            compiler)
+                   []]))))
+
+(def: #export (alias alias module)
+  (-> Text Text (Meta Any))
+  (do macro.Monad
+    [self-name macro.current-module-name]
+    (function (_ compiler)
+      (#e.Success [(update@ #.modules
+                            (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
+                                                                                 (|>> (#.Cons [alias module])))))
+                            compiler)
+                   []]))))
+
+(def: #export (exists? module)
+  (-> Text (Meta Bool))
+  (function (_ compiler)
+    (|> compiler
+        (get@ #.modules)
+        (plist.get module)
+        (case> (#.Some _) true #.None false)
+        [compiler] #e.Success)))
+
+(def: #export (define name definition)
+  (-> Text Definition (Meta []))
+  (do macro.Monad
+    [self-name macro.current-module-name
+     self macro.current-module]
+    (function (_ compiler)
+      (case (plist.get name (get@ #.definitions self))
+        #.None
+        (#e.Success [(update@ #.modules
+                              (plist.put self-name
+                                         (update@ #.definitions
+                                                  (: (-> (List [Text Definition]) (List [Text Definition]))
+                                                     (|>> (#.Cons [name definition])))
+                                                  self))
+                              compiler)
+                     []])
+
+        (#.Some already-existing)
+        ((//compiler.throw cannot-define-more-than-once [self-name name]) compiler)))))
+
+(def: #export (create hash name)
+  (-> Nat Text (Meta []))
+  (function (_ compiler)
+    (let [module (new hash)]
+      (#e.Success [(update@ #.modules
+                            (plist.put name module)
+                            compiler)
+                   []]))))
+
+(def: #export (with-module hash name action)
+  (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
+  (do macro.Monad
+    [_ (create hash name)
+     output (analysis.with-current-module name
+              action)
+     module (macro.find-module name)]
+    (wrap [module output])))
+
+(do-template [  ]
+  [(def: #export ( module-name)
+     (-> Text (Meta Any))
+     (function (_ compiler)
+       (case (|> compiler (get@ #.modules) (plist.get module-name))
+         (#.Some module)
+         (let [active? (case (get@ #.module-state module)
+                         #.Active true
+                         _     false)]
+           (if active?
+             (#e.Success [(update@ #.modules
+                                   (plist.put module-name (set@ #.module-state  module))
+                                   compiler)
+                          []])
+             ((//compiler.throw can-only-change-state-of-active-module [module-name ])
+              compiler)))
+
+         #.None
+         ((//compiler.throw unknown-module module-name) compiler))))
+   
+   (def: #export ( module-name)
+     (-> Text (Meta Bool))
+     (function (_ compiler)
+       (case (|> compiler (get@ #.modules) (plist.get module-name))
+         (#.Some module)
+         (#e.Success [compiler
+                      (case (get@ #.module-state module)
+                         true
+                        _     false)])
+
+         #.None
+         ((//compiler.throw unknown-module module-name) compiler))))]
+
+  [set-active   active?   #.Active]
+  [set-compiled compiled? #.Compiled]
+  [set-cached   cached?   #.Cached]
+  )
+
+(do-template [  ]
+  [(def: ( module-name)
+     (-> Text (Meta ))
+     (function (_ compiler)
+       (case (|> compiler (get@ #.modules) (plist.get module-name))
+         (#.Some module)
+         (#e.Success [compiler (get@  module)])
+
+         #.None
+         ((//compiler.throw unknown-module module-name) compiler))))]
+
+  [tags  #.tags        (List [Text [Nat (List Ident) Bool Type]])]
+  [types #.types       (List [Text [(List Ident) Bool Type]])]
+  [hash  #.module-hash Nat]
+  )
+
+(def: (ensure-undeclared-tags module-name tags)
+  (-> Text (List Tag) (Meta Any))
+  (do macro.Monad
+    [bindings (..tags module-name)
+     _ (monad.map @
+                  (function (_ tag)
+                    (case (plist.get tag bindings)
+                      #.None
+                      (wrap [])
+
+                      (#.Some _)
+                      (//compiler.throw cannot-declare-tag-twice [module-name tag])))
+                  tags)]
+    (wrap [])))
+
+(def: #export (declare-tags tags exported? type)
+  (-> (List Tag) Bool Type (Meta Any))
+  (do macro.Monad
+    [self-name macro.current-module-name
+     [type-module type-name] (case type
+                               (#.Named type-ident _)
+                               (wrap type-ident)
+
+                               _
+                               (//compiler.throw cannot-declare-tags-for-unnamed-type [tags type]))
+     _ (ensure-undeclared-tags self-name tags)
+     _ (//compiler.assert cannot-declare-tags-for-foreign-type [tags type]
+                          (text/= self-name type-module))]
+    (function (_ compiler)
+      (case (|> compiler (get@ #.modules) (plist.get self-name))
+        (#.Some module)
+        (let [namespaced-tags (list/map (|>> [self-name]) tags)]
+          (#e.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]))))
+                                compiler)
+                       []]))
+        #.None
+        ((//compiler.throw unknown-module self-name) compiler)))))
diff --git a/stdlib/source/lux/language/name.lux b/stdlib/source/lux/language/name.lux
new file mode 100644
index 000000000..1053eb76f
--- /dev/null
+++ b/stdlib/source/lux/language/name.lux
@@ -0,0 +1,47 @@
+(.module:
+  lux
+  (lux (data [maybe]
+             [text]
+             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
new file mode 100644
index 000000000..43c8f0d48
--- /dev/null
+++ b/stdlib/source/lux/language/reference.lux
@@ -0,0 +1,66 @@
+(.module:
+  lux
+  (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])
+
+      _
+      false)))
+
+(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 Bool)
+  (|>> ..variable
+       (case> (^ (..local +0))
+              true
+
+              _
+              false)))
diff --git a/stdlib/source/lux/language/scope.lux b/stdlib/source/lux/language/scope.lux
new file mode 100644
index 000000000..9cb1de1c2
--- /dev/null
+++ b/stdlib/source/lux/language/scope.lux
@@ -0,0 +1,188 @@
+(.module:
+  lux
+  (lux (control monad)
+       (data [text "text/" Equivalence]
+             text/format
+             [maybe "maybe/" Monad]
+             [product]
+             ["e" error]
+             (collection [list "list/" Functor Fold Monoid]
+                         (dictionary [plist])))
+       [macro])
+  [//reference #+ Register Variable])
+
+(type: Locals (Bindings Text [Type Register]))
+(type: Foreign (Bindings Text [Type Variable]))
+
+(def: (is-local? name scope)
+  (-> Text Scope Bool)
+  (|> scope
+      (get@ [#.locals #.mappings])
+      (plist.contains? name)))
+
+(def: (get-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: (is-captured? name scope)
+  (-> Text Scope Bool)
+  (|> scope
+      (get@ [#.captured #.mappings])
+      (plist.contains? name)))
+
+(def: (get-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: (is-ref? name scope)
+  (-> Text Scope Bool)
+  (or (is-local? name scope)
+      (is-captured? name scope)))
+
+(def: (get-ref name scope)
+  (-> Text Scope (Maybe [Type Variable]))
+  (case (get-local name scope)
+    (#.Some type)
+    (#.Some type)
+
+    _
+    (get-captured name scope)))
+
+(def: #export (find name)
+  (-> Text (Meta (Maybe [Type Variable])))
+  (function (_ compiler)
+    (let [[inner outer] (|> compiler
+                            (get@ #.scopes)
+                            (list.split-with (|>> (is-ref? name) not)))]
+      (case outer
+        #.Nil
+        (#.Right [compiler #.None])
+
+        (#.Cons top-outer _)
+        (let [[ref-type init-ref] (maybe.default (undefined)
+                                                 (get-ref 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 compiler)
+                    (#.Some [ref-type ref])]))
+        ))))
+
+(def: #export (with-local [name type] action)
+  (All [a] (-> [Text Type] (Meta a) (Meta a)))
+  (function (_ compiler)
+    (case (get@ #.scopes compiler)
+      (#.Cons head tail)
+      (let [old-mappings (get@ [#.locals #.mappings] head)
+            new-var-id (get@ [#.locals #.counter] head)
+            new-head (update@ #.locals
+                              (: (-> Locals Locals)
+                                 (|>> (update@ #.counter inc)
+                                      (update@ #.mappings (plist.put name [type new-var-id]))))
+                              head)]
+        (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler)
+                          action)
+          (#e.Success [compiler' output])
+          (case (get@ #.scopes compiler')
+            (#.Cons head' tail')
+            (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
+                                  tail')]
+              (#e.Success [(set@ #.scopes scopes' compiler')
+                           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 (Meta a) (Meta a)))
+  (function (_ compiler)
+    (let [parent-name (case (get@ #.scopes compiler)
+                        #.Nil
+                        (list)
+                        
+                        (#.Cons top _)
+                        (get@ #.name top))]
+      (case (action (update@ #.scopes
+                             (|>> (#.Cons (scope parent-name name)))
+                             compiler))
+        (#e.Error error)
+        (#e.Error error)
+
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.scopes
+                              (|>> list.tail (maybe.default (list)))
+                              compiler')
+                     output])
+        ))
+    ))
+
+(def: #export next-local
+  (Meta Register)
+  (function (_ compiler)
+    (case (get@ #.scopes compiler)
+      #.Nil
+      (#e.Error "Cannot get next reference when there is no scope.")
+      
+      (#.Cons top _)
+      (#e.Success [compiler (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/syntax.lux b/stdlib/source/lux/language/syntax.lux
new file mode 100644
index 000000000..b9214ca11
--- /dev/null
+++ b/stdlib/source/lux/language/syntax.lux
@@ -0,0 +1,626 @@
+## 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]
+  (lux (control monad
+                ["p" parser "p/" Monad]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [number]
+             [product]
+             [maybe]
+             [text]
+             (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 "_") (p/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? false]
+                             (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)))
+                                                    false)
+                                             (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))))
+                                                      false))
+                                             ## Must handle escaped
+                                             ## chars separately.
+                                             (do @
+                                               [[chars-consumed char] escaped-char^]
+                                               (recur (format text-read char)
+                                                      (|> where
+                                                          (update@ #.column (n/+ chars-consumed)))
+                                                      false))
+                                             ## 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))
+                                                true)))))]
+    (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 [ ]
+                      ["" ]
+                      (#.Bool ))
+                    (["true"  true]
+                     ["false" false])
+                    
+                    _
+                    (#.Symbol value))]])))
+
+(exception: #export (end-of-file {module Text})
+  module)
+
+(exception: #export (unrecognized-input {[file line column] Cursor})
+  (format "  File: " file "\n"
+          "  Line: " (%n line) "\n"
+          "Column: " (%n column) "\n"))
+
+(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/language/type.lux b/stdlib/source/lux/language/type.lux
new file mode 100644
index 000000000..b7e04afa4
--- /dev/null
+++ b/stdlib/source/lux/language/type.lux
@@ -0,0 +1,389 @@
+(.module: {#.doc "Basic functionality for working with types."}
+  [lux #- function]
+  (lux (control [equivalence #+ Equivalence]
+                [monad #+ do Monad]
+                ["p" parser])
+       (data [text "text/" Monoid Equivalence]
+             [ident "ident/" Equivalence Codec]
+             [number "nat/" Codec]
+             [maybe]
+             (collection [list #+ "list/" Functor Monoid Fold]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ Syntax syntax:])
+       ))
+
+## [Utils]
+(def: (beta-reduce env type)
+  (-> (List Type) Type Type)
+  (case type
+    (#.Primitive name params)
+    (#.Primitive name (list/map (beta-reduce env) params))
+    
+    (^template []
+      ( left right)
+      ( (beta-reduce env left) (beta-reduce env right)))
+    ([#.Sum]      [#.Product]
+     [#.Function] [#.Apply])
+    
+    (^template []
+      ( old-env def)
+      (case old-env
+        #.Nil
+        ( env def)
+
+        _
+        ( (list/map (beta-reduce env) old-env) def)))
+    ([#.UnivQ]
+     [#.ExQ])
+    
+    (#.Parameter idx)
+    (maybe.default (error! (text/compose "Unknown type var: " (nat/encode idx)))
+                   (list.nth idx env))
+    
+    _
+    type
+    ))
+
+## [Structures]
+(structure: #export _ (Equivalence Type)
+  (def: (= x y)
+    (case [x y]
+      [(#.Primitive xname xparams) (#.Primitive yname yparams)]
+      (and (text/= xname yname)
+           (n/= (list.size yparams) (list.size xparams))
+           (list/fold (.function (_ [x y] prev) (and prev (= x y)))
+                      true
+                      (list.zip2 xparams yparams)))
+
+      (^template []
+        [( xid) ( yid)]
+        (n/= yid xid))
+      ([#.Var] [#.Ex] [#.Parameter])
+
+      (^or [(#.Function xleft xright) (#.Function yleft yright)]
+           [(#.Apply xleft xright) (#.Apply yleft yright)])
+      (and (= xleft yleft)
+           (= xright yright))
+
+      [(#.Named xname xtype) (#.Named yname ytype)]
+      (and (ident/= xname yname)
+           (= xtype ytype))
+
+      (^template []
+        [( xL xR) ( yL yR)]
+        (and (= xL yL) (= xR yR)))
+      ([#.Sum] [#.Product])
+      
+      (^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)]
+           [(#.ExQ xenv xbody) (#.ExQ yenv ybody)])
+      (and (n/= (list.size yenv) (list.size xenv))
+           (= xbody ybody)
+           (list/fold (.function (_ [x y] prev) (and prev (= x y)))
+                      true
+                      (list.zip2 xenv yenv)))
+
+      _
+      false
+      )))
+
+## [Values]
+(do-template [ ]
+  [(def: #export ( type)
+     (-> Type [Nat Type])
+     (loop [num-args +0
+            type type]
+       (case type
+         ( env sub-type)
+         (recur (inc num-args) sub-type)
+
+         _
+         [num-args type])))]
+
+  [flatten-univ-q #.UnivQ]
+  [flatten-ex-q   #.ExQ]
+  )
+
+(def: #export (flatten-function type)
+  (-> Type [(List Type) Type])
+  (case type
+    (#.Function in out')
+    (let [[ins out] (flatten-function out')]
+      [(list& in ins) out])
+
+    _
+    [(list) type]))
+
+(def: #export (flatten-application type)
+  (-> Type [Type (List Type)])
+  (case type
+    (#.Apply arg func')
+    (let [[func args] (flatten-application func')]
+      [func (list/compose args (list arg))])
+
+    _
+    [type (list)]))
+
+(do-template [ ]
+  [(def: #export ( type)
+     (-> Type (List Type))
+     (case type
+       ( left right)
+       (list& left ( right))
+
+       _
+       (list type)))]
+
+  [flatten-variant #.Sum]
+  [flatten-tuple   #.Product]
+  )
+
+(def: #export (apply params func)
+  (-> (List Type) Type (Maybe Type))
+  (case params
+    #.Nil
+    (#.Some func)
+
+    (#.Cons param params')
+    (case func
+      (^template []
+        ( env body)
+        (|> body
+            (beta-reduce (list& func param env))
+            (apply params')))
+      ([#.UnivQ] [#.ExQ])
+
+      (#.Apply A F)
+      (apply (list& A params) F)
+
+      (#.Named name unnamed)
+      (apply params unnamed)
+      
+      _
+      #.None)))
+
+(def: #export (to-code type)
+  (-> Type Code)
+  (case type
+    (#.Primitive name params)
+    (` (#.Primitive (~ (code.text name))
+                    (.list (~+ (list/map to-code params)))))
+
+    (^template []
+      ( idx)
+      (` ( (~ (code.nat idx)))))
+    ([#.Var] [#.Ex] [#.Parameter])
+
+    (^template []
+      ( left right)
+      (` ( (~ (to-code left))
+                (~ (to-code right)))))
+    ([#.Sum] [#.Product] [#.Function] [#.Apply])
+
+    (#.Named name sub-type)
+    (code.symbol name)
+
+    (^template []
+      ( env body)
+      (` ( (.list (~+ (list/map to-code env)))
+                (~ (to-code body)))))
+    ([#.UnivQ] [#.ExQ])
+    ))
+
+(def: #export (to-text type)
+  (-> Type Text)
+  (case type
+    (#.Primitive name params)
+    (case params
+      #.Nil
+      ($_ text/compose "(primitive " name ")")
+
+      _
+      ($_ text/compose "(primitive " name " " (|> params (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")"))
+
+    (^template [   ]
+      ( _)
+      ($_ text/compose 
+          (|> ( type)
+              (list/map to-text)
+              list.reverse
+              (list.interpose " ")
+              (list/fold text/compose ""))
+          ))
+    ([#.Sum  "(| " ")" flatten-variant]
+     [#.Product "["   "]" flatten-tuple])
+
+    (#.Function input output)
+    (let [[ins out] (flatten-function type)]
+      ($_ text/compose  "(-> "
+          (|> ins
+              (list/map to-text)
+              list.reverse
+              (list.interpose " ")
+              (list/fold text/compose ""))
+          " " (to-text out) ")"))
+
+    (#.Parameter idx)
+    (nat/encode idx)
+
+    (#.Var id)
+    ($_ text/compose "⌈v:" (nat/encode id) "⌋")
+
+    (#.Ex id)
+    ($_ text/compose "⟨e:" (nat/encode id) "⟩")
+
+    (#.Apply param fun)
+    (let [[type-func type-args] (flatten-application type)]
+      ($_ text/compose  "(" (to-text type-func) " " (|> type-args (list/map to-text) list.reverse (list.interpose " ") (list/fold text/compose "")) ")"))
+
+    (^template [ ]
+      ( env body)
+      ($_ text/compose "("  " {" (|> env (list/map to-text) (text.join-with " ")) "} " (to-text body) ")"))
+    ([#.UnivQ "All"]
+     [#.ExQ "Ex"])
+
+    (#.Named [module name] type)
+    ($_ text/compose module "." name)
+    ))
+
+(def: #export (un-alias type)
+  (-> Type Type)
+  (case type
+    (#.Named _ (#.Named ident type'))
+    (un-alias (#.Named ident type'))
+
+    _
+    type))
+
+(def: #export (un-name type)
+  (-> Type Type)
+  (case type
+    (#.Named ident type')
+    (un-name type')
+
+    _
+    type))
+
+(do-template [  ]
+  [(def: #export ( types)
+     (-> (List Type) Type)
+     (case types
+       #.Nil
+       
+
+       (#.Cons type #.Nil)
+       type
+
+       (#.Cons type types')
+       ( type ( types'))))]
+
+  [variant Nothing #.Sum]
+  [tuple   Any     #.Product]
+  )
+
+(def: #export (function inputs output)
+  (-> (List Type) Type Type)
+  (case inputs
+    #.Nil
+    output
+
+    (#.Cons input inputs')
+    (#.Function input (function inputs' output))))
+
+(def: #export (application params quant)
+  (-> (List Type) Type Type)
+  (case params
+    #.Nil
+    quant
+
+    (#.Cons param params')
+    (application params' (#.Apply param quant))))
+
+(do-template [ ]
+  [(def: #export ( size body)
+     (-> Nat Type Type)
+     (case size
+       +0 body
+       _  (|> body ( (dec size)) ( (list)))))]
+
+  [univ-q #.UnivQ]
+  [ex-q   #.ExQ]
+  )
+
+(def: #export (quantified? type)
+  (-> Type Bool)
+  (case type
+    (#.Named [module name] _type)
+    (quantified? _type)
+
+    (#.Apply A F)
+    (maybe.default false
+                   (do maybe.Monad
+                     [applied (apply (list A) F)]
+                     (wrap (quantified? applied))))
+    
+    (^or (#.UnivQ _) (#.ExQ _))
+    true
+
+    _
+    false))
+
+(def: #export (array level elem-type)
+  (-> Nat Type Type)
+  (case level
+    +0 elem-type
+    _ (|> elem-type (array (dec level)) (list) (#.Primitive "#Array"))))
+
+(syntax: #export (:log! {input (p.alt s.symbol
+                                      s.any)})
+  (case input
+    (#.Left valueN)
+    (do @
+      [cursor macro.cursor
+       valueT (macro.find-type valueN)
+       #let [_ (log! ($_ text/compose
+                         ":log!" " @ " (.cursor-description cursor) "\n"
+                         (ident/encode valueN) " : " (..to-text valueT) "\n"))]]
+      (wrap (list (' []))))
+
+    (#.Right valueC)
+    (macro.with-gensyms [g!value]
+      (wrap (list (` (.let [(~ g!value) (~ valueC)]
+                       (..:log! (~ g!value)))))))))
+
+(def: type-parameters
+  (Syntax (List Text))
+  (s.tuple (p.some s.local-symbol)))
+
+(syntax: #export (:cast {type-vars type-parameters}
+                        input
+                        output
+                        {value (p.maybe s.any)})
+  (let [casterC (` (: (All [(~+ (list/map code.local-symbol type-vars))]
+                        (-> (~ input) (~ output)))
+                      (|>> :assume)))]
+    (case value
+      #.None
+      (wrap (list casterC))
+      
+      (#.Some value)
+      (wrap (list (` ((~ casterC) (~ value))))))))
+
+(type: Typed
+  {#type Code
+   #expression Code})
+
+(def: typed
+  (Syntax Typed)
+  (s.record (p.seq s.any s.any)))
+
+(syntax: #export (:share {type-vars type-parameters}
+                         {exemplar typed}
+                         {computation typed})
+  (macro.with-gensyms [g!_]
+    (let [shareC (` (: (All [(~+ (list/map code.local-symbol type-vars))]
+                         (-> (~ (get@ #type exemplar))
+                             (~ (get@ #type computation))))
+                       (.function ((~ g!_) (~ g!_))
+                         (:assume (~ (get@ #expression computation))))))]
+      (wrap (list (` ((~ shareC) (~ (get@ #expression exemplar)))))))))
diff --git a/stdlib/source/lux/language/type/check.lux b/stdlib/source/lux/language/type/check.lux
new file mode 100644
index 000000000..5fb8da617
--- /dev/null
+++ b/stdlib/source/lux/language/type/check.lux
@@ -0,0 +1,681 @@
+(.module: {#.doc "Type-checking functionality."}
+  lux
+  (lux (control [functor #+ Functor]
+                [apply #+ Apply]
+                [monad #+ do Monad]
+                ["ex" exception #+ exception:])
+       (data [text "text/" Monoid Equivalence]
+             [number "nat/" Codec]
+             [maybe]
+             [product]
+             (collection [list]
+                         [set #+ Set])
+             ["e" error])
+       (language [type "type/" Equivalence])
+       ))
+
+(exception: #export (unknown-type-var {id Nat})
+  (nat/encode id))
+
+(exception: #export (unbound-type-var {id Nat})
+  (nat/encode id))
+
+(exception: #export (invalid-type-application {funcT Type} {argT Type})
+  (type.to-text (#.Apply argT funcT)))
+
+(exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type})
+  (ex.report ["Var" (nat/encode id)]
+             ["Wanted Type" (type.to-text type)]
+             ["Current Type" (type.to-text bound)]))
+
+(exception: #export (type-check-failed {expected Type} {actual Type})
+  (ex.report ["Expected" (type.to-text expected)]
+             ["Actual" (type.to-text actual)]))
+
+(type: #export Var Nat)
+
+(type: #export Assumption
+  {#subsumption [Type Type]
+   #verdict Bool})
+
+(type: #export (Check a)
+  (-> Type-Context (e.Error [Type-Context a])))
+
+(type: #export Type-Vars
+  (List [Var (Maybe Type)]))
+
+(structure: #export _ (Functor Check)
+  (def: (map f fa)
+    (function (_ context)
+      (case (fa context)
+        (#e.Error error)
+        (#e.Error error)
+
+        (#e.Success [context' output])
+        (#e.Success [context' (f output)])
+        ))))
+
+(structure: #export _ (Apply Check)
+  (def: functor Functor)
+
+  (def: (apply ff fa)
+    (function (_ context)
+      (case (ff context)
+        (#e.Success [context' f])
+        (case (fa context')
+          (#e.Success [context'' a])
+          (#e.Success [context'' (f a)])
+
+          (#e.Error error)
+          (#e.Error error))
+
+        (#e.Error error)
+        (#e.Error error)
+        )))
+  )
+
+(structure: #export _ (Monad Check)
+  (def: functor Functor)
+
+  (def: (wrap x)
+    (function (_ context)
+      (#e.Success [context x])))
+
+  (def: (join ffa)
+    (function (_ context)
+      (case (ffa context)
+        (#e.Success [context' fa])
+        (case (fa context')
+          (#e.Success [context'' a])
+          (#e.Success [context'' a])
+
+          (#e.Error error)
+          (#e.Error error))
+
+        (#e.Error error)
+        (#e.Error error)
+        )))
+  )
+
+(open: "check/" Monad)
+
+(def: (var::get id plist)
+  (-> Var Type-Vars (Maybe (Maybe Type)))
+  (case plist
+    #.Nil
+    #.None
+
+    (#.Cons [var-id var-type]
+            plist')
+    (if (n/= id var-id)
+      (#.Some var-type)
+      (var::get id plist'))
+    ))
+
+(def: (var::new id plist)
+  (-> Var Type-Vars Type-Vars)
+  (#.Cons [id #.None] plist))
+
+(def: (var::put id value plist)
+  (-> Var (Maybe Type) Type-Vars Type-Vars)
+  (case plist
+    #.Nil
+    (list [id value])
+
+    (#.Cons [var-id var-type]
+            plist')
+    (if (n/= id var-id)
+      (#.Cons [var-id value]
+              plist')
+      (#.Cons [var-id var-type]
+              (var::put id value plist')))
+    ))
+
+(def: (var::remove id plist)
+  (-> Var Type-Vars Type-Vars)
+  (case plist
+    #.Nil
+    #.Nil
+
+    (#.Cons [var-id var-type]
+            plist')
+    (if (n/= id var-id)
+      plist'
+      (#.Cons [var-id var-type]
+              (var::remove id plist')))
+    ))
+
+## [[Logic]]
+(def: #export (run context proc)
+  (All [a] (-> Type-Context (Check a) (e.Error a)))
+  (case (proc context)
+    (#e.Error error)
+    (#e.Error error)
+
+    (#e.Success [context' output])
+    (#e.Success output)))
+
+(def: #export (throw exception message)
+  (All [e a] (-> (ex.Exception e) e (Check a)))
+  (function (_ context)
+    (ex.throw exception message)))
+
+(def: #export existential
+  {#.doc "A producer of existential types."}
+  (Check [Nat Type])
+  (function (_ context)
+    (let [id (get@ #.ex-counter context)]
+      (#e.Success [(update@ #.ex-counter inc context)
+                   [id (#.Ex id)]]))))
+
+(do-template [   ]
+  [(def: #export ( id)
+     (-> Var (Check ))
+     (function (_ context)
+       (case (|> context (get@ #.var-bindings) (var::get id))
+         (^or (#.Some (#.Some (#.Var _)))
+              (#.Some #.None))
+         (#e.Success [context ])
+         
+         (#.Some (#.Some bound))
+         (#e.Success [context ])
+
+         #.None
+         (ex.throw unknown-type-var id))))]
+
+  [bound? Bool false true]
+  [read (Maybe Type) #.None (#.Some bound)]
+  )
+
+(def: (peek id)
+  (-> Var (Check Type))
+  (function (_ context)
+    (case (|> context (get@ #.var-bindings) (var::get id))
+      (#.Some (#.Some bound))
+      (#e.Success [context bound])
+
+      (#.Some #.None)
+      (ex.throw unbound-type-var id)
+
+      #.None
+      (ex.throw unknown-type-var id))))
+
+(def: #export (write type id)
+  (-> Type Var (Check Any))
+  (function (_ context)
+    (case (|> context (get@ #.var-bindings) (var::get id))
+      (#.Some (#.Some bound))
+      (ex.throw cannot-rebind-var [id type bound])
+      
+      (#.Some #.None)
+      (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
+                   []])
+
+      #.None
+      (ex.throw unknown-type-var id))))
+
+(def: (update type id)
+  (-> Type Var (Check Any))
+  (function (_ context)
+    (case (|> context (get@ #.var-bindings) (var::get id))
+      (#.Some _)
+      (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context)
+                   []])
+      
+      #.None
+      (ex.throw unknown-type-var id))))
+
+(def: #export var
+  (Check [Var Type])
+  (function (_ context)
+    (let [id (get@ #.var-counter context)]
+      (#e.Success [(|> context
+                       (update@ #.var-counter inc)
+                       (update@ #.var-bindings (var::new id)))
+                   [id (#.Var id)]]))))
+
+(def: get-bindings
+  (Check (List [Var (Maybe Type)]))
+  (function (_ context)
+    (#e.Success [context
+                 (get@ #.var-bindings context)])))
+
+(def: (set-bindings value)
+  (-> (List [Var (Maybe Type)]) (Check Any))
+  (function (_ context)
+    (#e.Success [(set@ #.var-bindings value context)
+                 []])))
+
+(def: (apply-type! funcT argT)
+  (-> Type Type (Check Type))
+  (case funcT
+    (#.Var func-id)
+    (do Monad
+      [?funcT' (read func-id)]
+      (case ?funcT'
+        #.None
+        (throw invalid-type-application [funcT argT])
+
+        (#.Some funcT')
+        (apply-type! funcT' argT)))
+
+    _
+    (function (_ context)
+      (case (type.apply (list argT) funcT)
+        #.None
+        (ex.throw invalid-type-application [funcT argT])
+
+        (#.Some output)
+        (#e.Success [context output])))))
+
+(type: #export Ring (Set Var))
+
+(def: empty-ring Ring (set.new number.Hash))
+
+(def: #export (ring id)
+  (-> Var (Check Ring))
+  (function (_ context)
+    (loop [current id
+           output (set.add id empty-ring)]
+      (case (|> context (get@ #.var-bindings) (var::get current))
+        (#.Some (#.Some type))
+        (case type
+          (#.Var post)
+          (if (n/= id post)
+            (#e.Success [context output])
+            (recur post (set.add post output)))
+          
+          _
+          (#e.Success [context empty-ring]))
+
+        (#.Some #.None)
+        (#e.Success [context output])
+        
+        #.None
+        (ex.throw unknown-type-var current)))))
+
+(def: #export fresh-context
+  Type-Context
+  {#.var-counter +0
+   #.ex-counter +0
+   #.var-bindings (list)
+   })
+
+(def: (attempt op)
+  (All [a] (-> (Check a) (Check (Maybe a))))
+  (function (_ context)
+    (case (op context)
+      (#e.Success [context' output])
+      (#e.Success [context' (#.Some output)])
+
+      (#e.Error _)
+      (#e.Success [context #.None]))))
+
+(def: #export (fail message)
+  (All [a] (-> Text (Check a)))
+  (function (_ context)
+    (#e.Error message)))
+
+(def: #export (assert message test)
+  (-> Text Bool (Check Any))
+  (function (_ context)
+    (if test
+      (#e.Success [context []])
+      (#e.Error message))))
+
+(def: (either left right)
+  (All [a] (-> (Check a) (Check a) (Check a)))
+  (function (_ context)
+    (case (left context)
+      (#e.Success [context' output])
+      (#e.Success [context' output])
+
+      (#e.Error _)
+      (right context))))
+
+(def: (assumed? [e a] assumptions)
+  (-> [Type Type] (List Assumption) (Maybe Bool))
+  (:: maybe.Monad map product.right
+      (list.find (function (_ [[fe fa] status])
+                   (and (type/= e fe)
+                        (type/= a fa)))
+                 assumptions)))
+
+(def: (assume! ea status assumptions)
+  (-> [Type Type] Bool (List Assumption) (List Assumption))
+  (#.Cons [ea status] assumptions))
+
+(def: (on id type then else)
+  (All [a]
+    (-> Var Type (Check a) (-> Type (Check a))
+        (Check a)))
+  ($_ either
+      (do Monad
+        [_ (write type id)]
+        then)
+      (do Monad
+        [ring (ring id)
+         _ (assert "" (n/> +1 (set.size ring)))
+         _ (monad.map @ (update type) (set.to-list ring))]
+        then)
+      (do Monad
+        [?bound (read id)]
+        (else (maybe.default (#.Var id) ?bound)))))
+
+(def: (link-2 left right)
+  (-> Var Var (Check Any))
+  (do Monad
+    [_ (write (#.Var right) left)]
+    (write (#.Var left) right)))
+
+(def: (link-3 interpose to from)
+  (-> Var Var Var (Check Any))
+  (do Monad
+    [_ (update (#.Var interpose) from)]
+    (update (#.Var to) interpose)))
+
+(def: (check-vars check' assumptions idE idA)
+  (-> (-> Type Type (List Assumption) (Check (List Assumption)))
+      (List Assumption)
+      Var Var
+      (Check (List Assumption)))
+  (if (n/= idE idA)
+    (check/wrap assumptions)
+    (do Monad
+      [ebound (attempt (peek idE))
+       abound (attempt (peek idA))]
+      (case [ebound abound]
+        ## Link the 2 variables circularily
+        [#.None #.None]
+        (do @
+          [_ (link-2 idE idA)]
+          (wrap assumptions))
+
+        ## Interpose new variable between 2 existing links
+        [(#.Some etype) #.None]
+        (case etype
+          (#.Var targetE)
+          (do @
+            [_ (link-3 idA targetE idE)]
+            (wrap assumptions))
+
+          _
+          (check' etype (#.Var idA) assumptions))
+
+        ## Interpose new variable between 2 existing links
+        [#.None (#.Some atype)]
+        (case atype
+          (#.Var targetA)
+          (do @
+            [_ (link-3 idE targetA idA)]
+            (wrap assumptions))
+
+          _
+          (check' (#.Var idE) atype assumptions))
+
+        [(#.Some etype) (#.Some atype)]
+        (case [etype atype]
+          [(#.Var targetE) (#.Var targetA)]
+          (do @
+            [ringE (ring idE)
+             ringA (ring idA)]
+            (if (:: set.Equivalence = ringE ringA)
+              (wrap assumptions)
+              ## Fuse 2 rings
+              (do @
+                [_ (monad.fold @ (function (_ interpose to)
+                                   (do @
+                                     [_ (link-3 interpose to idE)]
+                                     (wrap interpose)))
+                               targetE
+                               (set.to-list ringA))]
+                (wrap assumptions))))
+          
+          [(#.Var targetE) _]
+          (do @
+            [ring (ring idE)
+             _ (monad.map @ (update atype) (set.to-list ring))]
+            (wrap assumptions))
+          
+          [_ (#.Var targetA)]
+          (do @
+            [ring (ring idA)
+             _ (monad.map @ (update etype) (set.to-list ring))]
+            (wrap assumptions))
+          
+          _
+          (check' etype atype assumptions))))))
+
+(def: (with-error-stack on-error check)
+  (All [a] (-> (-> Any Text) (Check a) (Check a)))
+  (function (_ context)
+    (case (check context)
+      (#e.Error error)
+      (#e.Error (case error
+                  ""
+                  (on-error [])
+
+                  _
+                  ($_ text/compose
+                      (on-error [])
+                      "\n\n-----------------------------------------\n\n"
+                      error)))
+
+      output
+      output)))
+
+(def: (check-apply check' assumptions [eAT eFT] [aAT aFT])
+  (-> (-> Type Type (List Assumption) (Check (List Assumption))) (List Assumption)
+      [Type Type] [Type Type]
+      (Check (List Assumption)))
+  (case [eFT aFT]
+    (^or [(#.UnivQ _ _) (#.Ex _)] [(#.UnivQ _ _) (#.Var _)])
+    (do Monad
+      [eFT' (apply-type! eFT eAT)]
+      (check' eFT' (#.Apply aAT aFT) assumptions))
+
+    (^or [(#.Ex _) (#.UnivQ _ _)] [(#.Var _) (#.UnivQ _ _)])
+    (do Monad
+      [aFT' (apply-type! aFT aAT)]
+      (check' (#.Apply eAT eFT) aFT' assumptions))
+
+    (^or [(#.Ex _) _] [_ (#.Ex _)])
+    (do Monad
+      [assumptions (check' eFT aFT assumptions)]
+      (check' eAT aAT assumptions))
+
+    [(#.Var id) _]
+    (do Monad
+      [?rFT (read id)]
+      (case ?rFT
+        (#.Some rFT)
+        (check' (#.Apply eAT rFT) (#.Apply aAT aFT) assumptions)
+
+        _
+        (do Monad
+          [assumptions (check' eFT aFT assumptions)
+           e' (apply-type! aFT eAT)
+           a' (apply-type! aFT aAT)]
+          (check' e' a' assumptions))))
+
+    [_ (#.Var id)]
+    (do Monad
+      [?rFT (read id)]
+      (case ?rFT
+        (#.Some rFT)
+        (check' (#.Apply eAT eFT) (#.Apply aAT rFT) assumptions)
+
+        _
+        (do Monad
+          [assumptions (check' eFT aFT assumptions)
+           e' (apply-type! eFT eAT)
+           a' (apply-type! eFT aAT)]
+          (check' e' a' assumptions))))
+
+    _
+    (fail "")))
+
+(def: #export (check' expected actual assumptions)
+  {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
+  (-> Type Type (List Assumption) (Check (List Assumption)))
+  (if (is? expected actual)
+    (check/wrap assumptions)
+    (with-error-stack
+      (function (_ _) (ex.construct type-check-failed [expected actual]))
+      (case [expected actual]
+        [(#.Var idE) (#.Var idA)]
+        (check-vars check' assumptions idE idA)
+        
+        [(#.Var id) _]
+        (on id actual
+            (check/wrap assumptions)
+            (function (_ bound)
+              (check' bound actual assumptions)))
+        
+        [_ (#.Var id)]
+        (on id expected
+            (check/wrap assumptions)
+            (function (_ bound)
+              (check' expected bound assumptions)))
+
+        (^template [ ]
+          [(#.Apply A1 ) (#.Apply A2 )]
+          (check-apply check' assumptions [A1 ] [A2 ]))
+        ([F1 (#.Ex ex)]
+         [(#.Ex ex) F2]
+         [F1 (#.Var id)]
+         [(#.Var id) F2])
+        
+        [(#.Apply A F) _]
+        (let [fx-pair [expected actual]]
+          (case (assumed? fx-pair assumptions)
+            (#.Some ?)
+            (if ?
+              (check/wrap assumptions)
+              (fail ""))
+
+            #.None
+            (do Monad
+              [expected' (apply-type! F A)]
+              (check' expected' actual (assume! fx-pair true assumptions)))))
+
+        [_ (#.Apply A F)]
+        (do Monad
+          [actual' (apply-type! F A)]
+          (check' expected actual' assumptions))
+
+        (^template [ ]
+          [( _) _]
+          (do Monad
+            [[_ paramT] 
+             expected' (apply-type! expected paramT)]
+            (check' expected' actual assumptions)))
+        ([#.UnivQ ..existential]
+         [#.ExQ ..var])
+
+        (^template [ ]
+          [_ ( _)]
+          (do Monad
+            [[_ paramT] 
+             actual' (apply-type! actual paramT)]
+            (check' expected actual' assumptions)))
+        ([#.UnivQ ..var]
+         [#.ExQ ..existential])
+
+        [(#.Primitive e-name e-params) (#.Primitive a-name a-params)]
+        (if (and (text/= e-name a-name)
+                 (n/= (list.size e-params)
+                      (list.size a-params)))
+          (do Monad
+            [assumptions (monad.fold Monad
+                                     (function (_ [e a] assumptions) (check' e a assumptions))
+                                     assumptions
+                                     (list.zip2 e-params a-params))]
+            (check/wrap assumptions))
+          (fail ""))
+
+        (^template []
+          [( eL eR) ( aL aR)]
+          (do Monad
+            [assumptions (check' eL aL assumptions)]
+            (check' eR aR assumptions)))
+        ([#.Sum]
+         [#.Product])
+        
+        [(#.Function eI eO) (#.Function aI aO)]
+        (do Monad
+          [assumptions (check' aI eI assumptions)]
+          (check' eO aO assumptions))
+
+        [(#.Ex e!id) (#.Ex a!id)]
+        (if (n/= e!id a!id)
+          (check/wrap assumptions)
+          (fail ""))
+
+        [(#.Named _ ?etype) _]
+        (check' ?etype actual assumptions)
+
+        [_ (#.Named _ ?atype)]
+        (check' expected ?atype assumptions)
+
+        _
+        (fail "")))))
+
+(def: #export (check expected actual)
+  {#.doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."}
+  (-> Type Type (Check Any))
+  (do Monad
+    [assumptions (check' expected actual (list))]
+    (wrap [])))
+
+(def: #export (checks? expected actual)
+  {#.doc "A simple type-checking function that just returns a yes/no answer."}
+  (-> Type Type Bool)
+  (case (run fresh-context (check expected actual))
+    (#e.Error error)
+    false
+
+    (#e.Success _)
+    true))
+
+(def: #export get-context
+  (Check Type-Context)
+  (function (_ context)
+    (#e.Success [context context])))
+
+(def: #export (clean inputT)
+  (-> Type (Check Type))
+  (case inputT
+    (#.Primitive name paramsT+)
+    (do Monad
+      [paramsT+' (monad.map @ clean paramsT+)]
+      (wrap (#.Primitive name paramsT+')))
+
+    (^or (#.Parameter _) (#.Ex _) (#.Named _))
+    (:: Monad wrap inputT)
+
+    (^template []
+      ( leftT rightT)
+      (do Monad
+        [leftT' (clean leftT)
+         rightT' (clean rightT)]
+        (wrap ( leftT' rightT'))))
+    ([#.Sum] [#.Product] [#.Function] [#.Apply])
+
+    (#.Var id)
+    (do Monad
+      [?actualT (read id)]
+      (case ?actualT
+        (#.Some actualT)
+        (clean actualT)
+
+        _
+        (wrap inputT)))
+
+    (^template []
+      ( envT+ unquantifiedT)
+      (do Monad
+        [envT+' (monad.map @ clean envT+)]
+        (wrap ( envT+' unquantifiedT))))
+    ([#.UnivQ] [#.ExQ])
+    ))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 05f800653..45e2aa900 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -20,8 +20,8 @@
               (syntax ["cs" common]
                       (common ["csr" reader]
                               ["csw" writer])))
-       (lang [type "type/" Equivalence]
-             (type [check]))
+       (language [type "type/" Equivalence]
+                 (type [check]))
        ))
 
 (type: #export Env (Dictionary Nat [Type Code]))
diff --git a/stdlib/source/lux/macro/poly/equivalence.lux b/stdlib/source/lux/macro/poly/equivalence.lux
index a01f70c74..00ffa3257 100644
--- a/stdlib/source/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/lux/macro/poly/equivalence.lux
@@ -25,7 +25,7 @@
               (syntax [common])
               [poly #+ poly:])
        (type [unit])
-       (lang [type])
+       (language [type])
        ))
 
 ## [Derivers]
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index c7a000e61..ae1611c55 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -12,7 +12,7 @@
               [syntax #+ syntax: Syntax]
               (syntax [common])
               [poly #+ poly:])
-       (lang [type])
+       (language [type])
        ))
 
 (poly: #export Functor
diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux
index 1414bb38c..4ac28a2a5 100644
--- a/stdlib/source/lux/macro/poly/json.lux
+++ b/stdlib/source/lux/macro/poly/json.lux
@@ -26,7 +26,7 @@
               [code]
               [poly #+ poly:])
        (type [unit])
-       (lang [type])
+       (language [type])
        ))
 
 (def: tag
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 28c90bbc8..10095805f 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -11,7 +11,7 @@
               (syntax ["cs" common]
                       (common ["csr" reader]
                               ["csw" writer])))
-       (lang [type #+ :cast])))
+       (language [type #+ :cast])))
 
 (def: (get k plist)
   (All [a]
diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux
index ea82200df..12dee41b4 100644
--- a/stdlib/source/lux/type/implicit.lux
+++ b/stdlib/source/lux/type/implicit.lux
@@ -14,8 +14,8 @@
        [macro #+ Monad]
        (macro [code]
               ["s" syntax #+ syntax: Syntax])
-       (lang [type]
-             (type ["tc" check #+ Check]))
+       (language [type]
+                 (type ["tc" check #+ Check]))
        ))
 
 (def: (find-type-var id env)
diff --git a/stdlib/source/lux/type/object/interface.lux b/stdlib/source/lux/type/object/interface.lux
index f48ccab0a..d6a31d1f8 100644
--- a/stdlib/source/lux/type/object/interface.lux
+++ b/stdlib/source/lux/type/object/interface.lux
@@ -15,7 +15,7 @@
               (syntax ["cs" common]
                       (common ["csr" reader]
                               ["csw" writer])))
-       (lang [type])))
+       (language [type])))
 
 ## [Common]
 (type: Declaration
diff --git a/stdlib/source/lux/type/quotient.lux b/stdlib/source/lux/type/quotient.lux
index 35e681159..958e5eda9 100644
--- a/stdlib/source/lux/type/quotient.lux
+++ b/stdlib/source/lux/type/quotient.lux
@@ -3,7 +3,7 @@
   (lux (control [monad #+ do]
                 ["p" parser])
        (data ["e" error #+ Error])
-       (lang [type])
+       (language [type])
        (type abstract)
        [macro]
        (macro ["s" syntax #+ syntax:]
diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux
index 7833e3db0..d7de1a67a 100644
--- a/stdlib/source/lux/type/refinement.lux
+++ b/stdlib/source/lux/type/refinement.lux
@@ -4,7 +4,7 @@
                 [monad #+ do]
                 ["p" parser])
        (data ["e" error #+ Error])
-       (lang [type "type/" Equivalence])
+       (language [type "type/" Equivalence])
        (type abstract)
        [macro]
        (macro ["s" syntax #+ syntax:]
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index de93d940a..3ff1fc4a8 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -11,7 +11,7 @@
        (world [blob #+ Blob])
        [io #+ Process]
        [host #+ import:]
-       [lang/host]))
+       [language/host]))
 
 (type: #export File Text)
 
@@ -95,7 +95,7 @@
   (ex.report ["Instant" (%instant instant)]
              ["File" file]))
 
-(`` (for {(~~ (static lang/host.jvm))
+(`` (for {(~~ (static language/host.jvm))
           (as-is (import: #long java/io/File
                    (new [String])
                    (exists [] #io #try boolean)
diff --git a/stdlib/test/test/lux/lang/compiler/analysis/case.lux b/stdlib/test/test/lux/lang/compiler/analysis/case.lux
deleted file mode 100644
index 5baf47fc0..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/case.lux
+++ /dev/null
@@ -1,194 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [bool "B/" Equivalence]
-             ["R" error]
-             [product]
-             [maybe]
-             [text "T/" Equivalence]
-             text/format
-             (collection [list "list/" Monad]
-                         [set]))
-       ["r" math/random "r/" Monad]
-       [macro #+ Monad]
-       (macro [code])
-       (lang [type "type/" Equivalence]
-             (type ["tc" check])
-             [".L" module]
-             (compiler [analysis]
-                       (analysis [".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)
-  (-> Bool (List [Code Code]) Code (r.Random (List Code)))
-  (case inputC
-    [_ (#.Bool _)]
-    (r/wrap (list (' true) (' false)))
-
-    (^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 (' _)))))
-        (r/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))])
-    (r/wrap (list (' [])))
-
-    (^ [_ (#.Record (list))])
-    (r/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)))
-
-    _
-    (r/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
-         (r/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)))
-         (r/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 (|>> (T/= 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 (tc.checks? outputT) not)
-                                                   _primitive.primitive)
-         exhaustive-patterns (exhaustive-branches true variantTC inputC)
-         redundant-patterns (exhaustive-branches false 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 Monad
-                                 [_ (moduleL.declare-tags variant-tags false
-                                                          (#.Named [module-name variant-name]
-                                                                   (type.variant primitivesT)))
-                                  _ (moduleL.declare-tags record-tags false
-                                                          (#.Named [module-name record-name]
-                                                                   (type.tuple primitivesT)))])
-                               (moduleL.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/lang/compiler/analysis/function.lux b/stdlib/test/test/lux/lang/compiler/analysis/function.lux
deleted file mode 100644
index 315972d28..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/function.lux
+++ /dev/null
@@ -1,112 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data ["e" error]
-             [maybe]
-             [product]
-             [text "text/" Equivalence]
-             text/format
-             (collection [list "list/" Functor]))
-       ["r" math/random "r/" Monad]
-       [macro]
-       (macro [code])
-       [lang]
-       (lang [type "type/" Equivalence]
-             [".L" reference]
-             (compiler [".L" init]
-                       [".L" analysis #+ Analysis]
-                       (analysis [".A" type]
-                                 [".A" expression]
-                                 ["/" function])))
-       test)
-  (// ["_." primitive]
-      ["_." structure]))
-
-(def: analyse (expressionA.analyser (:coerce lang.Eval [])))
-
-(def: (check-apply expectedT num-args analysis)
-  (-> Type Nat (Meta Analysis) Bool)
-  (|> analysis
-      (typeA.with-type expectedT)
-      (macro.run (initL.compiler []))
-      (case> (#e.Success applyA)
-             (let [[funcA argsA] (analysisL.application applyA)]
-               (n/= num-args (list.size argsA)))
-
-             (#e.Error error)
-             false)))
-
-(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 (#analysisL.Function (list) (#analysisL.Reference (referenceL.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/lang/compiler/analysis/primitive.lux b/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux
deleted file mode 100644
index cf98a71ff..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/primitive.lux
+++ /dev/null
@@ -1,86 +0,0 @@
-(.module:
-  [lux #- primitive]
-  (lux [io]
-       (control [monad #+ do]
-                pipe
-                ["ex" exception #+ exception:])
-       (data (text format)
-             ["e" error])
-       ["r" math/random "r/" Monad]
-       [macro]
-       (macro [code])
-       [lang]
-       (lang [".L" type "type/" Equivalence]
-             (compiler [".L" init]
-                       [analysis #+ Analysis]
-                       (analysis [".A" type]
-                                 [".A" expression])))
-       test))
-
-(def: #export analyse (expressionA.analyser (:coerce lang.Eval [])))
-
-(def: unit
-  (r.Random Code)
-  (r/wrap (' [])))
-
-(def: #export primitive
-  (r.Random [Type Code])
-  (`` ($_ r.either
-          (~~ (do-template [  ]
-                [(r.seq (r/wrap ) (r/map  ))]
-
-                [Any  code.tuple (r.list +0 ..unit)]
-                [Bool code.bool  r.bool]
-                [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 (Meta Analysis) (e.Error Analysis))
-  (|> (typeA.with-inference
-        analysis)
-      (macro.run (initL.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)
-
-                       _
-                       false)))
-      (<| (times +100)
-          (`` ($_ seq
-                  (~~ (do-template [    ]
-                        [(do @
-                           [sample ]
-                           (test (format "Can analyse "  ".")
-                                 (|> (infer-primitive  (..analyse ( sample)))
-                                     (case> (#e.Success (#analysis.Primitive ( output)))
-                                            (is? sample output)
-
-                                            _
-                                            false))))]
-
-                        ["bool" Bool #analysis.Bool r.bool code.bool]
-                        ["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/lang/compiler/analysis/procedure/common.lux b/stdlib/test/test/lux/lang/compiler/analysis/procedure/common.lux
deleted file mode 100644
index 377a48478..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/procedure/common.lux
+++ /dev/null
@@ -1,310 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (concurrency [atom])
-       (data text/format
-             ["e" error]
-             [product]
-             (collection [array]))
-       ["r" math/random "r/" Monad]
-       [macro #+ Monad]
-       (macro [code])
-       [lang]
-       (lang [type "type/" Equivalence]
-             [".L" scope]
-             (compiler [".L" init]
-                       (analysis [".A" type])))
-       test)
-  (/// ["_." primitive]))
-
-(do-template [  ]
-  [(def: ( procedure params output-type)
-     (-> Text (List Code) Type Bool)
-     (|> (scopeL.with-scope ""
-           (typeA.with-type output-type
-             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
-         (macro.run (initL.compiler []))
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [check-success+ true false]
-  [check-failure+ false true]
-  )
-
-(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) Bool))
-            (test "Reference equality must be done with elements of the same type."
-                  (check-failure+ "lux is" (list primC antiC) Bool))
-            (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) Bool))
-            (test "Can compare integers."
-                  (check-success+ "lux int <" (list subjectC paramC) Bool))
-            (test "Can obtain minimum integer."
-                  (check-success+ "lux int min" (list) Int))
-            (test "Can obtain maximum integer."
-                  (check-success+ "lux int max" (list) Int))
-            (test "Can convert integer to natural number."
-                  (check-success+ "lux int to-nat" (list subjectC) Nat))
-            (test "Can convert integer to frac number."
-                  (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) Bool))
-            (test "Can compare frac numbers."
-                  (check-success+ "lux frac <" (list subjectC paramC) Bool))
-            (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) Bool))
-            (test "Compare texts in lexicographical order."
-                  (check-success+ "lux text <" (list subjectC paramC) Bool))
-            (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 calculate a hash code for text."
-                  (check-success+ "lux text hash" (list subjectC) Nat))
-            (test "Can replace a text inside of a larger one (once)."
-                  (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
-            (test "Can replace a text inside of a larger one (all times)."
-                  (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
-            (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)
-                                 (|> (scopeL.with-scope ""
-                                       (scopeL.with-local [var-name arrayT]
-                                         (typeA.with-type output-type
-                                           (_primitive.analyse code))))
-                                     (macro.run (initL.compiler []))
-                                     (case> (#e.Success _)
-                                            true
-
-                                            (#e.Error error)
-                                            false)))]]
-        ($_ 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."
-                  (|> (scopeL.with-scope ""
-                        (scopeL.with-local [var-name atomT]
-                          (typeA.with-type elemT
-                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
-                      (macro.run (initL.compiler []))
-                      (case> (#e.Success _)
-                             true
-
-                             (#e.Error _)
-                             false)))
-            (test "Can swap the value of an atomic reference."
-                  (|> (scopeL.with-scope ""
-                        (scopeL.with-local [var-name atomT]
-                          (typeA.with-type Bool
-                            (_primitive.analyse (` ("lux atom compare-and-swap"
-                                                    (~ (code.symbol ["" var-name]))
-                                                    (~ elemC)
-                                                    (~ elemC)))))))
-                      (macro.run (initL.compiler []))
-                      (case> (#e.Success _)
-                             true
-
-                             (#e.Error _)
-                             false)))
-            ))))
-
-(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/lang/compiler/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/lang/compiler/analysis/procedure/host.jvm.lux
deleted file mode 100644
index 3d3dc41d5..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/procedure/host.jvm.lux
+++ /dev/null
@@ -1,541 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (concurrency [atom])
-       (data ["e" error]
-             [product]
-             [maybe]
-             [text "text/" Equivalence]
-             text/format
-             (collection [array]
-                         [list "list/" Fold]
-                         ["dict" dictionary]))
-       ["r" math/random "r/" Monad]
-       [macro #+ Monad]
-       (macro [code])
-       [lang]
-       (lang [type]
-             (compiler [".L" init]
-                       (analysis [".A" type])
-                       (extension (analysis [".AE" host]))))
-       test)
-  (/// ["_." primitive]))
-
-(do-template [  ]
-  [(def: ( procedure params output-type)
-     (-> Text (List Code) Type Bool)
-     (|> (do Monad
-           [## runtime-bytecode @runtime.translate
-            ]
-           (lang.with-scope
-             (typeA.with-type output-type
-               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
-         (lang.with-current-module "")
-         (macro.run (initL.compiler []))
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [success true false]
-  [failure false true]
-  )
-
-(do-template [  ]
-  [(def: ( syntax output-type)
-     (-> Code Type Bool)
-     (|> (do Monad
-           [## runtime-bytecode @runtime.translate
-            ]
-           (lang.with-scope
-             (typeA.with-type output-type
-               (_primitive.analyse syntax))))
-         (lang.with-current-module "")
-         (macro.run (initL.compiler []))
-         (case> (#e.Success _)
-                
-
-                (#e.Error error)
-                )))]
-
-  [success' true false]
-  [failure' false true]
-  )
-
-(context: "Conversions [double + float]."
-  (with-expansions [ (do-template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
-                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
-                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
-                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
-                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
-                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [int]."
-  (with-expansions [ (do-template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
-                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
-                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
-                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
-                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
-                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [long]."
-  (with-expansions [ (do-template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
-                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
-                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
-                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
-                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(context: "Conversions [char + byte + short]."
-  (with-expansions [ (do-template [  ]
-                                    [(test (format  " SUCCESS")
-                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
-                                     (test (format  " FAILURE")
-                                           (failure  (list (' [])) ))]
-
-                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
-                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
-                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
-                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
-                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
-                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
-                                    )]
-    ($_ seq
-        
-        )))
-
-(do-template [  ]
-  [(context: (format "Arithmetic " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " +")   ]
-                                        [(format "jvm "  " -")   ]
-                                        [(format "jvm "  " *")   ]
-                                        [(format "jvm "  " /")   ]
-                                        [(format "jvm "  " %")   ]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Order " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Bitwise " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " and")   ]
-                                        [(format "jvm "  " or")   ]
-                                        [(format "jvm "  " xor")   ]
-                                        [(format "jvm "  " shl")  "java.lang.Integer" ]
-                                        [(format "jvm "  " shr")  "java.lang.Integer" ]
-                                        [(format "jvm "  " ushr")  "java.lang.Integer" ]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["int" "java.lang.Integer" hostAE.Integer]
-  ["long" "java.lang.Long" hostAE.Long]
-  )
-
-(do-template [  ]
-  [(context: (format "Arithmetic " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " +")   ]
-                                        [(format "jvm "  " -")   ]
-                                        [(format "jvm "  " *")   ]
-                                        [(format "jvm "  " /")   ]
-                                        [(format "jvm "  " %")   ]
-                                        )]
-       ($_ seq
-           
-           )))
-
-   (context: (format "Order " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["float" "java.lang.Float" hostAE.Float]
-  ["double" "java.lang.Double" hostAE.Double]
-  )
-
-(do-template [  ]
-  [(context: (format "Order " "["  "].")
-     (with-expansions [ (do-template [   ]
-                                        [(test 
-                                               (success 
-                                                        (list (' ("lux coerce" (+0  (+0)) []))
-                                                              (' ("lux coerce" (+0  (+0)) [])))
-                                                        ))]
-
-                                        [(format "jvm "  " =")   hostAE.Boolean]
-                                        [(format "jvm "  " <")   hostAE.Boolean]
-                                        )]
-       ($_ seq
-           
-           )))]
-
-
-  ["char" "java.lang.Character" hostAE.Character]
-  )
-
-(def: array-type
-  (r.Random [Text Text])
-  (let [entries (dict.entries hostAE.boxes)
-        num-entries (list.size entries)]
-    (do r.Monad
-      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
-       #let [[unboxed boxed] (: [Text Text]
-                                (|> entries
-                                    (list.nth choice)
-                                    (maybe.default ["java.lang.Object" "java.lang.Object"])))]]
-      (wrap [unboxed boxed]))))
-
-(context: "Array."
-  (<| (times +100)
-      (do @
-        [#let [cap (|>> (n/% +10) (n/max +1))]
-         [unboxed boxed] array-type
-         size (|> r.nat (:: @ map cap))
-         idx (|> r.nat (:: @ map (n/% size)))
-         level (|> r.nat (:: @ map cap))
-         #let [unboxedT (#.Primitive unboxed (list))
-               arrayT (#.Primitive "#Array" (list unboxedT))
-               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0)))
-                           ("jvm array new" (~ (code.nat size)))))
-               boxedT (#.Primitive boxed (list))
-               boxedTC (` (+0 (~ (code.text boxed)) (+0)))
-               multi-arrayT (list/fold (function (_ _ innerT)
-                                         (|> innerT (list) (#.Primitive "#Array")))
-                                       boxedT
-                                       (list.n/range +1 level))]]
-        ($_ seq
-            (test "jvm array new"
-                  (success "jvm array new"
-                           (list (code.nat size))
-                           arrayT))
-            (test "jvm array new (no nesting)"
-                  (failure "jvm array new"
-                           (list (code.nat size))
-                           unboxedT))
-            (test "jvm array new (nested/multi-level)"
-                  (success "jvm array new"
-                           (list (code.nat size))
-                           multi-arrayT))
-            (test "jvm array length"
-                  (success "jvm array length"
-                           (list arrayC)
-                           Nat))
-            (test "jvm array read"
-                  (success' (` ("jvm object cast"
-                                ("jvm array read" (~ arrayC) (~ (code.nat idx)))))
-                            boxedT))
-            (test "jvm array write"
-                  (success "jvm array write"
-                           (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) [])))
-                           arrayT))
-            ))))
-
-(def: throwables
-  (List Text)
-  (list "java.lang.Throwable"
-        "java.lang.Error"
-        "java.io.IOError"
-        "java.lang.VirtualMachineError"
-        "java.lang.Exception"
-        "java.io.IOException"
-        "java.lang.RuntimeException"))
-
-(context: "Object."
-  (<| (times +100)
-      (do @
-        [[unboxed boxed] array-type
-         [!unboxed !boxed] (|> array-type
-                               (r.filter (function (_ [!unboxed !boxed])
-                                           (not (text/= boxed !boxed)))))
-         #let [boxedT (#.Primitive boxed (list))
-               boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0))
-                           ("jvm object null")))
-               !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0))
-                            ("jvm object null")))
-               unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
-                             ("jvm object null")))]
-         throwable (|> r.nat
-                       (:: @ map (n/% (inc (list.size throwables))))
-                       (:: @ map (function (_ idx)
-                                   (|> throwables
-                                       (list.nth idx)
-                                       (maybe.default "java.lang.Object")))))
-         #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0))
-                               ("jvm object null")))]]
-        ($_ seq
-            (test "jvm object null"
-                  (success "jvm object null"
-                           (list)
-                           (#.Primitive boxed (list))))
-            (test "jvm object null (no primitives)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object null"
-                               (list)
-                               (#.Primitive unboxed (list)))))
-            (test "jvm object null?"
-                  (success "jvm object null?"
-                           (list boxedC)
-                           Bool))
-            (test "jvm object synchronized"
-                  (success "jvm object synchronized"
-                           (list boxedC boxedC)
-                           boxedT))
-            (test "jvm object synchronized (no primitives)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object synchronized"
-                               (list unboxedC boxedC)
-                               boxedT)))
-            (test "jvm object throw"
-                  (or (text/= "java.lang.Object" throwable)
-                      (success "jvm object throw"
-                               (list throwableC)
-                               Nothing)))
-            (test "jvm object class"
-                  (success "jvm object class"
-                           (list (code.text boxed))
-                           (#.Primitive "java.lang.Class" (list boxedT))))
-            (test "jvm object instance?"
-                  (success "jvm object instance?"
-                           (list (code.text boxed)
-                                 boxedC)
-                           Bool))
-            (test "jvm object instance? (lineage)"
-                  (success "jvm object instance?"
-                           (list (' "java.lang.Object")
-                                 boxedC)
-                           Bool))
-            (test "jvm object instance? (no lineage)"
-                  (or (text/= "java.lang.Object" boxed)
-                      (failure "jvm object instance?"
-                               (list (code.text boxed)
-                                     !boxedC)
-                               Bool)))
-            ))))
-
-(context: "Member [Static Field]."
-  ($_ seq
-      (test "jvm member static get"
-            (success "jvm member static get"
-                     (list (code.text "java.lang.System")
-                           (code.text "out"))
-                     (#.Primitive "java.io.PrintStream" (list))))
-      (test "jvm member static get (inheritance out)"
-            (success "jvm member static get"
-                     (list (code.text "java.lang.System")
-                           (code.text "out"))
-                     (#.Primitive "java.lang.Object" (list))))
-      (test "jvm member static put"
-            (success "jvm member static put"
-                     (list (code.text "java.awt.datatransfer.DataFlavor")
-                           (code.text "allHtmlFlavor")
-                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
-                                ("jvm object null"))))
-                     Any))
-      (test "jvm member static put (final)"
-            (failure "jvm member static put"
-                     (list (code.text "java.lang.System")
-                           (code.text "out")
-                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
-                                ("jvm object null"))))
-                     Any))
-      (test "jvm member static put (inheritance in)"
-            (success "jvm member static put"
-                     (list (code.text "java.awt.datatransfer.DataFlavor")
-                           (code.text "allHtmlFlavor")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
-                                 ("jvm object null")))))
-                     Any))
-      ))
-
-(context: "Member [Virtual Field]."
-  ($_ seq
-      (test "jvm member virtual get"
-            (success "jvm member virtual get"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.String" (list))))
-      (test "jvm member virtual get (inheritance out)"
-            (success "jvm member virtual get"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.Object" (list))))
-      (test "jvm member virtual put"
-            (success "jvm member virtual put"
-                     (list (code.text "org.omg.CORBA.ValueMember")
-                           (code.text "id")
-                           (`' ("lux check" (+0 "java.lang.String" (+0))
-                                ("jvm object null")))
-                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
-                                ("jvm object null"))))
-                     (primitive "org.omg.CORBA.ValueMember")))
-      (test "jvm member virtual put (final)"
-            (failure "jvm member virtual put"
-                     (list (code.text "javax.swing.text.html.parser.DTD")
-                           (code.text "applet")
-                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
-                                ("jvm object null")))
-                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
-                                ("jvm object null"))))
-                     (primitive "javax.swing.text.html.parser.DTD")))
-      (test "jvm member virtual put (inheritance in)"
-            (success "jvm member virtual put"
-                     (list (code.text "java.awt.GridBagConstraints")
-                           (code.text "insets")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
-                                 ("jvm object null"))))
-                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
-                                ("jvm object null"))))
-                     (primitive "java.awt.GridBagConstraints")))
-      ))
-
-(context: "Boxing/Unboxing."
-  ($_ seq
-      (test "jvm member static get"
-            (success "jvm member static get"
-                     (list (code.text "java.util.GregorianCalendar")
-                           (code.text "AD"))
-                     (#.Primitive "java.lang.Integer" (list))))
-      (test "jvm member virtual get"
-            (success "jvm member virtual get"
-                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
-                           (code.text "startIndex")
-                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
-                                ("jvm object null"))))
-                     (#.Primitive "java.lang.Integer" (list))))
-      (test "jvm member virtual put"
-            (success "jvm member virtual put"
-                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
-                           (code.text "startIndex")
-                           (`' ("jvm object cast"
-                                ("lux check" (+0 "java.lang.Integer" (+0))
-                                 ("jvm object null"))))
-                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
-                                ("jvm object null"))))
-                     (primitive "javax.accessibility.AccessibleAttributeSequence")))
-      ))
-
-(context: "Member [Method]."
-  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
-                  +123))
-        intC (`' ("jvm convert long-to-int" (~ longC)))
-        stringC (' ("lux coerce" (+0 "java.lang.String" (+0))
-                    "YOLO"))
-        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
-                     ("jvm member invoke constructor" "java.util.ArrayList"
-                      ["int" ("jvm object cast" (~ intC))])))]
-    ($_ seq
-        (test "jvm member invoke static"
-              (success' (` ("jvm member invoke static"
-                            "java.lang.Long" "decode"
-                            ["java.lang.String" (~ stringC)]))
-                        (#.Primitive "java.lang.Long" (list))))
-        (test "jvm member invoke virtual"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke virtual"
-                             "java.lang.Object" "equals"
-                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke special"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke special"
-                             "java.lang.Long" "equals"
-                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke interface"
-              (success' (` ("jvm object cast"
-                            ("jvm member invoke interface"
-                             "java.util.Collection" "add"
-                             ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
-                        (#.Primitive "java.lang.Boolean" (list))))
-        (test "jvm member invoke constructor"
-              (success' (` ("jvm member invoke constructor"
-                            "java.util.ArrayList"
-                            ["int" ("jvm object cast" (~ intC))]))
-                        (All [a] (#.Primitive "java.util.ArrayList" (list a)))))
-        )))
diff --git a/stdlib/test/test/lux/lang/compiler/analysis/reference.lux b/stdlib/test/test/lux/lang/compiler/analysis/reference.lux
deleted file mode 100644
index d1874bfee..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/reference.lux
+++ /dev/null
@@ -1,102 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data ["e" error]
-             [ident "ident/" Equivalence]
-             [text "text/" Equivalence])
-       ["r" math/random]
-       [macro #+ Monad]
-       (macro [code])
-       [lang]
-       (lang [type "type/" Equivalence]
-             [".L" scope]
-             [".L" module]
-             [".L" reference]
-             (compiler [".L" init]
-                       [".L" analysis]
-                       (analysis [".A" type]
-                                 [".A" expression])))
-       test)
-  (// ["_." primitive]))
-
-(def: analyse (expressionA.analyser (:coerce lang.Eval [])))
-
-(type: Check (-> (e.Error Any) Bool))
-
-(do-template [  ]
-  [(def: 
-     Check
-     (|>> (case> (#e.Success _)
-                 
-
-                 (#e.Error _)
-                 )))]
-
-  [success? true false]
-  [failure? false true]
-  )
-
-(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
-  (-> Text [Bool Text] [Bool Text] Check Bool)
-  (|> (do Monad
-        [_ (moduleL.with-module +0 def-module
-             (moduleL.define var-name [Any
-                                       (if export?
-                                         (' {#.export? true})
-                                         (' {}))
-                                       []]))]
-        (moduleL.with-module +0 dependent-module
-          (do @
-            [_ (if import?
-                 (moduleL.import def-module)
-                 (wrap []))]
-            (typeA.with-inference
-              (..analyse (code.symbol [def-module var-name]))))))
-      (macro.run (initL.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."
-                  (|> (scopeL.with-scope scope-name
-                        (scopeL.with-local [var-name expectedT]
-                          (typeA.with-inference
-                            (..analyse (code.local-symbol var-name)))))
-                      (macro.run (initL.compiler []))
-                      (case> (^ (#e.Success [inferredT (#analysisL.Reference (referenceL.local var))]))
-                             (and (type/= expectedT inferredT)
-                                  (n/= +0 var))
-
-                             _
-                             false)))
-            (test "Can analyse definition (in the same module)."
-                  (let [def-name [def-module var-name]]
-                    (|> (do Monad
-                          [_ (moduleL.define var-name [expectedT (' {}) []])]
-                          (typeA.with-inference
-                            (..analyse (code.symbol def-name))))
-                        (moduleL.with-module +0 def-module)
-                        (macro.run (initL.compiler []))
-                        (case> (^ (#e.Success [_ inferredT (#analysisL.Reference (referenceL.constant constant-name))]))
-                               (and (type/= expectedT inferredT)
-                                    (ident/= def-name constant-name))
-
-                               _
-                               false))))
-            (test "Can analyse definition (if exported from imported module)."
-                  (reach-test var-name [true def-module] [true dependent-module] success?))
-            (test "Cannot analyse definition (if not exported from imported module)."
-                  (reach-test var-name [false def-module] [true dependent-module] failure?))
-            (test "Cannot analyse definition (if exported from non-imported module)."
-                  (reach-test var-name [true def-module] [false dependent-module] failure?))
-            ))))
diff --git a/stdlib/test/test/lux/lang/compiler/analysis/structure.lux b/stdlib/test/test/lux/lang/compiler/analysis/structure.lux
deleted file mode 100644
index 4b43d150f..000000000
--- a/stdlib/test/test/lux/lang/compiler/analysis/structure.lux
+++ /dev/null
@@ -1,292 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [bool "bool/" Equivalence]
-             ["e" error]
-             [product]
-             [maybe]
-             [text]
-             text/format
-             (collection [list "list/" Functor]
-                         [set]))
-       ["r" math/random "r/" Monad]
-       [macro]
-       (macro [code])
-       [lang]
-       (lang [type "type/" Equivalence]
-             (type ["tc" check])
-             [".L" module]
-             (compiler [".L" init]
-                       [".L" analysis #+ Analysis Variant Tag]
-                       (analysis [".A" type]
-                                 ["/" structure]
-                                 [".A" expression])))
-       test)
-  (// ["_." primitive]))
-
-(def: analyse (expressionA.analyser (:coerce lang.Eval [])))
-
-(do-template [  ]
-  [(def: #export 
-     (All [a] (-> (Meta a) Bool))
-     (|>> (macro.run (initL.compiler []))
-          (case> (#e.Success _)
-                 
-
-                 _
-                 )))]
-
-  [check-succeeds true  false]
-  [check-fails    false true]
-  )
-
-(def: (check-sum' size tag variant)
-  (-> Nat Tag (Variant Analysis) Bool)
-  (let [variant-tag (if (get@ #analysisL.right? variant)
-                      (inc (get@ #analysisL.lefts variant))
-                      (get@ #analysisL.lefts variant))]
-    (|> size dec (n/= tag)
-        (bool/= (get@ #analysisL.right? variant))
-        (and (n/= tag variant-tag)))))
-
-(def: (check-sum type size tag analysis)
-  (-> Type Nat Tag (Meta Analysis) Bool)
-  (|> analysis
-      (typeA.with-type type)
-      (macro.run (initL.compiler []))
-      (case> (^multi (#e.Success sumA)
-                     [(analysisL.variant sumA)
-                      (#.Some variant)])
-             (check-sum' size tag variant)
-
-             _
-             false)))
-
-(def: (tagged module tags type)
-  (All [a] (-> Text (List moduleL.Tag) Type (Meta a) (Meta [Module a])))
-  (|>> (do macro.Monad
-         [_ (moduleL.declare-tags tags false type)])
-       (moduleL.with-module +0 module)))
-
-(def: (check-variant module tags type size tag analysis)
-  (-> Text (List moduleL.Tag) Type Nat Tag (Meta Analysis) Bool)
-  (|> analysis
-      (tagged module tags type)
-      (typeA.with-type type)
-      (macro.run (initL.compiler []))
-      (case> (^multi (#e.Success [_ sumA])
-                     [(analysisL.variant sumA)
-                      (#.Some variant)])
-             (check-sum' size tag variant)
-
-             _
-             false)))
-
-(def: (right-size? size)
-  (-> Nat (-> Analysis Bool))
-  (|>> analysisL.tuple list.size (n/= size)))
-
-(def: (check-record-inference module tags type size analysis)
-  (-> Text (List moduleL.Tag) Type Nat (Meta [Type Analysis]) Bool)
-  (|> analysis
-      (tagged module tags type)
-      (macro.run (initL.compiler []))
-      (case> (#e.Success [_ productT productA])
-             (and (type/= type productT)
-                  (right-size? size productA))
-
-             _
-             false)))
-
-(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 macro.Monad
-                        [[_ varT] (typeA.with-env tc.var)
-                         _ (typeA.with-env
-                             (tc.check varT variantT))]
-                        (typeA.with-type varT
-                          (/.sum ..analyse choice valueC)))
-                      (macro.run (initL.compiler []))
-                      (case> (^multi (#e.Success sumA)
-                                     [(analysisL.variant sumA)
-                                      (#.Some variant)])
-                             (check-sum' size choice variant)
-
-                             _
-                             false)))
-            (test "Cannot analyse sum through unbound type-vars."
-                  (|> (do macro.Monad
-                        [[_ varT] (typeA.with-env tc.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)))
-                      (macro.run (initL.compiler []))
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             false)))
-            (test "Can infer product."
-                  (|> (typeA.with-inference
-                        (/.product ..analyse (list/map product.right primitives)))
-                      (macro.run (initL.compiler []))
-                      (case> (#e.Success [_type tupleA])
-                             (and (type/= tupleT _type)
-                                  (right-size? size tupleA))
-
-                             _
-                             false)))
-            (test "Can analyse pseudo-product (singleton tuple)"
-                  (|> (typeA.with-type singletonT
-                        (..analyse (` [(~ singletonC)])))
-                      check-succeeds))
-            (test "Can analyse product through bound type-vars."
-                  (|> (do macro.Monad
-                        [[_ varT] (typeA.with-env tc.var)
-                         _ (typeA.with-env
-                             (tc.check varT (type.tuple (list/map product.left primitives))))]
-                        (typeA.with-type varT
-                          (/.product ..analyse (list/map product.right primitives))))
-                      (macro.run (initL.compiler []))
-                      (case> (#e.Success tupleA)
-                             (right-size? size tupleA)
-
-                             _
-                             false)))
-            (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 macro.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/lang/compiler/synthesis/case.lux b/stdlib/test/test/lux/lang/compiler/synthesis/case.lux
deleted file mode 100644
index 228ed2920..000000000
--- a/stdlib/test/test/lux/lang/compiler/synthesis/case.lux
+++ /dev/null
@@ -1,82 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                pipe)
-       (data [error "error/" Functor])
-       (lang ["///." reference]
-             ["///." compiler]
-             [".L" analysis #+ Branch Analysis]
-             ["//" synthesis #+ Synthesis]
-             (synthesis [".S" expression])
-             [".L" extension])
-       ["r" math/random "r/" Monad]
-       test)
-  [//primitive])
-
-(context: "Dummy variables."
-  (<| (times +100)
-      (do @
-        [maskedA //primitive.primitive
-         temp (|> r.nat (:: @ map (n/% +100)))
-         #let [maskA (analysisL.control/case
-                      [maskedA
-                       [[(#analysisL.Bind temp)
-                         (#analysisL.Reference (///reference.local temp))]
-                        (list)]])]]
-        (test "Dummy variables created to mask expressions get eliminated during synthesis."
-              (|> maskA
-                  (expressionS.synthesizer extensionL.empty)
-                  (///compiler.run //.init)
-                  (error/map (//primitive.corresponds? maskedA))
-                  (error.default false))))))
-
-(context: "Let expressions."
-  (<| (times +100)
-      (do @
-        [registerA r.nat
-         inputA //primitive.primitive
-         outputA //primitive.primitive
-         #let [letA (analysisL.control/case
-                     [inputA
-                      [[(#analysisL.Bind registerA)
-                        outputA]
-                       (list)]])]]
-        (test "Can detect and reify simple 'let' expressions."
-              (|> letA
-                  (expressionS.synthesizer extensionL.empty)
-                  (///compiler.run //.init)
-                  (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
-                         (and (n/= registerA registerS)
-                              (//primitive.corresponds? inputA inputS)
-                              (//primitive.corresponds? outputA outputS))
-
-                         _
-                         false))))))
-
-(context: "If expressions."
-  (<| (times +100)
-      (do @
-        [then|else r.bool
-         inputA //primitive.primitive
-         thenA //primitive.primitive
-         elseA //primitive.primitive
-         #let [thenB (: Branch
-                        [(#analysisL.Simple (#analysisL.Bool true))
-                         thenA])
-               elseB (: Branch
-                        [(#analysisL.Simple (#analysisL.Bool false))
-                         elseA])
-               ifA (if then|else
-                     (analysisL.control/case [inputA [thenB (list elseB)]])
-                     (analysisL.control/case [inputA [elseB (list thenB)]]))]]
-        (test "Can detect and reify simple 'if' expressions."
-              (|> ifA
-                  (expressionS.synthesizer extensionL.empty)
-                  (///compiler.run //.init)
-                  (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
-                         (and (//primitive.corresponds? inputA inputS)
-                              (//primitive.corresponds? thenA thenS)
-                              (//primitive.corresponds? elseA elseS))
-
-                         _
-                         false))))))
diff --git a/stdlib/test/test/lux/lang/compiler/synthesis/function.lux b/stdlib/test/test/lux/lang/compiler/synthesis/function.lux
deleted file mode 100644
index 008062e5e..000000000
--- a/stdlib/test/test/lux/lang/compiler/synthesis/function.lux
+++ /dev/null
@@ -1,168 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [product]
-             [maybe]
-             [error]
-             [number]
-             text/format
-             (collection [list "list/" Functor Fold]
-                         ["dict" dictionary #+ Dictionary]
-                         [set]))
-       (lang ["///." reference #+ Variable "variable/" Equivalence]
-             ["///." compiler]
-             [".L" analysis #+ Arity Analysis]
-             ["//" synthesis #+ Synthesis]
-             (synthesis [".S" expression])
-             [".L" extension])
-       ["r" math/random]
-       test)
-  [//primitive])
-
-(def: constant-function
-  (r.Random [Arity Analysis Analysis])
-  (r.rec
-   (function (_ constant-function)
-     (do r.Monad
-       [function? r.bool]
-       (if function?
-         (do @
-           [[arity bodyA predictionA] constant-function]
-           (wrap [(inc arity)
-                  (#analysisL.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.bool]
-                                        (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
-                                                   (#analysisL.Function picked-env bodyA)
-                                                   predictionA]))
-                                          (do @
-                                            [chosen (pick (list.size current-env))]
-                                            (wrap [arity
-                                                   (#analysisL.Reference (///reference.foreign chosen))
-                                                   (maybe.assume (dict.get chosen resolver))])))))))]
-    (wrap [arity
-           (#analysisL.Function local-env bodyA)
-           predictionA])))
-
-(def: local-function
-  (r.Random [Arity Analysis Variable])
-  (loop [arity +0
-         nest? true]
-    (if nest?
-      (do r.Monad
-        [nest?' r.bool
-         [arity' bodyA predictionA] (recur (inc arity) nest?')]
-        (wrap [arity'
-               (#analysisL.Function (list) bodyA)
-               predictionA]))
-      (do r.Monad
-        [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
-        (wrap [arity
-               (#analysisL.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
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.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
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.init)
-                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
-                             (and (n/= arity//environment arity)
-                                  (variable/= prediction//environment output))
-                             
-                             _
-                             false)))
-            (test "Folded functions properly offset local variables."
-                  (|> function//local
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.init)
-                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
-                             (and (n/= arity//local arity)
-                                  (variable/= prediction//local output))
-                             
-                             _
-                             false)))
-            ))))
-
-(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."
-                  (|> (analysisL.apply [funcA argsA])
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.init)
-                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
-                             (and (//primitive.corresponds? funcA funcS)
-                                  (list.every? (product.uncurry //primitive.corresponds?)
-                                               (list.zip2 argsA argsS)))
-                             
-                             _
-                             false)))
-            (test "Function application on no arguments just synthesizes to the function itself."
-                  (|> (analysisL.apply [funcA (list)])
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.init)
-                      (case> (#error.Success funcS)
-                             (//primitive.corresponds? funcA funcS)
-
-                             _
-                             false)))
-            ))))
diff --git a/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux
deleted file mode 100644
index 0fd4d58c1..000000000
--- a/stdlib/test/test/lux/lang/compiler/synthesis/primitive.lux
+++ /dev/null
@@ -1,92 +0,0 @@
-(.module:
-  [lux #- primitive]
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [error]
-             text/format)
-       [lang]
-       (lang [".L" extension]
-             ["///." compiler]
-             [".L" analysis #+ Analysis]
-             ["//" synthesis #+ Synthesis]
-             (synthesis [".S" expression]))
-       ["r" math/random]
-       test))
-
-(def: #export primitive
-  (r.Random Analysis)
-  (do r.Monad
-    [primitive (: (r.Random analysisL.Primitive)
-                  ($_ r.alt
-                      (wrap [])
-                      r.bool
-                      r.nat
-                      r.int
-                      r.rev
-                      r.frac
-                      (r.unicode +5)))]
-    (wrap (#analysisL.Primitive primitive))))
-
-(def: #export (corresponds? analysis synthesis)
-  (-> Analysis Synthesis Bool)
-  (case [synthesis analysis]
-    [(#//.Primitive (#//.Text valueS))
-     (#analysisL.Primitive (#analysisL.Unit valueA))]
-    (is? valueS (:coerce Text valueA))
-    
-    [(#//.Primitive (#//.Bool valueS))
-     (#analysisL.Primitive (#analysisL.Bool valueA))]
-    (is? valueS valueA)
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysisL.Primitive (#analysisL.Nat valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysisL.Primitive (#analysisL.Int valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.I64 valueS))
-     (#analysisL.Primitive (#analysisL.Rev valueA))]
-    (is? valueS (.i64 valueA))
-    
-    [(#//.Primitive (#//.F64 valueS))
-     (#analysisL.Primitive (#analysisL.Frac valueA))]
-    (is? valueS valueA)
-    
-    [(#//.Primitive (#//.Text valueS))
-     (#analysisL.Primitive (#analysisL.Text valueA))]
-    (is? valueS valueA)
-    
-    _
-    false))
-
-(context: "Primitives."
-  (<| (times +100)
-      (do @
-        [%bool% r.bool
-         %nat% r.nat
-         %int% r.int
-         %rev% r.rev
-         %frac% r.frac
-         %text% (r.unicode +5)]
-        (`` ($_ seq
-                (~~ (do-template [   ]
-                      [(test (format "Can synthesize "  ".")
-                             (|> (#analysisL.Primitive ( ))
-                                 (expressionS.synthesizer extensionL.empty)
-                                 (///compiler.run //.init)
-                                 (case> (#error.Success (#//.Primitive ( value)))
-                                        (is?  value)
-
-                                        _
-                                        false)))]
-
-                      ["unit" #analysisL.Unit #//.Text //.unit]
-                      ["bool" #analysisL.Bool #//.Bool %bool%]
-                      ["nat"  #analysisL.Nat  #//.I64  (.i64 %nat%)]
-                      ["int"  #analysisL.Int  #//.I64  (.i64 %int%)]
-                      ["rev"  #analysisL.Rev  #//.I64  (.i64 %rev%)]
-                      ["frac" #analysisL.Frac #//.F64  %frac%]
-                      ["text" #analysisL.Text #//.Text %text%])))))))
diff --git a/stdlib/test/test/lux/lang/compiler/synthesis/structure.lux b/stdlib/test/test/lux/lang/compiler/synthesis/structure.lux
deleted file mode 100644
index b3e4d6b67..000000000
--- a/stdlib/test/test/lux/lang/compiler/synthesis/structure.lux
+++ /dev/null
@@ -1,57 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data [bool "bool/" Equivalence]
-             [product]
-             [error]
-             (collection [list]))
-       (lang ["///." compiler]
-             [".L" analysis]
-             ["//" synthesis #+ Synthesis]
-             (synthesis [".S" expression])
-             [".L" extension])
-       ["r" math/random "r/" Monad]
-       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."
-                  (|> (analysisL.sum-analysis size tagA memberA)
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.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)) (bool/= right?S))
-                                    (//primitive.corresponds? memberA valueS)))
-                             
-                             _
-                             false)))
-            ))))
-
-(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."
-                  (|> (analysisL.product-analysis membersA)
-                      (expressionS.synthesizer extensionL.empty)
-                      (///compiler.run //.init)
-                      (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
-                             (and (n/= size (list.size membersS))
-                                  (list.every? (product.uncurry //primitive.corresponds?)
-                                               (list.zip2 membersA membersS)))
-
-                             _
-                             false)))
-            ))))
diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux
deleted file mode 100644
index 9c2be5dd2..000000000
--- a/stdlib/test/test/lux/lang/syntax.lux
+++ /dev/null
@@ -1,242 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do])
-       (data [number]
-             ["e" error]
-             [text]
-             (text format
-                   ["l" lexer])
-             (collection [list]
-                         ["dict" dictionary #+ Dictionary]))
-       ["r" math/random "r/" Monad]
-       (macro [code])
-       (lang ["&" 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.bool (r/map code.bool))
-                        (|> 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)
-                    false
-
-                    (#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)
-                    false
-
-                    (#e.Success [remaining =sample])
-                    (case (&.read "" (dict.new text.Hash)
-                                  remaining)
-                      (#e.Error error)
-                      false
-
-                      (#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.bool
-         #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)
-
-                _
-                false)
-              ))))
-
-(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)
-
-                _
-                false)
-              ))))
-
-(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)
-                      true
-
-                      (#e.Success [_ parsed])
-                      false)))
-            (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)
-                      false
-
-                      (#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)
-                    false
-
-                    (#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)
-                         true
-
-                         (#e.Success [_ parsed])
-                         false)
-                       (case (&.read "" (dict.new text.Hash)
-                                     [default-cursor +0
-                                      (format "#(" unbalanced-comment ")#" ")#"
-                                              (code.to-text sample))])
-                         (#e.Error error)
-                         true
-
-                         (#e.Success [_ parsed])
-                         false)))
-            ))))
diff --git a/stdlib/test/test/lux/lang/type.lux b/stdlib/test/test/lux/lang/type.lux
deleted file mode 100644
index 0a5b42461..000000000
--- a/stdlib/test/test/lux/lang/type.lux
+++ /dev/null
@@ -1,163 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control ["M" monad #+ do Monad]
-                pipe)
-       (data [text "Text/" Monoid]
-             text/format
-             [number]
-             [maybe]
-             (collection [list]))
-       ["r" math/random]
-       (lang ["&" type]))
-  lux/test)
-
-## [Utils]
-(def: gen-name
-  (r.Random Text)
-  (do r.Monad
-    [size (|> r.nat (:: @ map (n/% +10)))]
-    (r.unicode size)))
-
-(def: gen-ident
-  (r.Random Ident)
-  (r.seq gen-name gen-name))
-
-(def: gen-type
-  (r.Random Type)
-  (let [(^open "R/") r.Monad]
-    (r.rec (function (_ gen-type)
-             ($_ r.alt
-                 (r.seq gen-name (R/wrap (list)))
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-type gen-type)
-                 r.nat
-                 r.nat
-                 r.nat
-                 (r.seq (R/wrap (list)) gen-type)
-                 (r.seq (R/wrap (list)) gen-type)
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-ident gen-type)
-                 )))))
-
-## [Tests]
-(context: "Types"
-  (<| (times +100)
-      (do @
-        [sample gen-type]
-        (test "Every type is equal to itself."
-              (:: &.Equivalence = sample sample)))))
-
-(context: "Type application"
-  (test "Can apply quantified types (universal and existential quantification)."
-        (and (maybe.default false
-                            (do maybe.Monad
-                              [partial (&.apply (list Bool) Ann)
-                               full (&.apply (list Int) partial)]
-                              (wrap (:: &.Equivalence = full (#.Product Bool Int)))))
-             (|> (&.apply (list Bool) Text)
-                 (case> #.None true _ false)))))
-
-(context: "Naming"
-  (let [base (#.Named ["" "a"] (#.Product Bool Int))
-        aliased (#.Named ["" "c"]
-                         (#.Named ["" "b"]
-                                  base))]
-    ($_ seq
-        (test "Can remove aliases from an already-named type."
-              (:: &.Equivalence =
-                  base
-                  (&.un-alias aliased)))
-
-        (test "Can remove all names from a type."
-              (and (not (:: &.Equivalence =
-                            base
-                            (&.un-name aliased)))
-                   (:: &.Equivalence =
-                       (&.un-name base)
-                       (&.un-name aliased)))))))
-
-(context: "Type construction [structs]"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (n/% +3)))
-         members (|> gen-type
-                     (r.filter (function (_ type)
-                                 (case type
-                                   (^or (#.Sum _) (#.Product _))
-                                   false
-
-                                   _
-                                   true)))
-                     (list.repeat size)
-                     (M.seq @))
-         #let [(^open "&/") &.Equivalence
-               (^open "L/") (list.Equivalence &.Equivalence)]]
-        (with-expansions
-          [ (do-template [   ]
-                            [(test (format "Can build and tear-down "  " types.")
-                                   (let [flat (|> members  )]
-                                     (or (L/= members flat)
-                                         (and (L/= (list) members)
-                                              (L/= (list ) flat)))))]
-
-                            ["variant" &.variant &.flatten-variant Nothing]
-                            ["tuple"   &.tuple   &.flatten-tuple   Any]
-                            )]
-          ($_ seq
-              
-              )))))
-
-(context: "Type construction [parameterized]"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (n/% +3)))
-         members (M.seq @ (list.repeat size gen-type))
-         extra (|> gen-type
-                   (r.filter (function (_ type)
-                               (case type
-                                 (^or (#.Function _) (#.Apply _))
-                                 false
-
-                                 _
-                                 true))))
-         #let [(^open "&/") &.Equivalence
-               (^open "L/") (list.Equivalence &.Equivalence)]]
-        ($_ seq
-            (test "Can build and tear-down function types."
-                  (let [[inputs output] (|> (&.function members extra) &.flatten-function)]
-                    (and (L/= members inputs)
-                         (&/= extra output))))
-
-            (test "Can build and tear-down application types."
-                  (let [[tfunc tparams] (|> extra (&.application members) &.flatten-application)]
-                    (n/= (list.size members) (list.size tparams))))
-            ))))
-
-(context: "Type construction [higher order]"
-  (<| (times +100)
-      (do @
-        [size (|> r.nat (:: @ map (n/% +3)))
-         extra (|> gen-type
-                   (r.filter (function (_ type)
-                               (case type
-                                 (^or (#.UnivQ _) (#.ExQ _))
-                                 false
-
-                                 _
-                                 true))))
-         #let [(^open "&/") &.Equivalence]]
-        (with-expansions
-          [ (do-template [  ]
-                           [(test (format "Can build and tear-down "  " types.")
-                                  (let [[flat-size flat-body] (|> extra ( size) )]
-                                    (and (n/= size flat-size)
-                                         (&/= extra flat-body))))]
-
-                           ["universally-quantified"   &.univ-q &.flatten-univ-q]
-                           ["existentially-quantified" &.ex-q   &.flatten-ex-q]
-                           )]
-          ($_ seq
-              
-              )))))
diff --git a/stdlib/test/test/lux/lang/type/check.lux b/stdlib/test/test/lux/lang/type/check.lux
deleted file mode 100644
index 889f05bd8..000000000
--- a/stdlib/test/test/lux/lang/type/check.lux
+++ /dev/null
@@ -1,262 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do Monad]
-                [pipe #+ case>])
-       (data [product]
-             [maybe]
-             [number]
-             [text "text/" Monoid Equivalence]
-             text/format
-             (collection [list "list/" Functor]
-                         [set]))
-       ["r" math/random]
-       (lang [type "type/" Equivalence]
-             ["@" type/check]))
-  lux/test)
-
-## [Utils]
-(def: gen-name
-  (r.Random Text)
-  (do r.Monad
-    [size (|> r.nat (:: @ map (n/% +10)))]
-    (r.unicode size)))
-
-(def: gen-ident
-  (r.Random Ident)
-  (r.seq gen-name gen-name))
-
-(def: gen-type
-  (r.Random Type)
-  (let [(^open "r/") r.Monad]
-    (r.rec (function (_ gen-type)
-             ($_ r.alt
-                 (r.seq gen-name (r/wrap (list)))
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-type gen-type)
-                 r.nat
-                 r.nat
-                 r.nat
-                 (r.seq (r/wrap (list)) gen-type)
-                 (r.seq (r/wrap (list)) gen-type)
-                 (r.seq gen-type gen-type)
-                 (r.seq gen-ident gen-type)
-                 )))))
-
-(def: (valid-type? type)
-  (-> Type Bool)
-  (case type
-    (#.Primitive name params)
-    (list.every? valid-type? params)
-    
-    (#.Ex id)
-    true
-
-    (^template []
-      ( left right)
-      (and (valid-type? left) (valid-type? right)))
-    ([#.Sum] [#.Product] [#.Function])
-
-    (#.Named name type')
-    (valid-type? type')
-
-    _
-    false))
-
-(def: (type-checks? input)
-  (-> (@.Check []) Bool)
-  (case (@.run @.fresh-context input)
-    (#.Right [])
-    true
-
-    (#.Left error)
-    false))
-
-## [Tests]
-(context: "Any and Nothing."
-  (<| (times +100)
-      (do @
-        [sample (|> gen-type (r.filter valid-type?))]
-        ($_ seq
-            (test "Any is the super-type of everything."
-                  (@.checks? Any sample))
-
-            (test "Nothing is the sub-type of everything."
-                  (@.checks? sample Nothing))
-            ))))
-
-(context: "Simple type-checking."
-  ($_ seq
-      (test "Any and Nothing match themselves."
-            (and (@.checks? Nothing Nothing)
-                 (@.checks? Any Any)))
-
-      (test "Existential types only match with themselves."
-            (and (type-checks? (do @.Monad
-                                 [[_ exT] @.existential]
-                                 (@.check exT exT)))
-                 (not (type-checks? (do @.Monad
-                                      [[_ exTL] @.existential
-                                       [_ exTR] @.existential]
-                                      (@.check exTL exTR))))))
-
-      (test "Names do not affect type-checking."
-            (and (type-checks? (do @.Monad
-                                 [[_ exT] @.existential]
-                                 (@.check (#.Named ["module" "name"] exT)
-                                          exT)))
-                 (type-checks? (do @.Monad
-                                 [[_ exT] @.existential]
-                                 (@.check exT
-                                          (#.Named ["module" "name"] exT))))
-                 (type-checks? (do @.Monad
-                                 [[_ exT] @.existential]
-                                 (@.check (#.Named ["module" "name"] exT)
-                                          (#.Named ["module" "name"] exT))))))
-
-      (test "Functions are covariant on inputs and contravariant on outputs."
-            (and (@.checks? (#.Function Nothing Any)
-                            (#.Function Any Nothing))
-                 (not (@.checks? (#.Function Any Nothing)
-                                 (#.Function Nothing Any)))))
-      ))
-
-(context: "Type application."
-  (<| (times +100)
-      (do @
-        [meta gen-type
-         data gen-type]
-        (test "Can type-check type application."
-              (and (@.checks? (|> Ann (#.Apply meta) (#.Apply data))
-                              (type.tuple (list meta data)))
-                   (@.checks? (type.tuple (list meta data))
-                              (|> Ann (#.Apply meta) (#.Apply data))))))))
-
-(context: "Primitive types."
-  (<| (times +100)
-      (do @
-        [nameL gen-name
-         nameR (|> gen-name (r.filter (|>> (text/= nameL) not)))
-         paramL gen-type
-         paramR (|> gen-type (r.filter (|>> (@.checks? paramL) not)))]
-        ($_ seq
-            (test "Primitive types match when they have the same name and the same parameters."
-                  (@.checks? (#.Primitive nameL (list paramL))
-                             (#.Primitive nameL (list paramL))))
-
-            (test "Names matter to primitive types."
-                  (not (@.checks? (#.Primitive nameL (list paramL))
-                                  (#.Primitive nameR (list paramL)))))
-
-            (test "Parameters matter to primitive types."
-                  (not (@.checks? (#.Primitive nameL (list paramL))
-                                  (#.Primitive nameL (list paramR)))))
-            ))))
-
-(context: "Type variables."
-  ($_ seq
-      (test "Type-vars check against themselves."
-            (type-checks? (do @.Monad
-                            [[id var] @.var]
-                            (@.check var var))))
-
-      (test "Can bind unbound type-vars by type-checking against them."
-            (and (type-checks? (do @.Monad
-                                 [[id var] @.var]
-                                 (@.check var .Any)))
-                 (type-checks? (do @.Monad
-                                 [[id var] @.var]
-                                 (@.check .Any var)))))
-
-      (test "Cannot rebind already bound type-vars."
-            (not (type-checks? (do @.Monad
-                                 [[id var] @.var
-                                  _ (@.check var .Bool)]
-                                 (@.check var .Nat)))))
-
-      (test "If the type bound to a var is a super-type to another, then the var is also a super-type."
-            (type-checks? (do @.Monad
-                            [[id var] @.var
-                             _ (@.check var Any)]
-                            (@.check var .Bool))))
-
-      (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type."
-            (type-checks? (do @.Monad
-                            [[id var] @.var
-                             _ (@.check var Nothing)]
-                            (@.check .Bool var))))
-      ))
-
-(def: (build-ring num-connections)
-  (-> Nat (@.Check [[Nat Type] (List [Nat Type]) [Nat Type]]))
-  (do @.Monad
-    [[head-id head-type] @.var
-     ids+types (monad.seq @ (list.repeat num-connections @.var))
-     [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type])
-                                         (do @
-                                           [_ (@.check head-type tail-type)]
-                                           (wrap [tail-id tail-type])))
-                                     [head-id head-type]
-                                     ids+types)]
-    (wrap [[head-id head-type] ids+types [tail-id tail-type]])))
-
-(context: "Rings of type variables."
-  (<| (times +100)
-      (do @
-        [num-connections (|> r.nat (:: @ map (n/% +100)))
-         boundT (|> gen-type (r.filter (|>> (case> (#.Var _) false _ true))))
-         pick-pcg (r.seq r.nat r.nat)]
-        ($_ seq
-            (test "Can create rings of variables."
-                  (type-checks? (do @.Monad
-                                  [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections)
-                                   #let [ids (list/map product.left ids+types)]
-                                   headR (@.ring head-id)
-                                   tailR (@.ring tail-id)]
-                                  (@.assert ""
-                                            (let [same-rings? (:: set.Equivalence = headR tailR)
-                                                  expected-size? (n/= (inc num-connections) (set.size headR))
-                                                  same-vars? (|> (set.to-list headR)
-                                                                 (list.sort n/<)
-                                                                 (:: (list.Equivalence number.Equivalence) = (list.sort n/< (#.Cons head-id ids))))]
-                                              (and same-rings?
-                                                   expected-size?
-                                                   same-vars?))))))
-            (test "When a var in a ring is bound, all the ring is bound."
-                  (type-checks? (do @.Monad
-                                  [[[head-id headT] ids+types tailT] (build-ring num-connections)
-                                   #let [ids (list/map product.left ids+types)]
-                                   _ (@.check headT boundT)
-                                   head-bound (@.read head-id)
-                                   tail-bound (monad.map @ @.read ids)
-                                   headR (@.ring head-id)
-                                   tailR+ (monad.map @ @.ring ids)]
-                                  (let [rings-were-erased? (and (set.empty? headR)
-                                                                (list.every? set.empty? tailR+))
-                                        same-types? (list.every? (type/= boundT) (list& (maybe.default headT head-bound)
-                                                                                        (list/map (function (_ [tail-id ?tailT])
-                                                                                                    (maybe.default (#.Var tail-id) ?tailT))
-                                                                                                  (list.zip2 ids tail-bound))))]
-                                    (@.assert ""
-                                              (and rings-were-erased?
-                                                   same-types?))))))
-            (test "Can merge multiple rings of variables."
-                  (type-checks? (do @.Monad
-                                  [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections)
-                                   [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections)
-                                   headRL-pre (@.ring head-idL)
-                                   headRR-pre (@.ring head-idR)
-                                   _ (@.check headTL headTR)
-                                   headRL-post (@.ring head-idL)
-                                   headRR-post (@.ring head-idR)]
-                                  (@.assert ""
-                                            (let [same-rings? (:: set.Equivalence = headRL-post headRR-post)
-                                                  expected-size? (n/= (n/* +2 (inc num-connections))
-                                                                      (set.size headRL-post))
-                                                  union? (:: set.Equivalence = headRL-post (set.union headRL-pre headRR-pre))]
-                                              (and same-rings?
-                                                   expected-size?
-                                                   union?))))))
-            ))
-      ))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/case.lux b/stdlib/test/test/lux/language/compiler/analysis/case.lux
new file mode 100644
index 000000000..ef54a66c1
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/case.lux
@@ -0,0 +1,194 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [bool "B/" Equivalence]
+             ["R" error]
+             [product]
+             [maybe]
+             [text "T/" Equivalence]
+             text/format
+             (collection [list "list/" Monad]
+                         [set]))
+       ["r" math/random "r/" Monad]
+       [macro #+ Monad]
+       (macro [code])
+       (language [type "type/" Equivalence]
+                 (type ["tc" check])
+                 [".L" module]
+                 (compiler [analysis]
+                           (analysis [".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)
+  (-> Bool (List [Code Code]) Code (r.Random (List Code)))
+  (case inputC
+    [_ (#.Bool _)]
+    (r/wrap (list (' true) (' false)))
+
+    (^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 (' _)))))
+        (r/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))])
+    (r/wrap (list (' [])))
+
+    (^ [_ (#.Record (list))])
+    (r/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)))
+
+    _
+    (r/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
+         (r/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)))
+         (r/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 (|>> (T/= 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 (tc.checks? outputT) not)
+                                                   _primitive.primitive)
+         exhaustive-patterns (exhaustive-branches true variantTC inputC)
+         redundant-patterns (exhaustive-branches false 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 Monad
+                                 [_ (moduleL.declare-tags variant-tags false
+                                                          (#.Named [module-name variant-name]
+                                                                   (type.variant primitivesT)))
+                                  _ (moduleL.declare-tags record-tags false
+                                                          (#.Named [module-name record-name]
+                                                                   (type.tuple primitivesT)))])
+                               (moduleL.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
new file mode 100644
index 000000000..e751f5e27
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/function.lux
@@ -0,0 +1,112 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             [maybe]
+             [product]
+             [text "text/" Equivalence]
+             text/format
+             (collection [list "list/" Functor]))
+       ["r" math/random "r/" Monad]
+       [macro]
+       (macro [code])
+       [language]
+       (language [type "type/" Equivalence]
+                 [".L" reference]
+                 (compiler [".L" init]
+                           [".L" analysis #+ Analysis]
+                           (analysis [".A" type]
+                                     [".A" expression]
+                                     ["/" function])))
+       test)
+  (// ["_." primitive]
+      ["_." structure]))
+
+(def: analyse (expressionA.analyser (:coerce language.Eval [])))
+
+(def: (check-apply expectedT num-args analysis)
+  (-> Type Nat (Meta Analysis) Bool)
+  (|> analysis
+      (typeA.with-type expectedT)
+      (macro.run (initL.compiler []))
+      (case> (#e.Success applyA)
+             (let [[funcA argsA] (analysisL.application applyA)]
+               (n/= num-args (list.size argsA)))
+
+             (#e.Error error)
+             false)))
+
+(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 (#analysisL.Function (list) (#analysisL.Reference (referenceL.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
new file mode 100644
index 000000000..5e19dd4e8
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/primitive.lux
@@ -0,0 +1,86 @@
+(.module:
+  [lux #- primitive]
+  (lux [io]
+       (control [monad #+ do]
+                pipe
+                ["ex" exception #+ exception:])
+       (data (text format)
+             ["e" error])
+       ["r" math/random "r/" Monad]
+       [macro]
+       (macro [code])
+       [language]
+       (language [".L" type "type/" Equivalence]
+                 (compiler [".L" init]
+                           [analysis #+ Analysis]
+                           (analysis [".A" type]
+                                     [".A" expression])))
+       test))
+
+(def: #export analyse (expressionA.analyser (:coerce language.Eval [])))
+
+(def: unit
+  (r.Random Code)
+  (r/wrap (' [])))
+
+(def: #export primitive
+  (r.Random [Type Code])
+  (`` ($_ r.either
+          (~~ (do-template [  ]
+                [(r.seq (r/wrap ) (r/map  ))]
+
+                [Any  code.tuple (r.list +0 ..unit)]
+                [Bool code.bool  r.bool]
+                [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 (Meta Analysis) (e.Error Analysis))
+  (|> (typeA.with-inference
+        analysis)
+      (macro.run (initL.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)
+
+                       _
+                       false)))
+      (<| (times +100)
+          (`` ($_ seq
+                  (~~ (do-template [    ]
+                        [(do @
+                           [sample ]
+                           (test (format "Can analyse "  ".")
+                                 (|> (infer-primitive  (..analyse ( sample)))
+                                     (case> (#e.Success (#analysis.Primitive ( output)))
+                                            (is? sample output)
+
+                                            _
+                                            false))))]
+
+                        ["bool" Bool #analysis.Bool r.bool code.bool]
+                        ["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
new file mode 100644
index 000000000..743c4194c
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/procedure/common.lux
@@ -0,0 +1,310 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data text/format
+             ["e" error]
+             [product]
+             (collection [array]))
+       ["r" math/random "r/" Monad]
+       [macro #+ Monad]
+       (macro [code])
+       [language]
+       (language [type "type/" Equivalence]
+                 [".L" scope]
+                 (compiler [".L" init]
+                           (analysis [".A" type])))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [  ]
+  [(def: ( procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (scopeL.with-scope ""
+           (typeA.with-type output-type
+             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                
+
+                (#e.Error error)
+                )))]
+
+  [check-success+ true false]
+  [check-failure+ false true]
+  )
+
+(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) Bool))
+            (test "Reference equality must be done with elements of the same type."
+                  (check-failure+ "lux is" (list primC antiC) Bool))
+            (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) Bool))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum integer."
+                  (check-success+ "lux int min" (list) Int))
+            (test "Can obtain maximum integer."
+                  (check-success+ "lux int max" (list) Int))
+            (test "Can convert integer to natural number."
+                  (check-success+ "lux int to-nat" (list subjectC) Nat))
+            (test "Can convert integer to frac number."
+                  (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) Bool))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) Bool))
+            (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) Bool))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) Bool))
+            (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 calculate a hash code for text."
+                  (check-success+ "lux text hash" (list subjectC) Nat))
+            (test "Can replace a text inside of a larger one (once)."
+                  (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
+            (test "Can replace a text inside of a larger one (all times)."
+                  (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
+            (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)
+                                 (|> (scopeL.with-scope ""
+                                       (scopeL.with-local [var-name arrayT]
+                                         (typeA.with-type output-type
+                                           (_primitive.analyse code))))
+                                     (macro.run (initL.compiler []))
+                                     (case> (#e.Success _)
+                                            true
+
+                                            (#e.Error error)
+                                            false)))]]
+        ($_ 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."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type elemT
+                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            (test "Can swap the value of an atomic reference."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type Bool
+                            (_primitive.analyse (` ("lux atom compare-and-swap"
+                                                    (~ (code.symbol ["" var-name]))
+                                                    (~ elemC)
+                                                    (~ elemC)))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            ))))
+
+(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/procedure/host.jvm.lux b/stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux
new file mode 100644
index 000000000..bbe4c0170
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/procedure/host.jvm.lux
@@ -0,0 +1,541 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data ["e" error]
+             [product]
+             [maybe]
+             [text "text/" Equivalence]
+             text/format
+             (collection [array]
+                         [list "list/" Fold]
+                         ["dict" dictionary]))
+       ["r" math/random "r/" Monad]
+       [macro #+ Monad]
+       (macro [code])
+       [language]
+       (language [type]
+                 (compiler [".L" init]
+                           (analysis [".A" type])
+                           (extension (analysis [".AE" host]))))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [  ]
+  [(def: ( procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (do Monad
+           [## runtime-bytecode @runtime.translate
+            ]
+           (language.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
+         (language.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                
+
+                (#e.Error error)
+                )))]
+
+  [success true false]
+  [failure false true]
+  )
+
+(do-template [  ]
+  [(def: ( syntax output-type)
+     (-> Code Type Bool)
+     (|> (do Monad
+           [## runtime-bytecode @runtime.translate
+            ]
+           (language.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse syntax))))
+         (language.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                
+
+                (#e.Error error)
+                )))]
+
+  [success' true false]
+  [failure' false true]
+  )
+
+(context: "Conversions [double + float]."
+  (with-expansions [ (do-template [  ]
+                                    [(test (format  " SUCCESS")
+                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
+                                     (test (format  " FAILURE")
+                                           (failure  (list (' [])) ))]
+
+                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
+                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
+                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
+                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
+                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
+                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
+                                    )]
+    ($_ seq
+        
+        )))
+
+(context: "Conversions [int]."
+  (with-expansions [ (do-template [  ]
+                                    [(test (format  " SUCCESS")
+                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
+                                     (test (format  " FAILURE")
+                                           (failure  (list (' [])) ))]
+
+                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
+                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
+                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
+                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
+                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
+                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
+                                    )]
+    ($_ seq
+        
+        )))
+
+(context: "Conversions [long]."
+  (with-expansions [ (do-template [  ]
+                                    [(test (format  " SUCCESS")
+                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
+                                     (test (format  " FAILURE")
+                                           (failure  (list (' [])) ))]
+
+                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
+                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
+                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
+                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
+                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
+                                    )]
+    ($_ seq
+        
+        )))
+
+(context: "Conversions [char + byte + short]."
+  (with-expansions [ (do-template [  ]
+                                    [(test (format  " SUCCESS")
+                                           (success  (list (' ("lux coerce" (+0  (+0)) []))) ))
+                                     (test (format  " FAILURE")
+                                           (failure  (list (' [])) ))]
+
+                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
+                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
+                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
+                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
+                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
+                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
+                                    )]
+    ($_ seq
+        
+        )))
+
+(do-template [  ]
+  [(context: (format "Arithmetic " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " +")   ]
+                                        [(format "jvm "  " -")   ]
+                                        [(format "jvm "  " *")   ]
+                                        [(format "jvm "  " /")   ]
+                                        [(format "jvm "  " %")   ]
+                                        )]
+       ($_ seq
+           
+           )))
+
+   (context: (format "Order " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " =")   hostAE.Boolean]
+                                        [(format "jvm "  " <")   hostAE.Boolean]
+                                        )]
+       ($_ seq
+           
+           )))
+
+   (context: (format "Bitwise " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " and")   ]
+                                        [(format "jvm "  " or")   ]
+                                        [(format "jvm "  " xor")   ]
+                                        [(format "jvm "  " shl")  "java.lang.Integer" ]
+                                        [(format "jvm "  " shr")  "java.lang.Integer" ]
+                                        [(format "jvm "  " ushr")  "java.lang.Integer" ]
+                                        )]
+       ($_ seq
+           
+           )))]
+
+
+  ["int" "java.lang.Integer" hostAE.Integer]
+  ["long" "java.lang.Long" hostAE.Long]
+  )
+
+(do-template [  ]
+  [(context: (format "Arithmetic " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " +")   ]
+                                        [(format "jvm "  " -")   ]
+                                        [(format "jvm "  " *")   ]
+                                        [(format "jvm "  " /")   ]
+                                        [(format "jvm "  " %")   ]
+                                        )]
+       ($_ seq
+           
+           )))
+
+   (context: (format "Order " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " =")   hostAE.Boolean]
+                                        [(format "jvm "  " <")   hostAE.Boolean]
+                                        )]
+       ($_ seq
+           
+           )))]
+
+
+  ["float" "java.lang.Float" hostAE.Float]
+  ["double" "java.lang.Double" hostAE.Double]
+  )
+
+(do-template [  ]
+  [(context: (format "Order " "["  "].")
+     (with-expansions [ (do-template [   ]
+                                        [(test 
+                                               (success 
+                                                        (list (' ("lux coerce" (+0  (+0)) []))
+                                                              (' ("lux coerce" (+0  (+0)) [])))
+                                                        ))]
+
+                                        [(format "jvm "  " =")   hostAE.Boolean]
+                                        [(format "jvm "  " <")   hostAE.Boolean]
+                                        )]
+       ($_ seq
+           
+           )))]
+
+
+  ["char" "java.lang.Character" hostAE.Character]
+  )
+
+(def: array-type
+  (r.Random [Text Text])
+  (let [entries (dict.entries hostAE.boxes)
+        num-entries (list.size entries)]
+    (do r.Monad
+      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
+       #let [[unboxed boxed] (: [Text Text]
+                                (|> entries
+                                    (list.nth choice)
+                                    (maybe.default ["java.lang.Object" "java.lang.Object"])))]]
+      (wrap [unboxed boxed]))))
+
+(context: "Array."
+  (<| (times +100)
+      (do @
+        [#let [cap (|>> (n/% +10) (n/max +1))]
+         [unboxed boxed] array-type
+         size (|> r.nat (:: @ map cap))
+         idx (|> r.nat (:: @ map (n/% size)))
+         level (|> r.nat (:: @ map cap))
+         #let [unboxedT (#.Primitive unboxed (list))
+               arrayT (#.Primitive "#Array" (list unboxedT))
+               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0)))
+                           ("jvm array new" (~ (code.nat size)))))
+               boxedT (#.Primitive boxed (list))
+               boxedTC (` (+0 (~ (code.text boxed)) (+0)))
+               multi-arrayT (list/fold (function (_ _ innerT)
+                                         (|> innerT (list) (#.Primitive "#Array")))
+                                       boxedT
+                                       (list.n/range +1 level))]]
+        ($_ seq
+            (test "jvm array new"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           arrayT))
+            (test "jvm array new (no nesting)"
+                  (failure "jvm array new"
+                           (list (code.nat size))
+                           unboxedT))
+            (test "jvm array new (nested/multi-level)"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           multi-arrayT))
+            (test "jvm array length"
+                  (success "jvm array length"
+                           (list arrayC)
+                           Nat))
+            (test "jvm array read"
+                  (success' (` ("jvm object cast"
+                                ("jvm array read" (~ arrayC) (~ (code.nat idx)))))
+                            boxedT))
+            (test "jvm array write"
+                  (success "jvm array write"
+                           (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) [])))
+                           arrayT))
+            ))))
+
+(def: throwables
+  (List Text)
+  (list "java.lang.Throwable"
+        "java.lang.Error"
+        "java.io.IOError"
+        "java.lang.VirtualMachineError"
+        "java.lang.Exception"
+        "java.io.IOException"
+        "java.lang.RuntimeException"))
+
+(context: "Object."
+  (<| (times +100)
+      (do @
+        [[unboxed boxed] array-type
+         [!unboxed !boxed] (|> array-type
+                               (r.filter (function (_ [!unboxed !boxed])
+                                           (not (text/= boxed !boxed)))))
+         #let [boxedT (#.Primitive boxed (list))
+               boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0))
+                           ("jvm object null")))
+               !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0))
+                            ("jvm object null")))
+               unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
+                             ("jvm object null")))]
+         throwable (|> r.nat
+                       (:: @ map (n/% (inc (list.size throwables))))
+                       (:: @ map (function (_ idx)
+                                   (|> throwables
+                                       (list.nth idx)
+                                       (maybe.default "java.lang.Object")))))
+         #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0))
+                               ("jvm object null")))]]
+        ($_ seq
+            (test "jvm object null"
+                  (success "jvm object null"
+                           (list)
+                           (#.Primitive boxed (list))))
+            (test "jvm object null (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object null"
+                               (list)
+                               (#.Primitive unboxed (list)))))
+            (test "jvm object null?"
+                  (success "jvm object null?"
+                           (list boxedC)
+                           Bool))
+            (test "jvm object synchronized"
+                  (success "jvm object synchronized"
+                           (list boxedC boxedC)
+                           boxedT))
+            (test "jvm object synchronized (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object synchronized"
+                               (list unboxedC boxedC)
+                               boxedT)))
+            (test "jvm object throw"
+                  (or (text/= "java.lang.Object" throwable)
+                      (success "jvm object throw"
+                               (list throwableC)
+                               Nothing)))
+            (test "jvm object class"
+                  (success "jvm object class"
+                           (list (code.text boxed))
+                           (#.Primitive "java.lang.Class" (list boxedT))))
+            (test "jvm object instance?"
+                  (success "jvm object instance?"
+                           (list (code.text boxed)
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (lineage)"
+                  (success "jvm object instance?"
+                           (list (' "java.lang.Object")
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (no lineage)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object instance?"
+                               (list (code.text boxed)
+                                     !boxedC)
+                               Bool)))
+            ))))
+
+(context: "Member [Static Field]."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.io.PrintStream" (list))))
+      (test "jvm member static get (inheritance out)"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member static put"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (final)"
+            (failure "jvm member static put"
+                     (list (code.text "java.lang.System")
+                           (code.text "out")
+                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (inheritance in)"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
+                                 ("jvm object null")))))
+                     Any))
+      ))
+
+(context: "Member [Virtual Field]."
+  ($_ seq
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.String" (list))))
+      (test "jvm member virtual get (inheritance out)"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "java.lang.String" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (primitive "org.omg.CORBA.ValueMember")))
+      (test "jvm member virtual put (final)"
+            (failure "jvm member virtual put"
+                     (list (code.text "javax.swing.text.html.parser.DTD")
+                           (code.text "applet")
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.swing.text.html.parser.DTD")))
+      (test "jvm member virtual put (inheritance in)"
+            (success "jvm member virtual put"
+                     (list (code.text "java.awt.GridBagConstraints")
+                           (code.text "insets")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
+                                ("jvm object null"))))
+                     (primitive "java.awt.GridBagConstraints")))
+      ))
+
+(context: "Boxing/Unboxing."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.util.GregorianCalendar")
+                           (code.text "AD"))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "java.lang.Integer" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.accessibility.AccessibleAttributeSequence")))
+      ))
+
+(context: "Member [Method]."
+  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
+                  +123))
+        intC (`' ("jvm convert long-to-int" (~ longC)))
+        stringC (' ("lux coerce" (+0 "java.lang.String" (+0))
+                    "YOLO"))
+        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
+                     ("jvm member invoke constructor" "java.util.ArrayList"
+                      ["int" ("jvm object cast" (~ intC))])))]
+    ($_ seq
+        (test "jvm member invoke static"
+              (success' (` ("jvm member invoke static"
+                            "java.lang.Long" "decode"
+                            ["java.lang.String" (~ stringC)]))
+                        (#.Primitive "java.lang.Long" (list))))
+        (test "jvm member invoke virtual"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke virtual"
+                             "java.lang.Object" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke special"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke special"
+                             "java.lang.Long" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke interface"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke interface"
+                             "java.util.Collection" "add"
+                             ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke constructor"
+              (success' (` ("jvm member invoke constructor"
+                            "java.util.ArrayList"
+                            ["int" ("jvm object cast" (~ intC))]))
+                        (All [a] (#.Primitive "java.util.ArrayList" (list a)))))
+        )))
diff --git a/stdlib/test/test/lux/language/compiler/analysis/reference.lux b/stdlib/test/test/lux/language/compiler/analysis/reference.lux
new file mode 100644
index 000000000..7016c3181
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/reference.lux
@@ -0,0 +1,102 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             [ident "ident/" Equivalence]
+             [text "text/" Equivalence])
+       ["r" math/random]
+       [macro #+ Monad]
+       (macro [code])
+       [language]
+       (language [type "type/" Equivalence]
+                 [".L" scope]
+                 [".L" module]
+                 [".L" reference]
+                 (compiler [".L" init]
+                           [".L" analysis]
+                           (analysis [".A" type]
+                                     [".A" expression])))
+       test)
+  (// ["_." primitive]))
+
+(def: analyse (expressionA.analyser (:coerce language.Eval [])))
+
+(type: Check (-> (e.Error Any) Bool))
+
+(do-template [  ]
+  [(def: 
+     Check
+     (|>> (case> (#e.Success _)
+                 
+
+                 (#e.Error _)
+                 )))]
+
+  [success? true false]
+  [failure? false true]
+  )
+
+(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
+  (-> Text [Bool Text] [Bool Text] Check Bool)
+  (|> (do Monad
+        [_ (moduleL.with-module +0 def-module
+             (moduleL.define var-name [Any
+                                       (if export?
+                                         (' {#.export? true})
+                                         (' {}))
+                                       []]))]
+        (moduleL.with-module +0 dependent-module
+          (do @
+            [_ (if import?
+                 (moduleL.import def-module)
+                 (wrap []))]
+            (typeA.with-inference
+              (..analyse (code.symbol [def-module var-name]))))))
+      (macro.run (initL.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."
+                  (|> (scopeL.with-scope scope-name
+                        (scopeL.with-local [var-name expectedT]
+                          (typeA.with-inference
+                            (..analyse (code.local-symbol var-name)))))
+                      (macro.run (initL.compiler []))
+                      (case> (^ (#e.Success [inferredT (#analysisL.Reference (referenceL.local var))]))
+                             (and (type/= expectedT inferredT)
+                                  (n/= +0 var))
+
+                             _
+                             false)))
+            (test "Can analyse definition (in the same module)."
+                  (let [def-name [def-module var-name]]
+                    (|> (do Monad
+                          [_ (moduleL.define var-name [expectedT (' {}) []])]
+                          (typeA.with-inference
+                            (..analyse (code.symbol def-name))))
+                        (moduleL.with-module +0 def-module)
+                        (macro.run (initL.compiler []))
+                        (case> (^ (#e.Success [_ inferredT (#analysisL.Reference (referenceL.constant constant-name))]))
+                               (and (type/= expectedT inferredT)
+                                    (ident/= def-name constant-name))
+
+                               _
+                               false))))
+            (test "Can analyse definition (if exported from imported module)."
+                  (reach-test var-name [true def-module] [true dependent-module] success?))
+            (test "Cannot analyse definition (if not exported from imported module)."
+                  (reach-test var-name [false def-module] [true dependent-module] failure?))
+            (test "Cannot analyse definition (if exported from non-imported module)."
+                  (reach-test var-name [true def-module] [false 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
new file mode 100644
index 000000000..177e84e52
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/analysis/structure.lux
@@ -0,0 +1,292 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [bool "bool/" Equivalence]
+             ["e" error]
+             [product]
+             [maybe]
+             [text]
+             text/format
+             (collection [list "list/" Functor]
+                         [set]))
+       ["r" math/random "r/" Monad]
+       [macro]
+       (macro [code])
+       [language]
+       (language [type "type/" Equivalence]
+                 (type ["tc" check])
+                 [".L" module]
+                 (compiler [".L" init]
+                           [".L" analysis #+ Analysis Variant Tag]
+                           (analysis [".A" type]
+                                     ["/" structure]
+                                     [".A" expression])))
+       test)
+  (// ["_." primitive]))
+
+(def: analyse (expressionA.analyser (:coerce language.Eval [])))
+
+(do-template [  ]
+  [(def: #export 
+     (All [a] (-> (Meta a) Bool))
+     (|>> (macro.run (initL.compiler []))
+          (case> (#e.Success _)
+                 
+
+                 _
+                 )))]
+
+  [check-succeeds true  false]
+  [check-fails    false true]
+  )
+
+(def: (check-sum' size tag variant)
+  (-> Nat Tag (Variant Analysis) Bool)
+  (let [variant-tag (if (get@ #analysisL.right? variant)
+                      (inc (get@ #analysisL.lefts variant))
+                      (get@ #analysisL.lefts variant))]
+    (|> size dec (n/= tag)
+        (bool/= (get@ #analysisL.right? variant))
+        (and (n/= tag variant-tag)))))
+
+(def: (check-sum type size tag analysis)
+  (-> Type Nat Tag (Meta Analysis) Bool)
+  (|> analysis
+      (typeA.with-type type)
+      (macro.run (initL.compiler []))
+      (case> (^multi (#e.Success sumA)
+                     [(analysisL.variant sumA)
+                      (#.Some variant)])
+             (check-sum' size tag variant)
+
+             _
+             false)))
+
+(def: (tagged module tags type)
+  (All [a] (-> Text (List moduleL.Tag) Type (Meta a) (Meta [Module a])))
+  (|>> (do macro.Monad
+         [_ (moduleL.declare-tags tags false type)])
+       (moduleL.with-module +0 module)))
+
+(def: (check-variant module tags type size tag analysis)
+  (-> Text (List moduleL.Tag) Type Nat Tag (Meta Analysis) Bool)
+  (|> analysis
+      (tagged module tags type)
+      (typeA.with-type type)
+      (macro.run (initL.compiler []))
+      (case> (^multi (#e.Success [_ sumA])
+                     [(analysisL.variant sumA)
+                      (#.Some variant)])
+             (check-sum' size tag variant)
+
+             _
+             false)))
+
+(def: (right-size? size)
+  (-> Nat (-> Analysis Bool))
+  (|>> analysisL.tuple list.size (n/= size)))
+
+(def: (check-record-inference module tags type size analysis)
+  (-> Text (List moduleL.Tag) Type Nat (Meta [Type Analysis]) Bool)
+  (|> analysis
+      (tagged module tags type)
+      (macro.run (initL.compiler []))
+      (case> (#e.Success [_ productT productA])
+             (and (type/= type productT)
+                  (right-size? size productA))
+
+             _
+             false)))
+
+(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 macro.Monad
+                        [[_ varT] (typeA.with-env tc.var)
+                         _ (typeA.with-env
+                             (tc.check varT variantT))]
+                        (typeA.with-type varT
+                          (/.sum ..analyse choice valueC)))
+                      (macro.run (initL.compiler []))
+                      (case> (^multi (#e.Success sumA)
+                                     [(analysisL.variant sumA)
+                                      (#.Some variant)])
+                             (check-sum' size choice variant)
+
+                             _
+                             false)))
+            (test "Cannot analyse sum through unbound type-vars."
+                  (|> (do macro.Monad
+                        [[_ varT] (typeA.with-env tc.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)))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success tupleA)
+                             (right-size? size tupleA)
+
+                             _
+                             false)))
+            (test "Can infer product."
+                  (|> (typeA.with-inference
+                        (/.product ..analyse (list/map product.right primitives)))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success [_type tupleA])
+                             (and (type/= tupleT _type)
+                                  (right-size? size tupleA))
+
+                             _
+                             false)))
+            (test "Can analyse pseudo-product (singleton tuple)"
+                  (|> (typeA.with-type singletonT
+                        (..analyse (` [(~ singletonC)])))
+                      check-succeeds))
+            (test "Can analyse product through bound type-vars."
+                  (|> (do macro.Monad
+                        [[_ varT] (typeA.with-env tc.var)
+                         _ (typeA.with-env
+                             (tc.check varT (type.tuple (list/map product.left primitives))))]
+                        (typeA.with-type varT
+                          (/.product ..analyse (list/map product.right primitives))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success tupleA)
+                             (right-size? size tupleA)
+
+                             _
+                             false)))
+            (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 macro.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
new file mode 100644
index 000000000..92051fcb4
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/synthesis/case.lux
@@ -0,0 +1,82 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                pipe)
+       (data [error "error/" Functor])
+       (language ["///." reference]
+                 ["///." compiler]
+                 [".L" analysis #+ Branch Analysis]
+                 ["//" synthesis #+ Synthesis]
+                 (synthesis [".S" expression])
+                 [".L" extension])
+       ["r" math/random "r/" Monad]
+       test)
+  [//primitive])
+
+(context: "Dummy variables."
+  (<| (times +100)
+      (do @
+        [maskedA //primitive.primitive
+         temp (|> r.nat (:: @ map (n/% +100)))
+         #let [maskA (analysisL.control/case
+                      [maskedA
+                       [[(#analysisL.Bind temp)
+                         (#analysisL.Reference (///reference.local temp))]
+                        (list)]])]]
+        (test "Dummy variables created to mask expressions get eliminated during synthesis."
+              (|> maskA
+                  (expressionS.synthesizer extensionL.empty)
+                  (///compiler.run //.init)
+                  (error/map (//primitive.corresponds? maskedA))
+                  (error.default false))))))
+
+(context: "Let expressions."
+  (<| (times +100)
+      (do @
+        [registerA r.nat
+         inputA //primitive.primitive
+         outputA //primitive.primitive
+         #let [letA (analysisL.control/case
+                     [inputA
+                      [[(#analysisL.Bind registerA)
+                        outputA]
+                       (list)]])]]
+        (test "Can detect and reify simple 'let' expressions."
+              (|> letA
+                  (expressionS.synthesizer extensionL.empty)
+                  (///compiler.run //.init)
+                  (case> (^ (#error.Success (//.branch/let [inputS registerS outputS])))
+                         (and (n/= registerA registerS)
+                              (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? outputA outputS))
+
+                         _
+                         false))))))
+
+(context: "If expressions."
+  (<| (times +100)
+      (do @
+        [then|else r.bool
+         inputA //primitive.primitive
+         thenA //primitive.primitive
+         elseA //primitive.primitive
+         #let [thenB (: Branch
+                        [(#analysisL.Simple (#analysisL.Bool true))
+                         thenA])
+               elseB (: Branch
+                        [(#analysisL.Simple (#analysisL.Bool false))
+                         elseA])
+               ifA (if then|else
+                     (analysisL.control/case [inputA [thenB (list elseB)]])
+                     (analysisL.control/case [inputA [elseB (list thenB)]]))]]
+        (test "Can detect and reify simple 'if' expressions."
+              (|> ifA
+                  (expressionS.synthesizer extensionL.empty)
+                  (///compiler.run //.init)
+                  (case> (^ (#error.Success (//.branch/if [inputS thenS elseS])))
+                         (and (//primitive.corresponds? inputA inputS)
+                              (//primitive.corresponds? thenA thenS)
+                              (//primitive.corresponds? elseA elseS))
+
+                         _
+                         false))))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/function.lux b/stdlib/test/test/lux/language/compiler/synthesis/function.lux
new file mode 100644
index 000000000..bd6c4c7a9
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/synthesis/function.lux
@@ -0,0 +1,168 @@
+(.module:
+  lux
+  (lux [io]
+       (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]
+                 [".L" analysis #+ Arity Analysis]
+                 ["//" synthesis #+ Synthesis]
+                 (synthesis [".S" expression])
+                 [".L" extension])
+       ["r" math/random]
+       test)
+  [//primitive])
+
+(def: constant-function
+  (r.Random [Arity Analysis Analysis])
+  (r.rec
+   (function (_ constant-function)
+     (do r.Monad
+       [function? r.bool]
+       (if function?
+         (do @
+           [[arity bodyA predictionA] constant-function]
+           (wrap [(inc arity)
+                  (#analysisL.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.bool]
+                                        (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
+                                                   (#analysisL.Function picked-env bodyA)
+                                                   predictionA]))
+                                          (do @
+                                            [chosen (pick (list.size current-env))]
+                                            (wrap [arity
+                                                   (#analysisL.Reference (///reference.foreign chosen))
+                                                   (maybe.assume (dict.get chosen resolver))])))))))]
+    (wrap [arity
+           (#analysisL.Function local-env bodyA)
+           predictionA])))
+
+(def: local-function
+  (r.Random [Arity Analysis Variable])
+  (loop [arity +0
+         nest? true]
+    (if nest?
+      (do r.Monad
+        [nest?' r.bool
+         [arity' bodyA predictionA] (recur (inc arity) nest?')]
+        (wrap [arity'
+               (#analysisL.Function (list) bodyA)
+               predictionA]))
+      (do r.Monad
+        [chosen (|> r.nat (:: @ map (|>> (n/% +100) (n/max +2))))]
+        (wrap [arity
+               (#analysisL.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
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.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
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.init)
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
+                             (and (n/= arity//environment arity)
+                                  (variable/= prediction//environment output))
+                             
+                             _
+                             false)))
+            (test "Folded functions properly offset local variables."
+                  (|> function//local
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.init)
+                      (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (///reference.variable output))])))
+                             (and (n/= arity//local arity)
+                                  (variable/= prediction//local output))
+                             
+                             _
+                             false)))
+            ))))
+
+(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."
+                  (|> (analysisL.apply [funcA argsA])
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.init)
+                      (case> (^ (#error.Success (//.function/apply [funcS argsS])))
+                             (and (//primitive.corresponds? funcA funcS)
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 argsA argsS)))
+                             
+                             _
+                             false)))
+            (test "Function application on no arguments just synthesizes to the function itself."
+                  (|> (analysisL.apply [funcA (list)])
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.init)
+                      (case> (#error.Success funcS)
+                             (//primitive.corresponds? funcA funcS)
+
+                             _
+                             false)))
+            ))))
diff --git a/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux
new file mode 100644
index 000000000..04e8b4dec
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/synthesis/primitive.lux
@@ -0,0 +1,92 @@
+(.module:
+  [lux #- primitive]
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [error]
+             text/format)
+       [language]
+       (language [".L" extension]
+                 ["///." compiler]
+                 [".L" analysis #+ Analysis]
+                 ["//" synthesis #+ Synthesis]
+                 (synthesis [".S" expression]))
+       ["r" math/random]
+       test))
+
+(def: #export primitive
+  (r.Random Analysis)
+  (do r.Monad
+    [primitive (: (r.Random analysisL.Primitive)
+                  ($_ r.alt
+                      (wrap [])
+                      r.bool
+                      r.nat
+                      r.int
+                      r.rev
+                      r.frac
+                      (r.unicode +5)))]
+    (wrap (#analysisL.Primitive primitive))))
+
+(def: #export (corresponds? analysis synthesis)
+  (-> Analysis Synthesis Bool)
+  (case [synthesis analysis]
+    [(#//.Primitive (#//.Text valueS))
+     (#analysisL.Primitive (#analysisL.Unit valueA))]
+    (is? valueS (:coerce Text valueA))
+    
+    [(#//.Primitive (#//.Bool valueS))
+     (#analysisL.Primitive (#analysisL.Bool valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Nat valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Int valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.I64 valueS))
+     (#analysisL.Primitive (#analysisL.Rev valueA))]
+    (is? valueS (.i64 valueA))
+    
+    [(#//.Primitive (#//.F64 valueS))
+     (#analysisL.Primitive (#analysisL.Frac valueA))]
+    (is? valueS valueA)
+    
+    [(#//.Primitive (#//.Text valueS))
+     (#analysisL.Primitive (#analysisL.Text valueA))]
+    (is? valueS valueA)
+    
+    _
+    false))
+
+(context: "Primitives."
+  (<| (times +100)
+      (do @
+        [%bool% r.bool
+         %nat% r.nat
+         %int% r.int
+         %rev% r.rev
+         %frac% r.frac
+         %text% (r.unicode +5)]
+        (`` ($_ seq
+                (~~ (do-template [   ]
+                      [(test (format "Can synthesize "  ".")
+                             (|> (#analysisL.Primitive ( ))
+                                 (expressionS.synthesizer extensionL.empty)
+                                 (///compiler.run //.init)
+                                 (case> (#error.Success (#//.Primitive ( value)))
+                                        (is?  value)
+
+                                        _
+                                        false)))]
+
+                      ["unit" #analysisL.Unit #//.Text //.unit]
+                      ["bool" #analysisL.Bool #//.Bool %bool%]
+                      ["nat"  #analysisL.Nat  #//.I64  (.i64 %nat%)]
+                      ["int"  #analysisL.Int  #//.I64  (.i64 %int%)]
+                      ["rev"  #analysisL.Rev  #//.I64  (.i64 %rev%)]
+                      ["frac" #analysisL.Frac #//.F64  %frac%]
+                      ["text" #analysisL.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
new file mode 100644
index 000000000..e3351158e
--- /dev/null
+++ b/stdlib/test/test/lux/language/compiler/synthesis/structure.lux
@@ -0,0 +1,57 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [bool "bool/" Equivalence]
+             [product]
+             [error]
+             (collection [list]))
+       (language ["///." compiler]
+                 [".L" analysis]
+                 ["//" synthesis #+ Synthesis]
+                 (synthesis [".S" expression])
+                 [".L" extension])
+       ["r" math/random "r/" Monad]
+       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."
+                  (|> (analysisL.sum-analysis size tagA memberA)
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.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)) (bool/= right?S))
+                                    (//primitive.corresponds? memberA valueS)))
+                             
+                             _
+                             false)))
+            ))))
+
+(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."
+                  (|> (analysisL.product-analysis membersA)
+                      (expressionS.synthesizer extensionL.empty)
+                      (///compiler.run //.init)
+                      (case> (#error.Success (#//.Structure (#//.Tuple membersS)))
+                             (and (n/= size (list.size membersS))
+                                  (list.every? (product.uncurry //primitive.corresponds?)
+                                               (list.zip2 membersA membersS)))
+
+                             _
+                             false)))
+            ))))
diff --git a/stdlib/test/test/lux/language/syntax.lux b/stdlib/test/test/lux/language/syntax.lux
new file mode 100644
index 000000000..9df62a608
--- /dev/null
+++ b/stdlib/test/test/lux/language/syntax.lux
@@ -0,0 +1,242 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do])
+       (data [number]
+             ["e" error]
+             [text]
+             (text format
+                   ["l" lexer])
+             (collection [list]
+                         ["dict" dictionary #+ Dictionary]))
+       ["r" math/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.bool (r/map code.bool))
+                        (|> 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)
+                    false
+
+                    (#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)
+                    false
+
+                    (#e.Success [remaining =sample])
+                    (case (&.read "" (dict.new text.Hash)
+                                  remaining)
+                      (#e.Error error)
+                      false
+
+                      (#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.bool
+         #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)
+
+                _
+                false)
+              ))))
+
+(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)
+
+                _
+                false)
+              ))))
+
+(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)
+                      true
+
+                      (#e.Success [_ parsed])
+                      false)))
+            (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)
+                      false
+
+                      (#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)
+                    false
+
+                    (#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)
+                         true
+
+                         (#e.Success [_ parsed])
+                         false)
+                       (case (&.read "" (dict.new text.Hash)
+                                     [default-cursor +0
+                                      (format "#(" unbalanced-comment ")#" ")#"
+                                              (code.to-text sample))])
+                         (#e.Error error)
+                         true
+
+                         (#e.Success [_ parsed])
+                         false)))
+            ))))
diff --git a/stdlib/test/test/lux/language/type.lux b/stdlib/test/test/lux/language/type.lux
new file mode 100644
index 000000000..ee53dd542
--- /dev/null
+++ b/stdlib/test/test/lux/language/type.lux
@@ -0,0 +1,163 @@
+(.module:
+  lux
+  (lux [io]
+       (control ["M" monad #+ do Monad]
+                pipe)
+       (data [text "Text/" Monoid]
+             text/format
+             [number]
+             [maybe]
+             (collection [list]))
+       ["r" math/random]
+       (language ["&" type]))
+  lux/test)
+
+## [Utils]
+(def: gen-name
+  (r.Random Text)
+  (do r.Monad
+    [size (|> r.nat (:: @ map (n/% +10)))]
+    (r.unicode size)))
+
+(def: gen-ident
+  (r.Random Ident)
+  (r.seq gen-name gen-name))
+
+(def: gen-type
+  (r.Random Type)
+  (let [(^open "R/") r.Monad]
+    (r.rec (function (_ gen-type)
+             ($_ r.alt
+                 (r.seq gen-name (R/wrap (list)))
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-type gen-type)
+                 r.nat
+                 r.nat
+                 r.nat
+                 (r.seq (R/wrap (list)) gen-type)
+                 (r.seq (R/wrap (list)) gen-type)
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-ident gen-type)
+                 )))))
+
+## [Tests]
+(context: "Types"
+  (<| (times +100)
+      (do @
+        [sample gen-type]
+        (test "Every type is equal to itself."
+              (:: &.Equivalence = sample sample)))))
+
+(context: "Type application"
+  (test "Can apply quantified types (universal and existential quantification)."
+        (and (maybe.default false
+                            (do maybe.Monad
+                              [partial (&.apply (list Bool) Ann)
+                               full (&.apply (list Int) partial)]
+                              (wrap (:: &.Equivalence = full (#.Product Bool Int)))))
+             (|> (&.apply (list Bool) Text)
+                 (case> #.None true _ false)))))
+
+(context: "Naming"
+  (let [base (#.Named ["" "a"] (#.Product Bool Int))
+        aliased (#.Named ["" "c"]
+                         (#.Named ["" "b"]
+                                  base))]
+    ($_ seq
+        (test "Can remove aliases from an already-named type."
+              (:: &.Equivalence =
+                  base
+                  (&.un-alias aliased)))
+
+        (test "Can remove all names from a type."
+              (and (not (:: &.Equivalence =
+                            base
+                            (&.un-name aliased)))
+                   (:: &.Equivalence =
+                       (&.un-name base)
+                       (&.un-name aliased)))))))
+
+(context: "Type construction [structs]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (n/% +3)))
+         members (|> gen-type
+                     (r.filter (function (_ type)
+                                 (case type
+                                   (^or (#.Sum _) (#.Product _))
+                                   false
+
+                                   _
+                                   true)))
+                     (list.repeat size)
+                     (M.seq @))
+         #let [(^open "&/") &.Equivalence
+               (^open "L/") (list.Equivalence &.Equivalence)]]
+        (with-expansions
+          [ (do-template [   ]
+                            [(test (format "Can build and tear-down "  " types.")
+                                   (let [flat (|> members  )]
+                                     (or (L/= members flat)
+                                         (and (L/= (list) members)
+                                              (L/= (list ) flat)))))]
+
+                            ["variant" &.variant &.flatten-variant Nothing]
+                            ["tuple"   &.tuple   &.flatten-tuple   Any]
+                            )]
+          ($_ seq
+              
+              )))))
+
+(context: "Type construction [parameterized]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (n/% +3)))
+         members (M.seq @ (list.repeat size gen-type))
+         extra (|> gen-type
+                   (r.filter (function (_ type)
+                               (case type
+                                 (^or (#.Function _) (#.Apply _))
+                                 false
+
+                                 _
+                                 true))))
+         #let [(^open "&/") &.Equivalence
+               (^open "L/") (list.Equivalence &.Equivalence)]]
+        ($_ seq
+            (test "Can build and tear-down function types."
+                  (let [[inputs output] (|> (&.function members extra) &.flatten-function)]
+                    (and (L/= members inputs)
+                         (&/= extra output))))
+
+            (test "Can build and tear-down application types."
+                  (let [[tfunc tparams] (|> extra (&.application members) &.flatten-application)]
+                    (n/= (list.size members) (list.size tparams))))
+            ))))
+
+(context: "Type construction [higher order]"
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (n/% +3)))
+         extra (|> gen-type
+                   (r.filter (function (_ type)
+                               (case type
+                                 (^or (#.UnivQ _) (#.ExQ _))
+                                 false
+
+                                 _
+                                 true))))
+         #let [(^open "&/") &.Equivalence]]
+        (with-expansions
+          [ (do-template [  ]
+                           [(test (format "Can build and tear-down "  " types.")
+                                  (let [[flat-size flat-body] (|> extra ( size) )]
+                                    (and (n/= size flat-size)
+                                         (&/= extra flat-body))))]
+
+                           ["universally-quantified"   &.univ-q &.flatten-univ-q]
+                           ["existentially-quantified" &.ex-q   &.flatten-ex-q]
+                           )]
+          ($_ seq
+              
+              )))))
diff --git a/stdlib/test/test/lux/language/type/check.lux b/stdlib/test/test/lux/language/type/check.lux
new file mode 100644
index 000000000..7b24d0f91
--- /dev/null
+++ b/stdlib/test/test/lux/language/type/check.lux
@@ -0,0 +1,262 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do Monad]
+                [pipe #+ case>])
+       (data [product]
+             [maybe]
+             [number]
+             [text "text/" Monoid Equivalence]
+             text/format
+             (collection [list "list/" Functor]
+                         [set]))
+       ["r" math/random]
+       (language [type "type/" Equivalence]
+                 (type ["@" check])))
+  lux/test)
+
+## [Utils]
+(def: gen-name
+  (r.Random Text)
+  (do r.Monad
+    [size (|> r.nat (:: @ map (n/% +10)))]
+    (r.unicode size)))
+
+(def: gen-ident
+  (r.Random Ident)
+  (r.seq gen-name gen-name))
+
+(def: gen-type
+  (r.Random Type)
+  (let [(^open "r/") r.Monad]
+    (r.rec (function (_ gen-type)
+             ($_ r.alt
+                 (r.seq gen-name (r/wrap (list)))
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-type gen-type)
+                 r.nat
+                 r.nat
+                 r.nat
+                 (r.seq (r/wrap (list)) gen-type)
+                 (r.seq (r/wrap (list)) gen-type)
+                 (r.seq gen-type gen-type)
+                 (r.seq gen-ident gen-type)
+                 )))))
+
+(def: (valid-type? type)
+  (-> Type Bool)
+  (case type
+    (#.Primitive name params)
+    (list.every? valid-type? params)
+    
+    (#.Ex id)
+    true
+
+    (^template []
+      ( left right)
+      (and (valid-type? left) (valid-type? right)))
+    ([#.Sum] [#.Product] [#.Function])
+
+    (#.Named name type')
+    (valid-type? type')
+
+    _
+    false))
+
+(def: (type-checks? input)
+  (-> (@.Check []) Bool)
+  (case (@.run @.fresh-context input)
+    (#.Right [])
+    true
+
+    (#.Left error)
+    false))
+
+## [Tests]
+(context: "Any and Nothing."
+  (<| (times +100)
+      (do @
+        [sample (|> gen-type (r.filter valid-type?))]
+        ($_ seq
+            (test "Any is the super-type of everything."
+                  (@.checks? Any sample))
+
+            (test "Nothing is the sub-type of everything."
+                  (@.checks? sample Nothing))
+            ))))
+
+(context: "Simple type-checking."
+  ($_ seq
+      (test "Any and Nothing match themselves."
+            (and (@.checks? Nothing Nothing)
+                 (@.checks? Any Any)))
+
+      (test "Existential types only match with themselves."
+            (and (type-checks? (do @.Monad
+                                 [[_ exT] @.existential]
+                                 (@.check exT exT)))
+                 (not (type-checks? (do @.Monad
+                                      [[_ exTL] @.existential
+                                       [_ exTR] @.existential]
+                                      (@.check exTL exTR))))))
+
+      (test "Names do not affect type-checking."
+            (and (type-checks? (do @.Monad
+                                 [[_ exT] @.existential]
+                                 (@.check (#.Named ["module" "name"] exT)
+                                          exT)))
+                 (type-checks? (do @.Monad
+                                 [[_ exT] @.existential]
+                                 (@.check exT
+                                          (#.Named ["module" "name"] exT))))
+                 (type-checks? (do @.Monad
+                                 [[_ exT] @.existential]
+                                 (@.check (#.Named ["module" "name"] exT)
+                                          (#.Named ["module" "name"] exT))))))
+
+      (test "Functions are covariant on inputs and contravariant on outputs."
+            (and (@.checks? (#.Function Nothing Any)
+                            (#.Function Any Nothing))
+                 (not (@.checks? (#.Function Any Nothing)
+                                 (#.Function Nothing Any)))))
+      ))
+
+(context: "Type application."
+  (<| (times +100)
+      (do @
+        [meta gen-type
+         data gen-type]
+        (test "Can type-check type application."
+              (and (@.checks? (|> Ann (#.Apply meta) (#.Apply data))
+                              (type.tuple (list meta data)))
+                   (@.checks? (type.tuple (list meta data))
+                              (|> Ann (#.Apply meta) (#.Apply data))))))))
+
+(context: "Primitive types."
+  (<| (times +100)
+      (do @
+        [nameL gen-name
+         nameR (|> gen-name (r.filter (|>> (text/= nameL) not)))
+         paramL gen-type
+         paramR (|> gen-type (r.filter (|>> (@.checks? paramL) not)))]
+        ($_ seq
+            (test "Primitive types match when they have the same name and the same parameters."
+                  (@.checks? (#.Primitive nameL (list paramL))
+                             (#.Primitive nameL (list paramL))))
+
+            (test "Names matter to primitive types."
+                  (not (@.checks? (#.Primitive nameL (list paramL))
+                                  (#.Primitive nameR (list paramL)))))
+
+            (test "Parameters matter to primitive types."
+                  (not (@.checks? (#.Primitive nameL (list paramL))
+                                  (#.Primitive nameL (list paramR)))))
+            ))))
+
+(context: "Type variables."
+  ($_ seq
+      (test "Type-vars check against themselves."
+            (type-checks? (do @.Monad
+                            [[id var] @.var]
+                            (@.check var var))))
+
+      (test "Can bind unbound type-vars by type-checking against them."
+            (and (type-checks? (do @.Monad
+                                 [[id var] @.var]
+                                 (@.check var .Any)))
+                 (type-checks? (do @.Monad
+                                 [[id var] @.var]
+                                 (@.check .Any var)))))
+
+      (test "Cannot rebind already bound type-vars."
+            (not (type-checks? (do @.Monad
+                                 [[id var] @.var
+                                  _ (@.check var .Bool)]
+                                 (@.check var .Nat)))))
+
+      (test "If the type bound to a var is a super-type to another, then the var is also a super-type."
+            (type-checks? (do @.Monad
+                            [[id var] @.var
+                             _ (@.check var Any)]
+                            (@.check var .Bool))))
+
+      (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type."
+            (type-checks? (do @.Monad
+                            [[id var] @.var
+                             _ (@.check var Nothing)]
+                            (@.check .Bool var))))
+      ))
+
+(def: (build-ring num-connections)
+  (-> Nat (@.Check [[Nat Type] (List [Nat Type]) [Nat Type]]))
+  (do @.Monad
+    [[head-id head-type] @.var
+     ids+types (monad.seq @ (list.repeat num-connections @.var))
+     [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type])
+                                         (do @
+                                           [_ (@.check head-type tail-type)]
+                                           (wrap [tail-id tail-type])))
+                                     [head-id head-type]
+                                     ids+types)]
+    (wrap [[head-id head-type] ids+types [tail-id tail-type]])))
+
+(context: "Rings of type variables."
+  (<| (times +100)
+      (do @
+        [num-connections (|> r.nat (:: @ map (n/% +100)))
+         boundT (|> gen-type (r.filter (|>> (case> (#.Var _) false _ true))))
+         pick-pcg (r.seq r.nat r.nat)]
+        ($_ seq
+            (test "Can create rings of variables."
+                  (type-checks? (do @.Monad
+                                  [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections)
+                                   #let [ids (list/map product.left ids+types)]
+                                   headR (@.ring head-id)
+                                   tailR (@.ring tail-id)]
+                                  (@.assert ""
+                                            (let [same-rings? (:: set.Equivalence = headR tailR)
+                                                  expected-size? (n/= (inc num-connections) (set.size headR))
+                                                  same-vars? (|> (set.to-list headR)
+                                                                 (list.sort n/<)
+                                                                 (:: (list.Equivalence number.Equivalence) = (list.sort n/< (#.Cons head-id ids))))]
+                                              (and same-rings?
+                                                   expected-size?
+                                                   same-vars?))))))
+            (test "When a var in a ring is bound, all the ring is bound."
+                  (type-checks? (do @.Monad
+                                  [[[head-id headT] ids+types tailT] (build-ring num-connections)
+                                   #let [ids (list/map product.left ids+types)]
+                                   _ (@.check headT boundT)
+                                   head-bound (@.read head-id)
+                                   tail-bound (monad.map @ @.read ids)
+                                   headR (@.ring head-id)
+                                   tailR+ (monad.map @ @.ring ids)]
+                                  (let [rings-were-erased? (and (set.empty? headR)
+                                                                (list.every? set.empty? tailR+))
+                                        same-types? (list.every? (type/= boundT) (list& (maybe.default headT head-bound)
+                                                                                        (list/map (function (_ [tail-id ?tailT])
+                                                                                                    (maybe.default (#.Var tail-id) ?tailT))
+                                                                                                  (list.zip2 ids tail-bound))))]
+                                    (@.assert ""
+                                              (and rings-were-erased?
+                                                   same-types?))))))
+            (test "Can merge multiple rings of variables."
+                  (type-checks? (do @.Monad
+                                  [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections)
+                                   [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections)
+                                   headRL-pre (@.ring head-idL)
+                                   headRR-pre (@.ring head-idR)
+                                   _ (@.check headTL headTR)
+                                   headRL-post (@.ring head-idL)
+                                   headRR-post (@.ring head-idR)]
+                                  (@.assert ""
+                                            (let [same-rings? (:: set.Equivalence = headRL-post headRR-post)
+                                                  expected-size? (n/= (n/* +2 (inc num-connections))
+                                                                      (set.size headRL-post))
+                                                  union? (:: set.Equivalence = headRL-post (set.union headRL-pre headRR-pre))]
+                                              (and same-rings?
+                                                   expected-size?
+                                                   union?))))))
+            ))
+      ))
diff --git a/stdlib/test/test/lux/math/modular.lux b/stdlib/test/test/lux/math/modular.lux
index dcfdb4e11..dc0d89c40 100644
--- a/stdlib/test/test/lux/math/modular.lux
+++ b/stdlib/test/test/lux/math/modular.lux
@@ -7,7 +7,7 @@
              text/format)
        (math ["r" random]
              ["/" modular])
-       (lang [type "type/" Equivalence]))
+       (language [type "type/" Equivalence]))
   lux/test)
 
 (def: %3 (/.modulus 3))
-- 
cgit v1.2.3