Re-named "lux/platform" to "lux/tool".

66 files changed, 9609 insertions, 0 deletions

diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux
new file mode 100644
index 000000000..b4fdd541e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler.lux
@@ -0,0 +1,46 @@
+(.module:
+  [lux (#- Module Source Code)
+   [control
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
+   [world
+    ["." file (#+ File)]]]
+  [/
+   [meta
+    ["." archive (#+ Archive)
+     [key (#+ Key)]
+     [descriptor (#+ Module)]
+     [document (#+ Document)]]]])
+
+(type: #export Code
+  Text)
+
+(type: #export Parameter
+  Text)
+
+(type: #export Input
+  {#module Module
+   #file File
+   #hash Nat
+   #code Code})
+
+(type: #export (Output o)
+  (Dictionary Text o))
+
+(type: #export (Compilation d o)
+  {#dependencies (List Module)
+   #process (-> Archive
+                (Error (Either (Compilation d o)
+                               [(Document d) (Output o)])))})
+
+(type: #export (Compiler d o)
+  (-> Input (Compilation d o)))
+
+(type: #export (Instancer d o)
+  (-> (Key d) (List Parameter) (Compiler d o)))
+
+(exception: #export (cannot-compile {module Module})
+  (ex.report ["Module" module]))
diff --git a/stdlib/source/lux/tool/compiler/cli.lux b/stdlib/source/lux/tool/compiler/cli.lux
new file mode 100644
index 000000000..7e92b2c34
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/cli.lux
@@ -0,0 +1,41 @@
+(.module:
+  [lux #*
+   [control
+    ["p" parser]]
+   ["." cli (#+ CLI)]
+   [world
+    [file (#+ File)]]]
+  [///
+   [importer (#+ Source)]])
+
+(type: #export Configuration
+  {#sources (List Source)
+   #target File
+   #module Text})
+
+(type: #export Service
+  (#Compilation Configuration)
+  (#Interpretation Configuration))
+
+(do-template [<name> <short> <long>]
+  [(def: #export <name>
+     (CLI Text)
+     (cli.parameter [<short> <long>]))]
+
+  [source "-s" "--source"]
+  [target "-t" "--target"]
+  [module "-m" "--module"]
+  )
+
+(def: #export configuration
+  (CLI Configuration)
+  ($_ p.and
+      (p.some ..source)
+      ..target
+      ..module))
+
+(def: #export service
+  (CLI Service)
+  ($_ p.or
+      (p.after (cli.this "build") ..configuration)
+      (p.after (cli.this "repl") ..configuration)))
diff --git a/stdlib/source/lux/tool/compiler/default.lux b/stdlib/source/lux/tool/compiler/default.lux
new file mode 100644
index 000000000..726562cc8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default.lux
@@ -0,0 +1,6 @@
+(.module:
+  [lux #*])
+
+(type: #export Version Text)
+
+(def: #export version Version "0.6.0")
diff --git a/stdlib/source/lux/tool/compiler/default/cache.lux b/stdlib/source/lux/tool/compiler/default/cache.lux
new file mode 100644
index 000000000..1770b4a82
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default/cache.lux
@@ -0,0 +1,35 @@
+(.module:
+  [lux #*
+   [data
+    [format
+     ["_" binary (#+ Format)]]]])
+
+(def: definition
+  (Format Definition)
+  ($_ _.and _.type _.code _.any))
+
+(def: alias
+  (Format [Text Text])
+  (_.and _.text _.text))
+
+## TODO: Remove #module-hash, #imports & #module-state ASAP.
+## TODO: Not just from this parser, but from the lux.Module type.
+(def: #export module
+  (Format Module)
+  ($_ _.and
+      ## #module-hash
+      (_.ignore 0)
+      ## #module-aliases
+      (_.list ..alias)
+      ## #definitions
+      (_.list (_.and _.text ..definition))
+      ## #imports
+      (_.list _.text)
+      ## #tags
+      (_.ignore (list))
+      ## #types
+      (_.ignore (list))
+      ## #module-annotations
+      (_.maybe _.code)
+      ## #module-state
+      (_.ignore #.Cached)))
diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux
new file mode 100644
index 000000000..1f21304ca
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux
@@ -0,0 +1,36 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." error]
+    [text
+     format]]]
+  [///
+   ["." phase
+    [analysis (#+ Operation)
+     [".A" expression]
+     ["." type]]
+    ["." synthesis
+     [".S" expression]]
+    ["." translation]]])
+
+(type: #export Eval
+  (-> Nat Type Code (Operation Any)))
+
+(def: #export (evaluator synthesis-state translation-state translate)
+  (All [anchor expression statement]
+    (-> synthesis.State+
+        (translation.State+ anchor expression statement)
+        (translation.Phase anchor expression statement)
+        Eval))
+  (function (eval count type exprC)
+    (do phase.monad
+      [exprA (type.with-type type
+               (expressionA.compile exprC))]
+      (phase.lift (do error.monad
+                    [exprS (|> exprA expressionS.phase (phase.run synthesis-state))]
+                    (phase.run translation-state
+                               (do phase.monad
+                                 [exprO (translate exprS)]
+                                 (translation.evaluate! (format "eval" (%n count)) exprO))))))))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
new file mode 100644
index 000000000..a416c0a3b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -0,0 +1,198 @@
+(.module:
+  [lux (#- Module loop)
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." product]
+    ["." error (#+ Error)]
+    ["." text ("#/." hash)]
+    [collection
+     ["." dictionary]]]
+   ["." macro]
+   [world
+    ["." file]]]
+  ["." //
+   ["." syntax (#+ Aliases)]
+   ["." evaluation]
+   ["/." // (#+ Compiler)
+    ["." host]
+    ["." phase
+     ["." analysis
+      ["." module]
+      [".A" expression]]
+     ["." synthesis
+      [".S" expression]]
+     ["." translation]
+     ["." statement
+      [".S" total]]
+     ["." extension
+      [".E" analysis]
+      [".E" synthesis]
+      [".E" statement]]]
+    [meta
+     [archive
+      ["." signature]
+      ["." key (#+ Key)]
+      ["." descriptor (#+ Module)]
+      ["." document]]]]])
+
+(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: refresh
+  (All [anchor expression statement]
+    (statement.Operation anchor expression statement Any))
+  (do phase.monad
+    [[bundle state] phase.get-state
+     #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state)
+                                      (get@ [#statement.translation #statement.state] state)
+                                      (get@ [#statement.translation #statement.phase] state))]]
+    (phase.set-state [statementE.bundle
+                      (update@ [#statement.analysis #statement.state]
+                               (: (-> analysis.State+ analysis.State+)
+                                  (|>> product.right
+                                       [(analysisE.bundle eval)]))
+                               state)])))
+
+(def: #export (state host translate translation-bundle)
+  (All [anchor expression statement]
+    (-> (translation.Host expression statement)
+        (translation.Phase anchor expression statement)
+        (translation.Bundle anchor expression statement)
+        (statement.State+ anchor expression statement)))
+  (let [synthesis-state [synthesisE.bundle synthesis.init]
+        translation-state [translation-bundle (translation.state host)]
+        eval (evaluation.evaluator synthesis-state translation-state translate)
+        analysis-state [(analysisE.bundle eval) (analysis.state ..info host)]]
+    [statementE.bundle
+     {#statement.analysis {#statement.state analysis-state
+                           #statement.phase expressionA.compile}
+      #statement.synthesis {#statement.state synthesis-state
+                            #statement.phase expressionS.phase}
+      #statement.translation {#statement.state translation-state
+                              #statement.phase translate}}]))
+
+(type: Reader
+  (-> Source (Error [Source Code])))
+
+(def: (reader current-module aliases)
+  (-> Module Aliases (analysis.Operation Reader))
+  (function (_ [bundle state])
+    (let [[cursor offset source-code] (get@ #.source state)]
+      (#error.Success [[bundle state]
+                       (syntax.parse current-module aliases ("lux text size" source-code))]))))
+
+(def: (read reader)
+  (-> Reader (analysis.Operation Code))
+  (function (_ [bundle compiler])
+    (case (reader (get@ #.source compiler))
+      (#error.Failure error)
+      (#error.Failure error)
+
+      (#error.Success [source' output])
+      (let [[cursor _] output]
+        (#error.Success [[bundle (|> compiler
+                                     (set@ #.source source')
+                                     (set@ #.cursor cursor))]
+                         output])))))
+
+(with-expansions [<Operation> (as-is (All [anchor expression statement]
+                                       (statement.Operation anchor expression statement Any)))]
+
+  (def: (begin hash input)
+    (-> Nat ///.Input <Operation>)
+    (statement.lift-analysis
+     (do phase.monad
+       [#let [module (get@ #///.module input)]
+        _ (module.create hash module)
+        _ (analysis.set-current-module module)]
+       (analysis.set-source-code (analysis.source (get@ #///.module input) (get@ #///.code input))))))
+
+  (def: end
+    (-> Module <Operation>)
+    (|>> module.set-compiled
+         statement.lift-analysis))
+
+  (def: (iteration reader)
+    (-> Reader <Operation>)
+    (do phase.monad
+      [code (statement.lift-analysis
+             (..read reader))
+       _ (totalS.phase code)]
+      ..refresh))
+
+  (def: (loop module)
+    (-> Module <Operation>)
+    (do phase.monad
+      [reader (statement.lift-analysis
+               (..reader module syntax.no-aliases))]
+      (function (_ state)
+        (.loop [state state]
+          (case (..iteration reader state)
+            (#error.Success [state' output])
+            (recur state')
+
+            (#error.Failure error)
+            (if (ex.match? syntax.end-of-file error)
+              (#error.Success [state []])
+              (ex.with-stack ///.cannot-compile module (#error.Failure error))))))))
+
+  (def: (compile hash input)
+    (-> Nat ///.Input <Operation>)
+    (do phase.monad
+      [#let [module (get@ #///.module input)]
+       _ (..begin hash input)
+       _ (..loop module)]
+      (..end module)))
+
+  (def: (default-dependencies prelude input)
+    (-> Module ///.Input (List Module))
+    (if (text/= prelude (get@ #///.module input))
+      (list)
+      (list prelude)))
+  )
+
+(def: #export (compiler prelude state)
+  (All [anchor expression statement]
+    (-> Module
+        (statement.State+ anchor expression statement)
+        (Compiler .Module)))
+  (function (_ key parameters input)
+    (let [hash (text/hash (get@ #///.code input))
+          dependencies (default-dependencies prelude input)]
+      {#///.dependencies dependencies
+       #///.process (function (_ archive)
+                      (do error.monad
+                        [[state' analysis-module] (phase.run' state
+                                                              (: (All [anchor expression statement]
+                                                                   (statement.Operation anchor expression statement .Module))
+                                                                 (do phase.monad
+                                                                   [_ (compile hash input)]
+                                                                   (statement.lift-analysis
+                                                                    (extension.lift
+                                                                     macro.current-module)))))
+                         #let [descriptor {#descriptor.hash hash
+                                           #descriptor.name (get@ #///.module input)
+                                           #descriptor.file (get@ #///.file input)
+                                           #descriptor.references dependencies
+                                           #descriptor.state #.Compiled}]]
+                        (wrap (#.Right [(document.write key descriptor analysis-module)
+                                        (dictionary.new text.hash)]))))})))
+
+(def: #export key
+  (Key .Module)
+  (key.key {#signature.name (name-of ..compiler)
+            #signature.version //.version}
+           (module.new 0)))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
new file mode 100644
index 000000000..7e3846c09
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -0,0 +1,109 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." product]
+    ["." error]]
+   [world
+    ["." file (#+ File)]]]
+  [//
+   ["." init]
+   ["." syntax]
+   ["/." //
+    ["." phase
+     ["." translation]
+     ["." statement]]
+    ["." cli (#+ Configuration)]
+    [meta
+     ["." archive]
+     [io
+      ["." context]]]]])
+
+(type: #export (Platform ! anchor expression statement)
+  {#host (translation.Host expression statement)
+   #phase (translation.Phase anchor expression statement)
+   #runtime (translation.Operation anchor expression statement Any)
+   #file-system (file.System !)})
+
+## (def: (write-module target-dir file-name module-name module outputs)
+##   (-> File Text Text Module Outputs (Process Any))
+##   (do (error.with-error io.monad)
+##     [_ (monad.map @ (product.uncurry (&io.write target-dir))
+##                   (dictionary.entries outputs))]
+##     (&io.write target-dir
+##                (format module-name "/" cache.descriptor-name)
+##                (encoding.to-utf8 (%code (cache/description.write file-name module))))))
+
+(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
+                  <State+> (as-is (statement.State+ anchor expression statement))
+                  <Bundle> (as-is (translation.Bundle anchor expression statement))]
+
+  (def: #export (initialize platform translation-bundle)
+    (All [! anchor expression statement]
+      (-> <Platform> <Bundle> (! <State+>)))
+    (|> platform
+        (get@ #runtime)
+        statement.lift-translation
+        (phase.run' (init.state (get@ #host platform)
+                                (get@ #phase platform)
+                                translation-bundle))
+        (:: error.functor map product.left)
+        (:: (get@ #file-system platform) lift))
+    
+    ## (case (runtimeT.translate ## (initL.compiler (io.run js.init))
+    ##        (initL.compiler (io.run hostL.init-host))
+    ##        )
+    ##   ## (#error.Success [state disk-write])
+    ##   ## (do @
+    ##   ##   [_ (&io.prepare-target target)
+    ##   ##    _ disk-write
+    ##   ##    ## _ (cache/io.pre-load sources target (commonT.load-definition state))
+    ##   ##    ]
+    ##   ##   (wrap (|> state
+    ##   ##             (set@ [#.info #.mode] #.Build))))
+
+    ##   (#error.Success [state [runtime-bc function-bc]])
+    ##   (do @
+    ##     [_ (&io.prepare-target target)
+    ##      ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
+    ##      ## _ (&io.write target (format hostL.function-class ".class") function-bc)
+    ##      ## _ (cache/io.pre-load sources target (commonT.load-definition state))
+    ##      ]
+    ##     (wrap (|> state
+    ##               (set@ [#.info #.mode] #.Build))))
+
+    ##   (#error.Failure error)
+    ##   (io.fail error))
+    )
+
+  (def: #export (compile platform configuration state)
+    (All [! anchor expression statement]
+      (-> <Platform> Configuration <State+> (! Any)))
+    (do (:: (get@ #file-system platform) &monad)
+      [input (context.read (get@ #file-system platform)
+                           (get@ #cli.sources configuration)
+                           (get@ #cli.module configuration))
+       ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
+       ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
+       ]
+      ## (case (compiler input)
+      ##   (#error.Failure error)
+      ##   (:: (get@ #file-system platform) lift (#error.Failure error))
+      
+      ##   (#error.Success))
+      (let [compiler (init.compiler syntax.prelude state)
+            compilation (compiler init.key (list) input)]
+        (case ((get@ #///.process compilation)
+               archive.empty)
+          (#error.Success more|done)
+          (case more|done
+            (#.Left more)
+            (:: (get@ #file-system platform) lift (#error.Failure "NOT DONE!"))
+            
+            (#.Right done)
+            (wrap []))
+          
+          (#error.Failure error)
+          (:: (get@ #file-system platform) lift (#error.Failure error))))))
+  )
diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux
new file mode 100644
index 000000000..c76857aab
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/default/syntax.lux
@@ -0,0 +1,561 @@
+## 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 #*
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    [number
+     ["." nat]
+     ["." int]
+     ["." rev]
+     ["." frac]]
+    ["." text
+     [lexer (#+ Offset)]
+     format]
+    [collection
+     ["." list]
+     ["." dictionary (#+ Dictionary)]]]])
+
+## TODO: Optimize how forms, tuples & records are parsed in the end.
+## There is repeated-work going on when parsing the white-space before the
+## closing parenthesis/bracket/brace.
+## That repeated-work should be avoided.
+
+## TODO: Implement "lux syntax char case!" as a custom extension.
+## That way, it should be possible to obtain the char without wrapping
+## it into a java.lang.Long, thereby improving performance.
+
+## TODO: Make an extension to take advantage of java/lang/String::indexOf<int,int>
+## to get better performance than the current "lux text index" extension.
+
+(type: Char Nat)
+
+(do-template [<name> <extension> <diff>]
+  [(template: (<name> value)
+     (<extension> value <diff>))]
+
+  [!inc   "lux i64 +" 1]
+  [!inc/2 "lux i64 +" 2]
+  [!dec   "lux i64 -" 1]
+  )
+
+(template: (!clip from to text)
+  ("lux text clip" text from to))
+
+(do-template [<name> <extension>]
+  [(template: (<name> reference subject)
+     (<extension> subject reference))]
+
+  [!n/= "lux i64 ="]
+  [!i/< "lux int <"]
+  )
+
+(do-template [<name> <extension>]
+  [(template: (<name> param subject)
+     (<extension> subject param))]
+
+  [!n/+ "lux i64 +"]
+  [!n/- "lux i64 -"]
+  )
+
+(type: #export Aliases (Dictionary Text Text))
+(def: #export no-aliases Aliases (dictionary.new text.hash))
+
+(def: #export prelude "lux")
+
+(def: #export space " ")
+
+(def: #export text-delimiter text.double-quote)
+
+(def: #export open-form "(")
+(def: #export close-form ")")
+
+(def: #export open-tuple "[")
+(def: #export close-tuple "]")
+
+(def: #export open-record "{")
+(def: #export close-record "}")
+
+(def: #export sigil "#")
+
+(def: #export digit-separator "_")
+
+(def: #export positive-sign "+")
+(def: #export negative-sign "-")
+
+(def: #export frac-separator ".")
+
+## The parts of an name are separated by a single mark.
+## E.g. module.short.
+## Only one such mark may be used in an name, since there
+## can only be 2 parts to an name (the module [before the
+## mark], and the short [after the mark]).
+## There are also some extra rules regarding name syntax,
+## encoded on the parser.
+(def: #export name-separator ".")
+
+(exception: #export (end-of-file {module Text})
+  (ex.report ["Module" (%t module)]))
+
+(def: amount-of-input-shown 64)
+
+(def: (input-at start input)
+  (-> Offset Text Text)
+  (let [end (|> start (n/+ amount-of-input-shown) (n/min ("lux text size" input)))]
+    (!clip start end input)))
+
+(exception: #export (unrecognized-input {[file line column] Cursor} {context Text} {input Text} {offset Offset})
+  (ex.report ["File" file]
+             ["Line" (%n line)]
+             ["Column" (%n column)]
+             ["Context" (%t context)]
+             ["Input" (input-at offset input)]))
+
+(exception: #export (text-cannot-contain-new-lines {text Text})
+  (ex.report ["Text" (%t text)]))
+
+(exception: #export (invalid-escape-syntax)
+  "")
+
+(exception: #export (cannot-close-composite-expression {closing-char Char} {source-code Text} {offset Offset})
+  (ex.report ["Closing Character" (text.from-code closing-char)]
+             ["Input" (format text.new-line
+                              (input-at offset source-code))]))
+
+(type: Parser
+  (-> Source (Error [Source Code])))
+
+(template: (!with-char+ @source-code-size @source-code @offset @char @else @body)
+  (if (!i/< (:coerce Int @source-code-size)
+            (:coerce Int @offset))
+    (let [@char ("lux text char" @source-code @offset)]
+      @body)
+    @else))
+
+(template: (!with-char @source-code @offset @char @else @body)
+  (!with-char+ ("lux text size" @source-code) @source-code @offset @char @else @body))
+
+(def: close-signal "CLOSE")
+
+(with-expansions [<cannot-close> (as-is (ex.throw cannot-close-composite-expression [closing-char source-code end]))]
+  (def: (read-close closing-char source-code//size source-code offset)
+    (-> Char Nat Text Offset (Error Offset))
+    (loop [end offset]
+      (<| (!with-char+ source-code//size source-code end char <cannot-close>
+            (if (!n/= closing-char char)
+              (#error.Success (!inc end))
+              (`` ("lux syntax char case!" char
+                   [[(~~ (static ..space))
+                     (~~ (static text.carriage-return))
+                     (~~ (static text.new-line))]
+                    (recur (!inc end))]
+
+                   ## else
+                   <cannot-close>))))))))
+
+(`` (do-template [<name> <close> <tag> <context>]
+      [(def: (<name> parse source)
+         (-> Parser Parser)
+         (let [[_ _ source-code] source
+               source-code//size ("lux text size" source-code)]
+           (loop [source source
+                  stack (: (List Code) #.Nil)]
+             (case (parse source)
+               (#error.Success [source' top])
+               (recur source' (#.Cons top stack))
+               
+               (#error.Failure error)
+               (let [[where offset _] source]
+                 (case (read-close (char <close>) source-code//size source-code offset)
+                   (#error.Success offset')
+                   (#error.Success [[(update@ #.column inc where) offset' source-code]
+                                    [where (<tag> (list.reverse stack))]])
+
+                   (#error.Failure error)
+                   (#error.Failure error)))))))]
+
+      ## 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.
+      [parse-form  (~~ (static ..close-form))  #.Form  "Form"]
+      [parse-tuple (~~ (static ..close-tuple)) #.Tuple "Tuple"]
+      ))
+
+(def: (parse-record parse source)
+  (-> Parser Parser)
+  (let [[_ _ source-code] source
+        source-code//size ("lux text size" source-code)]
+    (loop [source source
+           stack (: (List [Code Code]) #.Nil)]
+      (case (parse source)
+        (#error.Success [sourceF field])
+        (case (parse sourceF)
+          (#error.Success [sourceFV value])
+          (recur sourceFV (#.Cons [field value] stack))
+
+          (#error.Failure error)
+          (#error.Failure error))
+
+        (#error.Failure error)
+        (let [[where offset _] source]
+          (<| (!with-char+ source-code//size source-code offset closing-char (#error.Failure error))
+              (case (read-close (`` (char (~~ (static ..close-record)))) source-code//size source-code offset)
+                (#error.Success offset')
+                (#error.Success [[(update@ #.column inc where) offset' source-code]
+                                 [where (#.Record (list.reverse stack))]])
+
+                (#error.Failure error)
+                (#error.Failure error))))))))
+
+(template: (!guarantee-no-new-lines content body)
+  (case ("lux text index" content (static text.new-line) 0)
+    #.None
+    body
+
+    g!_
+    (ex.throw ..text-cannot-contain-new-lines content)))
+
+(template: (!read-text where offset source-code)
+  (case ("lux text index" source-code (static ..text-delimiter) offset)
+    (#.Some g!end)
+    (let [g!content (!clip offset g!end source-code)]
+      (<| (!guarantee-no-new-lines g!content)
+          (#error.Success [[(update@ #.column (n/+ (!n/- offset g!end)) where)
+                            (!inc g!end)
+                            source-code]
+                           [where
+                            (#.Text g!content)]])))
+    
+    _
+    (ex.throw unrecognized-input [where "Text" source-code offset])))
+
+(def: digit-bottom Nat (!dec (char "0")))
+(def: digit-top Nat (!inc (char "9")))
+
+(template: (!digit? char)
+  (and (!i/< (:coerce Int char) (:coerce Int (static ..digit-bottom)))
+       (!i/< (:coerce Int (static ..digit-top)) (:coerce Int char))))
+
+(`` (template: (!digit?+ char)
+      (or (!digit? char)
+          ("lux i64 =" (.char (~~ (static ..digit-separator))) char))))
+
+(`` (template: (!strict-name-char? char)
+      (not (or ("lux i64 =" (.char (~~ (static ..space))) char)
+               ("lux i64 =" (.char (~~ (static text.new-line))) char)
+
+               ("lux i64 =" (.char (~~ (static ..name-separator))) char)
+
+               ("lux i64 =" (.char (~~ (static ..open-form))) char)
+               ("lux i64 =" (.char (~~ (static ..close-form))) char)
+
+               ("lux i64 =" (.char (~~ (static ..open-tuple))) char)
+               ("lux i64 =" (.char (~~ (static ..close-tuple))) char)
+
+               ("lux i64 =" (.char (~~ (static ..open-record))) char)
+               ("lux i64 =" (.char (~~ (static ..close-record))) char)
+
+               ("lux i64 =" (.char (~~ (static ..text-delimiter))) char)
+               ("lux i64 =" (.char (~~ (static ..sigil))) char)))))
+
+(template: (!name-char?|head char)
+  (and (!strict-name-char? char)
+       (not (!digit? char))))
+
+(template: (!name-char? char)
+  (or (!strict-name-char? char)
+      (!digit? char)))
+
+(template: (!number-output <start> <end> <codec> <tag>)
+  (case (:: <codec> decode (!clip <start> <end> source-code))
+    (#error.Success output)
+    (#error.Success [[(update@ #.column (n/+ (!n/- <start> <end>)) where)
+                      <end>
+                      source-code]
+                     [where (<tag> output)]])
+
+    (#error.Failure error)
+    (#error.Failure error)))
+
+(def: no-exponent Offset 0)
+
+(with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int))
+                  <frac-output> (as-is (!number-output start end frac.decimal #.Frac))
+                  <failure> (ex.throw unrecognized-input [where "Frac" source-code offset])]
+  (def: (parse-frac source-code//size start [where offset source-code])
+    (-> Nat Offset Parser)
+    (loop [end offset
+           exponent ..no-exponent]
+      (<| (!with-char+ source-code//size source-code end char/0 <frac-output>)
+          (cond (!digit?+ char/0)
+                (recur (!inc end) exponent)
+
+                (and (or (!n/= (char "e") char/0)
+                         (!n/= (char "E") char/0))
+                     (not (is? ..no-exponent exponent)))
+                (<| (!with-char+ source-code//size source-code (!inc end) char/1 <failure>)
+                    (if (or (!n/= (`` (char (~~ (static ..positive-sign)))) char/1)
+                            (!n/= (`` (char (~~ (static ..negative-sign)))) char/1))
+                      (<| (!with-char+ source-code//size source-code (!n/+ 2 end) char/2 <failure>)
+                          (if (!digit?+ char/2)
+                            (recur (!n/+ 3 end) char/0)
+                            <failure>))
+                      <failure>))
+
+                ## else
+                <frac-output>))))
+
+  (def: (parse-signed start [where offset source-code])
+    (-> Offset Parser)
+    (let [source-code//size ("lux text size" source-code)]
+      (loop [end offset]
+        (<| (!with-char+ source-code//size source-code end char <int-output>)
+            (cond (!digit?+ char)
+                  (recur (!inc end))
+
+                  (!n/= (`` (.char (~~ (static ..frac-separator))))
+                        char)
+                  (parse-frac source-code//size start [where (!inc end) source-code])
+
+                  ## else
+                  <int-output>))))))
+
+(do-template [<name> <codec> <tag>]
+  [(template: (<name> source-code//size start where offset source-code)
+     (loop [g!end offset]
+       (<| (!with-char+ source-code//size source-code g!end g!char (!number-output start g!end <codec> <tag>))
+           (if (!digit?+ g!char)
+             (recur (!inc g!end))
+             (!number-output start g!end <codec> <tag>)))))]
+
+  [!parse-nat nat.decimal #.Nat]
+  [!parse-rev rec.decimal #.Rev]
+  )
+
+(template: (!parse-signed source-code//size offset where source-code @end)
+  (let [g!offset/1 (!inc offset)]
+    (<| (!with-char+ source-code//size source-code g!offset/1 g!char/1 @end)
+        (if (!digit? g!char/1)
+          (parse-signed offset [where (!inc/2 offset) source-code])
+          (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier)))))
+
+(with-expansions [<output> (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where)
+                                             end
+                                             source-code]
+                                            (!clip start end source-code)])]
+  (def: (parse-name-part start [where offset source-code])
+    (-> Offset Source (Error [Source Text]))
+    (let [source-code//size ("lux text size" source-code)]
+      (loop [end offset]
+        (<| (!with-char+ source-code//size source-code end char <output>)
+            (if (!name-char? char)
+              (recur (!inc end))
+              <output>))))))
+
+(template: (!new-line where)
+  ## (-> Cursor Cursor)
+  (let [[where::file where::line where::column] where]
+    [where::file (!inc where::line) 0]))
+
+(with-expansions [<end-of-file> (ex.throw end-of-file current-module)
+                  <failure> (ex.throw unrecognized-input [where "General" source-code offset/0])
+                  <close!> (#error.Failure close-signal)
+                  <consume-1> (as-is [where (!inc offset/0) source-code])
+                  <consume-2> (as-is [where (!inc/2 offset/0) source-code])]
+
+  (template: (!parse-half-name @offset @char @module)
+    (cond (!name-char?|head @char)
+          (case (..parse-name-part @offset [where (!inc @offset) source-code])
+            (#error.Success [source' name])
+            (#error.Success [source' [@module name]])
+            
+            (#error.Failure error)
+            (#error.Failure error))
+
+          ## else
+          <failure>))
+
+  (`` (def: (parse-short-name current-module [where offset/0 source-code])
+        (-> Text Source (Error [Source Name]))
+        (<| (!with-char source-code offset/0 char/0 <end-of-file>)
+            (if (!n/= (char (~~ (static ..name-separator))) char/0)
+              (let [offset/1 (!inc offset/0)]
+                (<| (!with-char source-code offset/1 char/1 <end-of-file>)
+                    (!parse-half-name offset/1 char/1 current-module)))
+              (!parse-half-name offset/0 char/0 ..prelude)))))
+
+  (template: (!parse-short-name @current-module @source @where @tag)
+    (case (..parse-short-name @current-module @source)
+      (#error.Success [source' name])
+      (#error.Success [source' [@where (@tag name)]])
+      
+      (#error.Failure error)
+      (#error.Failure error)))
+
+  (with-expansions [<simple> (as-is (#error.Success [source' ["" simple]]))]
+    (`` (def: (parse-full-name start source)
+          (-> Offset Source (Error [Source Name]))
+          (case (..parse-name-part start source)
+            (#error.Success [source' simple])
+            (let [[where' offset' source-code'] source']
+              (<| (!with-char source-code' offset' char/separator <simple>)
+                  (if (!n/= (char (~~ (static ..name-separator))) char/separator)
+                    (let [offset'' (!inc offset')]
+                      (case (..parse-name-part offset'' [where' offset'' source-code'])
+                        (#error.Success [source'' complex])
+                        (#error.Success [source'' [simple complex]])
+                        
+                        (#error.Failure error)
+                        (#error.Failure error)))
+                    <simple>)))
+            
+            (#error.Failure error)
+            (#error.Failure error)))))
+
+  (template: (!parse-full-name @offset @source @where @tag)
+    (case (..parse-full-name @offset @source)
+      (#error.Success [source' full-name])
+      (#error.Success [source' [@where (@tag full-name)]])
+      
+      (#error.Failure error)
+      (#error.Failure error)))
+
+  (`` (template: (<<closers>>)
+        [(~~ (static ..close-form))
+         (~~ (static ..close-tuple))
+         (~~ (static ..close-record))]))
+
+  ## TODO: Grammar macro for specifying syntax.
+  ## (grammar: lux-grammar
+  ##   [expression ...]
+  ##   [form "(" [#* expression] ")"])
+  
+  (with-expansions [<parse> (as-is (parse current-module aliases source-code//size))
+                    <horizontal-move> (as-is (recur [(update@ #.column inc where)
+                                                     (!inc offset/0)
+                                                     source-code]))]
+    (def: #export (parse current-module aliases source-code//size)
+      (-> Text Aliases Nat (-> Source (Error [Source Code])))
+      ## The "exec []" is only there to avoid function fusion.
+      ## This is to preserve the loop as much as possible and keep it tight.
+      (exec []
+        (function (recur [where offset/0 source-code])
+          (<| (!with-char+ source-code//size source-code offset/0 char/0 <end-of-file>)
+              ## The space was singled-out for special treatment
+              ## because of how common it is.
+              (`` (if (!n/= (char (~~ (static ..space))) char/0)
+                    <horizontal-move>
+                    ("lux syntax char case!" char/0
+                     [## New line
+                      [(~~ (static text.carriage-return))]
+                      <horizontal-move>
+                      
+                      [(~~ (static text.new-line))]
+                      (recur [(!new-line where) (!inc offset/0) source-code])
+
+                      ## Form
+                      [(~~ (static ..open-form))]
+                      (parse-form <parse> <consume-1>)
+
+                      ## Tuple
+                      [(~~ (static ..open-tuple))]
+                      (parse-tuple <parse> <consume-1>)
+
+                      ## Record
+                      [(~~ (static ..open-record))]
+                      (parse-record <parse> <consume-1>)
+
+                      ## Text
+                      [(~~ (static ..text-delimiter))]
+                      (let [offset/1 (!inc offset/0)]
+                        (!read-text where offset/1 source-code))
+
+                      ## Special code
+                      [(~~ (static ..sigil))]
+                      (let [offset/1 (!inc offset/0)]
+                        (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+                            ("lux syntax char case!" char/1
+                             [(~~ (do-template [<char> <bit>]
+                                    [[<char>]
+                                     (#error.Success [[(update@ #.column (|>> !inc/2) where)
+                                                       (!inc offset/1)
+                                                       source-code]
+                                                      [where (#.Bit <bit>)]])]
+
+                                    ["0" #0]
+                                    ["1" #1]))
+
+                              ## Single-line comment
+                              [(~~ (static ..sigil))]
+                              (case ("lux text index" source-code (static text.new-line) offset/1)
+                                (#.Some end)
+                                (recur [(!new-line where) (!inc end) source-code])
+                                
+                                _
+                                <end-of-file>)
+
+                              [(~~ (static ..name-separator))]
+                              (!parse-short-name current-module <consume-2> where #.Tag)]
+
+                             ## else
+                             (cond (!name-char?|head char/1) ## Tag
+                                   (!parse-full-name offset/1 <consume-2> where #.Tag)
+
+                                   ## else
+                                   <failure>))))
+
+                      ## Coincidentally (= name-separator frac-separator)
+                      [(~~ (static ..name-separator))]
+                      (let [offset/1 (!inc offset/0)]
+                        (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+                            (if (!digit? char/1)
+                              (let [offset/2 (!inc offset/1)]
+                                (!parse-rev source-code//size offset/0 where offset/2 source-code))
+                              (!parse-short-name current-module [where offset/1 source-code] where #.Identifier))))
+
+                      [(~~ (static ..positive-sign))
+                       (~~ (static ..negative-sign))]
+                      (!parse-signed source-code//size offset/0 where source-code <end-of-file>)
+
+                      ## Invalid characters at this point...
+                      (~~ (<<closers>>))
+                      <close!>]
+
+                     ## else
+                     (if (!digit? char/0)
+                       ## Natural number
+                       (let [offset/1 (!inc offset/0)]
+                         (!parse-nat source-code//size offset/0 where offset/1 source-code))
+                       ## Identifier
+                       (!parse-full-name offset/0 <consume-1> where #.Identifier))
+                     )))
+              )))
+      ))
+  )
diff --git a/stdlib/source/lux/tool/compiler/host.lux b/stdlib/source/lux/tool/compiler/host.lux
new file mode 100644
index 000000000..218de67a4
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/host.lux
@@ -0,0 +1,18 @@
+(.module:
+  lux)
+
+(type: #export Host Text)
+
+(do-template [<name> <value>]
+  [(def: #export <name> Host <value>)]
+
+  [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/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
new file mode 100644
index 000000000..c318bfaf7
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -0,0 +1,77 @@
+(.module:
+  [lux (#- Module)
+   [control
+    ["ex" exception (#+ exception:)]
+    ["." equivalence (#+ Equivalence)]
+    ["." monad (#+ do)]]
+   [data
+    ["." error (#+ Error)]
+    ["." name]
+    ["." text
+     format]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
+   [type (#+ :share)
+    abstract]
+   [world
+    [file (#+ File)]]]
+  [///
+   [default (#+ Version)]]
+  [/
+   ["." signature (#+ Signature)]
+   ["." key (#+ Key)]
+   ["." descriptor (#+ Module Descriptor)]
+   ["." document (#+ Document)]])
+
+## Archive
+(exception: #export (unknown-document {name Module})
+  (ex.report ["Module" name]))
+
+(exception: #export (cannot-replace-document {name Module}
+                                             {old (Document Any)}
+                                             {new (Document Any)})
+  (ex.report ["Module" name]
+             ["Old key" (signature.description (document.signature old))]
+             ["New key" (signature.description (document.signature new))]))
+
+(with-expansions [<Document> (as-is (type (Ex [d] (Document d))))]
+  (abstract: #export Archive
+    {}
+    
+    (Dictionary Text [Descriptor <Document>])
+
+    (def: #export empty
+      Archive
+      (:abstraction (dictionary.new text.hash)))
+
+    (def: #export (add name descriptor document archive)
+      (-> Module Descriptor <Document> Archive (Error Archive))
+      (case (dictionary.get name (:representation archive))
+        (#.Some existing)
+        (if (is? document existing)
+          (#error.Success archive)
+          (ex.throw cannot-replace-document [name existing document]))
+        
+        #.None
+        (#error.Success (|> archive
+                            :representation
+                            (dictionary.put name [descriptor document])
+                            :abstraction))))
+
+    (def: #export (find name archive)
+      (-> Module Archive (Error [Descriptor <Document>]))
+      (case (dictionary.get name (:representation archive))
+        (#.Some document)
+        (#error.Success document)
+        
+        #.None
+        (ex.throw unknown-document [name])))
+
+    (def: #export (merge additions archive)
+      (-> Archive Archive (Error Archive))
+      (monad.fold error.monad
+                  (function (_ [name' descriptor+document'] archive')
+                    (..add name' descriptor+document' archive'))
+                  archive
+                  (dictionary.entries (:representation additions))))
+    ))
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
new file mode 100644
index 000000000..328240e6c
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
@@ -0,0 +1,16 @@
+(.module:
+  [lux (#- Module)
+   [data
+    [collection
+     [set (#+ Set)]]]
+   [world
+    [file (#+ File)]]])
+
+(type: #export Module Text)
+
+(type: #export Descriptor
+  {#hash Nat
+   #name Module
+   #file File
+   #references (Set Module)
+   #state Module-State})
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/lux/tool/compiler/meta/archive/document.lux
new file mode 100644
index 000000000..5c077080f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/archive/document.lux
@@ -0,0 +1,49 @@
+(.module:
+  [lux (#- Module)
+   [control
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
+   [type (#+ :share)
+    abstract]]
+  [//
+   ["." signature (#+ Signature)]
+   ["." key (#+ Key)]
+   [descriptor (#+ Module)]])
+
+## Document
+(exception: #export (invalid-signature {expected Signature} {actual Signature})
+  (ex.report ["Expected" (signature.description expected)]
+             ["Actual" (signature.description actual)]))
+
+(abstract: #export (Document d)
+  {}
+  
+  {#signature Signature
+   #content d}
+
+  (def: #export (read key document)
+    (All [d] (-> (Key d) (Document Any) (Error d)))
+    (let [[document//signature document//content] (:representation document)]
+      (if (:: signature.equivalence =
+              (key.signature key)
+              document//signature)
+        (#error.Success (:share [e]
+                                {(Key e)
+                                 key}
+                                {e
+                                 document//content}))
+        (ex.throw invalid-signature [(key.signature key)
+                                     document//signature]))))
+
+  (def: #export (write key content)
+    (All [d] (-> (Key d) d (Document d)))
+    (:abstraction {#signature (key.signature key)
+                   #content content}))
+
+  (def: #export signature
+    (-> (Document Any) Signature)
+    (|>> :representation (get@ #signature)))
+  )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/lux/tool/compiler/meta/archive/key.lux
new file mode 100644
index 000000000..50c10ac01
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/archive/key.lux
@@ -0,0 +1,20 @@
+(.module:
+  [lux #*
+   [type
+    abstract]]
+  [//
+   [signature (#+ Signature)]])
+
+(abstract: #export (Key k)
+  {}
+
+  Signature
+
+  (def: #export signature
+    (-> (Key Any) Signature)
+    (|>> :representation))
+
+  (def: #export (key signature sample)
+    (All [d] (-> Signature d (Key d)))
+    (:abstraction signature))
+  )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
new file mode 100644
index 000000000..fb96aec58
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
@@ -0,0 +1,23 @@
+(.module:
+  [lux #*
+   [control
+    ["." equivalence (#+ Equivalence)]]
+   [data
+    ["." name]
+    ["." text
+     format]]]
+  [////
+   [default (#+ Version)]])
+
+## Key
+(type: #export Signature
+  {#name Name
+   #version Version})
+
+(def: #export equivalence
+  (Equivalence Signature)
+  (equivalence.product name.equivalence text.equivalence))
+
+(def: #export (description signature)
+  (-> Signature Text)
+  (format (%name (get@ #name signature)) " " (get@ #version signature)))
diff --git a/stdlib/source/lux/tool/compiler/meta/cache.lux b/stdlib/source/lux/tool/compiler/meta/cache.lux
new file mode 100644
index 000000000..7ba16878a
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/cache.lux
@@ -0,0 +1,178 @@
+(.module:
+  [lux (#- Module)
+   [control
+    ["." monad (#+ Monad do)]
+    ["ex" exception (#+ exception:)]
+    pipe]
+   [data
+    ["." bit ("#/." equivalence)]
+    ["." maybe]
+    ["." error]
+    ["." product]
+    [format
+     ["." binary (#+ Format)]]
+    ["." text
+     [format (#- Format)]]
+    [collection
+     ["." 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-file {file File})
+  (ex.report ["File" file]))
+
+(exception: #export (stale-document {module ///.Module} {current-hash Nat} {stale-hash Nat})
+  (ex.report ["Module" module]
+             ["Current hash" (%n current-hash)]
+             ["Stale hash" (%n stale-hash)]))
+
+(exception: #export (mismatched-signature {module ///.Module} {expected Signature} {actual Signature})
+  (ex.report ["Module" module]
+             ["Expected" (archive.describe expected)]
+             ["Actual" (archive.describe actual)]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [cannot-load-definition]
+  )
+
+## General
+(def: #export (cached System<m> root)
+  (All [m] (-> (System m) File (m (List File))))
+  (|> root
+      (io/archive.archive System<m>)
+      (do> (:: System<m> &monad)
+           [(:: System<m> files)]
+           [(monad.map @ (function (recur file)
+                           (do @
+                             [is-dir? (:: System<m> directory? file)]
+                             (if is-dir?
+                               (|> file
+                                   (do> @
+                                        [(:: System<m> files)]
+                                        [(monad.map @ recur)]
+                                        [list.concat
+                                         (list& (maybe.assume (io/archive.module System<m> root file)))
+                                         wrap]))
+                               (wrap (list))))))]
+           [list.concat wrap])))
+
+## Clean
+(def: (delete System<m> document)
+  (All [m] (-> (System m) File (m Any)))
+  (do (:: System<m> &monad)
+    [deleted? (:: System<m> delete document)]
+    (if deleted?
+      (wrap [])
+      (:: System<m> throw cannot-delete-file document))))
+
+(def: (un-install System<m> root module)
+  (All [m] (-> (System m) File Module (m Any)))
+  (let [document (io/archive.document System<m> root module)]
+    (|> document
+        (do> (:: System<m> &monad)
+             [(:: System<m> files)]
+             [(monad.map @ (function (_ file)
+                             (do @
+                               [? (:: System<m> directory? file)]
+                               (if ?
+                                 (wrap #0)
+                                 (do @
+                                   [_ (..delete System<m> file)]
+                                   (wrap #1))))))]
+             [(list.every? (bit/= #1))
+              (if> [(..delete System<m> document)]
+                   [(wrap [])])]))))
+
+(def: #export (clean System<m> root wanted-modules)
+  (All [m] (-> (System m) File (Set Module) (m Any)))
+  (|> root
+      (do> (:: System<m> &monad)
+           [(..cached System<m>)]
+           [(list.filter (bit.complement (set.member? wanted-modules)))
+            (monad.map @ (un-install System<m> root))])))
+
+## Load
+(def: signature
+  (Format Signature)
+  ($_ binary.and binary.name binary.text))
+
+(def: descriptor
+  (Format Descriptor)
+  ($_ binary.and binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))
+
+(def: document
+  (All [a] (-> (Format a) (Format [Signature Descriptor a])))
+  (|>> ($_ binary.and ..signature ..descriptor)))
+
+(def: (load-document System<m> contexts root key binary module)
+  (All [m d] (-> (System m) (List File) File (Key d) (Format d) Module
+                 (m (Maybe [Dependency (Document d)]))))
+  (do (:: System<m> &monad)
+    [document' (:: System<m> read (io/archive.document System<m> root module))
+     [module' source-code] (io/context.read System<m> 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 mismatched-signature [module (get@ #archive.signature key) signature]
+                          (:: archive.equivalence =
+                              (get@ #archive.signature key)
+                              signature))
+             _ (ex.assert stale-document [module current-hash document-hash]
+                          (n/= current-hash document-hash))
+             document (archive.write key signature descriptor content)]
+            (wrap [[module references] document]))
+      (#error.Success [dependency document])
+      (wrap (#.Some [dependency document]))
+      
+      (#error.Failure error)
+      (do @
+        [_ (un-install System<m> root module)]
+        (wrap #.None)))))
+
+(def: #export (load-archive System<m> contexts root key binary)
+  (All [m d] (-> (System m) (List Context) File (Key d) (Format d) (m Archive)))
+  (do (:: System<m> &monad)
+    [candidate (|> root
+                   (do> @
+                        [(..cached System<m>)]
+                        [(monad.map @ (load-document System<m> 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/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
new file mode 100644
index 000000000..4664ade1d
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
@@ -0,0 +1,53 @@
+(.module:
+  [lux (#- Module)
+   [data
+    ["." text]
+    [collection
+     ["." 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/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux
new file mode 100644
index 000000000..dd261a539
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/io.lux
@@ -0,0 +1,16 @@
+(.module:
+  [lux (#- Module Code)
+   [data
+    ["." text]]
+   [world
+    [file (#+ File System)]]])
+
+(type: #export Context File)
+
+(type: #export Module Text)
+
+(type: #export Code Text)
+
+(def: #export (sanitize system)
+  (All [m] (-> (System m) Text Text))
+  (text.replace-all "/" (:: system separator)))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
new file mode 100644
index 000000000..354f84460
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -0,0 +1,74 @@
+(.module:
+  [lux (#- Module)
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error]
+    ["." text
+     format]]
+   [world
+    ["." file (#+ File System)]
+    [binary (#+ Binary)]]]
+  ["." // (#+ Module)
+   [///
+    ["." host]]])
+
+(type: #export Document File)
+
+(exception: #export (cannot-prepare {archive File} {module Module})
+  (ex.report ["Archive" archive]
+             ["Module" module]))
+
+(def: #export (archive System<m> root)
+  (All [m] (-> (System m) File File))
+  (<| (format root (:: System<m> 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<m> root module)
+  (All [m] (-> (System m) File Module Document))
+  (let [archive (..archive System<m> root)]
+    (|> module
+        (//.sanitize System<m>)
+        (format archive (:: System<m> separator)))))
+
+(def: #export (prepare System<m> root module)
+  (All [m] (-> (System m) File Module (m Any)))
+  (do (:: System<m> &monad)
+    [#let [archive (..archive System<m> root)
+           document (..document System<m> root module)]
+     document-exists? (file.exists? System<m> document)]
+    (if document-exists?
+      (wrap [])
+      (do @
+        [outcome (:: System<m> try (:: System<m> make-directory document))]
+        (case outcome
+          (#error.Success output)
+          (wrap output)
+
+          (#error.Failure _)
+          (:: System<m> throw cannot-prepare [archive module]))))))
+
+(def: #export (write System<m> root content name)
+  (All [m] (-> (System m) File Binary Text (m Any)))
+  (:: System<m> write content (..document System<m> root name)))
+
+(def: #export (module System<m> root document)
+  (All [m] (-> (System m) File Document (Maybe Module)))
+  (case (text.split-with (..archive System<m> root) document)
+    (#.Some ["" post])
+    (let [raw (text.replace-all (:: System<m> separator) "/" post)]
+      (if (text.starts-with? "/" raw)
+        (text.clip' 1 raw)
+        (#.Some raw)))
+
+    _
+    #.None))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
new file mode 100644
index 000000000..be72e4ccc
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -0,0 +1,107 @@
+(.module:
+  [lux (#- Module Code)
+   [control
+    monad
+    ["ex" exception (#+ Exception exception:)]]
+   [data
+    ["." error]
+    [text
+     format
+     ["." encoding]]]
+   [world
+    ["." file (#+ File)]
+    [binary (#+ Binary)]]]
+  ["." // (#+ Context Code)
+   [//
+    [archive
+     [descriptor (#+ Module)]]
+    ["//." // (#+ Input)
+     ["." host]]]])
+
+(do-template [<name>]
+  [(exception: #export (<name> {module Module})
+     (ex.report ["Module" module]))]
+
+  [cannot-find-module]
+  [cannot-read-module]
+  )
+
+(type: #export Extension Text)
+
+(def: lux-extension
+  Extension
+  ".lux")
+
+(def: partial-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: full-host-extension
+  Extension
+  (format partial-host-extension lux-extension))
+
+(def: #export (file System<m> context module)
+  (All [m] (-> (file.System m) Context Module File))
+  (|> module
+      (//.sanitize System<m>)
+      (format context (:: System<m> separator))))
+
+(def: (find-source-file System<m> contexts module extension)
+  (All [!]
+    (-> (file.System !) (List Context) Module Extension
+        (! (Maybe File))))
+  (case contexts
+    #.Nil
+    (:: (:: System<m> &monad) wrap #.None)
+
+    (#.Cons context contexts')
+    (do (:: System<m> &monad)
+      [#let [file (format (..file System<m> context module) extension)]
+       ? (file.exists? System<m> file)]
+      (if ?
+        (wrap (#.Some file))
+        (find-source-file System<m> contexts' module extension)))))
+
+(def: (try System<m> computations exception message)
+  (All [m a e] (-> (file.System m) (List (m (Maybe a))) (Exception e) e (m a)))
+  (case computations
+    #.Nil
+    (:: System<m> throw exception message)
+
+    (#.Cons computation computations')
+    (do (:: System<m> &monad)
+      [outcome computation]
+      (case outcome
+        (#.Some output)
+        (wrap output)
+
+        #.None
+        (try System<m> computations' exception message)))))
+
+(def: #export (read System<m> contexts module)
+  (All [!]
+    (-> (file.System !) (List Context) Module
+        (! Input)))
+  (let [find-source-file' (find-source-file System<m> contexts module)]
+    (do (:: System<m> &monad)
+      [file (try System<m>
+                 (list (find-source-file' ..full-host-extension)
+                       (find-source-file' ..lux-extension))
+                 ..cannot-find-module [module])
+       binary (:: System<m> read file)]
+      (case (encoding.from-utf8 binary)
+        (#error.Success code)
+        (wrap {#////.module module
+               #////.file file
+               #////.code code})
+        
+        (#error.Failure _)
+        (:: System<m> throw ..cannot-read-module [module])))))
diff --git a/stdlib/source/lux/tool/compiler/name.lux b/stdlib/source/lux/tool/compiler/name.lux
new file mode 100644
index 000000000..394bdb2db
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/name.lux
@@ -0,0 +1,47 @@
+(.module:
+  [lux #*
+   [data
+    ["." maybe]
+    ["." text
+     format]]])
+
+(`` (template: (!sanitize char)
+      ("lux syntax char case!" char
+       [["*"] "_AS"
+        ["+"] "_PL"
+        ["-"] "_DS"
+        ["/"] "_SL"
+        ["\"] "_BS"
+        ["_"] "_US"
+        ["%"] "_PC"
+        ["$"] "_DL"
+        ["'"] "_QU"
+        ["`"] "_BQ"
+        ["@"] "_AT"
+        ["^"] "_CR"
+        ["&"] "_AA"
+        ["="] "_EQ"
+        ["!"] "_BG"
+        ["?"] "_QM"
+        [":"] "_CO"
+        ["."] "_PD"
+        [","] "_CM"
+        ["<"] "_LT"
+        [">"] "_GT"
+        ["~"] "_TI"
+        ["|"] "_PI"]
+       (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)
+               (|> ("lux text char" name idx) !sanitize (format output)))
+        output))))
+
+(def: #export (definition [module short])
+  (-> Name Text)
+  (format (normalize module) "___" (normalize short)))
diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux
new file mode 100644
index 000000000..66abcc6cd
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase.lux
@@ -0,0 +1,115 @@
+(.module:
+  [lux #*
+   [control
+    ["." state]
+    ["ex" exception (#+ Exception exception:)]
+    [monad (#+ do)]]
+   [data
+    ["." product]
+    ["." error (#+ Error) ("#/." functor)]
+    ["." text
+     format]]
+   [time
+    ["." instant]
+    ["." duration]]
+   ["." io]
+   [macro
+    ["s" syntax (#+ syntax:)]]])
+
+(type: #export (Operation s o)
+  (state.State' Error s o))
+
+(def: #export monad
+  (state.monad error.monad))
+
+(type: #export (Phase s i o)
+  (-> i (Operation s o)))
+
+(def: #export (run' state operation)
+  (All [s o]
+    (-> s (Operation s o) (Error [s o])))
+  (operation state))
+
+(def: #export (run state operation)
+  (All [s o]
+    (-> s (Operation s o) (Error o)))
+  (|> state
+      operation
+      (:: error.monad map product.right)))
+
+(def: #export get-state
+  (All [s o]
+    (Operation s s))
+  (function (_ state)
+    (#error.Success [state state])))
+
+(def: #export (set-state state)
+  (All [s o]
+    (-> s (Operation s Any)))
+  (function (_ _)
+    (#error.Success [state []])))
+
+(def: #export (sub [get set] operation)
+  (All [s s' o]
+    (-> [(-> s s') (-> s' s s)]
+        (Operation s' o)
+        (Operation s o)))
+  (function (_ state)
+    (do error.monad
+      [[state' output] (operation (get state))]
+      (wrap [(set state' state) output]))))
+
+(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)))
+
+(def: #export (lift error)
+  (All [s a] (-> (Error a) (Operation s a)))
+  (function (_ state)
+    (error/map (|>> [state]) error)))
+
+(syntax: #export (assert exception message test)
+  (wrap (list (` (if (~ test)
+                   (:: ..monad (~' wrap) [])
+                   (..throw (~ exception) (~ message)))))))
+
+(def: #export (with-stack exception message action)
+  (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
+  (<<| (ex.with-stack exception message)
+       action))
+
+(def: #export identity
+  (All [s a] (Phase s a a))
+  (function (_ input state)
+    (#error.Success [state input])))
+
+(def: #export (compose pre post)
+  (All [s0 s1 i t o]
+    (-> (Phase s0 i t)
+        (Phase s1 t o)
+        (Phase [s0 s1] i o)))
+  (function (_ input [pre/state post/state])
+    (do error.monad
+      [[pre/state' temp] (pre input pre/state)
+       [post/state' output] (post temp post/state)]
+      (wrap [[pre/state' post/state'] output]))))
+
+(def: #export (timed definition description operation)
+  (All [s a]
+    (-> Name Text (Operation s a) (Operation s a)))
+  (do ..monad
+    [_ (wrap [])
+     #let [pre (io.run instant.now)]
+     output operation
+     #let [_ (log! (|> instant.now
+                       io.run
+                       instant.relative
+                       (duration.difference (instant.relative pre))
+                       %duration
+                       (format (%name definition) " [" description "]: ")))]]
+    (wrap output)))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis.lux b/stdlib/source/lux/tool/compiler/phase/analysis.lux
new file mode 100644
index 000000000..845346482
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis.lux
@@ -0,0 +1,349 @@
+(.module:
+  [lux (#- nat int rev)
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." product]
+    ["." error]
+    ["." maybe]
+    ["." text ("#/." equivalence)
+     format]
+    [collection
+     ["." list ("#/." functor fold)]]]
+   ["." function]]
+  [//
+   ["." extension (#+ Extension)]
+   [//
+    ["." reference (#+ Register Variable Reference)]]])
+
+(type: #export #rec Primitive
+  #Unit
+  (#Bit Bit)
+  (#Nat Nat)
+  (#Int Int)
+  (#Rev Rev)
+  (#Frac Frac)
+  (#Text Text))
+
+(type: #export Tag Nat)
+
+(type: #export (Variant a)
+  {#lefts Nat
+   #right? Bit
+   #value a})
+
+(type: #export (Tuple a) (List a))
+
+(type: #export (Composite a)
+  (#Variant (Variant a))
+  (#Tuple (Tuple a)))
+
+(type: #export #rec Pattern
+  (#Simple Primitive)
+  (#Complex (Composite Pattern))
+  (#Bind Register))
+
+(type: #export (Branch' e)
+  {#when Pattern
+   #then e})
+
+(type: #export (Match' e)
+  [(Branch' e) (List (Branch' e))])
+
+(type: #export Environment
+  (List Variable))
+
+(type: #export #rec Analysis
+  (#Primitive Primitive)
+  (#Structure (Composite Analysis))
+  (#Reference Reference)
+  (#Case Analysis (Match' Analysis))
+  (#Function Environment Analysis)
+  (#Apply Analysis Analysis)
+  (#Extension (Extension Analysis)))
+
+(type: #export Branch
+  (Branch' Analysis))
+
+(type: #export Match
+  (Match' Analysis))
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<tag> content))]
+
+  [control/case #..Case]
+  )
+
+(do-template [<name> <type> <tag>]
+  [(def: #export <name>
+     (-> <type> Analysis)
+     (|>> <tag> #..Primitive))]
+
+  [bit  Bit  #..Bit]
+  [nat  Nat  #..Nat]
+  [int  Int  #..Int]
+  [rev  Rev  #..Rev]
+  [frac Frac #..Frac]
+  [text Text #..Text]
+  )
+
+(type: #export Arity Nat)
+
+(type: #export (Abstraction c) [Environment Arity c])
+
+(type: #export (Application c) [c (List c)])
+
+(def: (last? size tag)
+  (-> Nat Tag Bit)
+  (n/= (dec size) tag))
+
+(template: #export (no-op value)
+  (|> 1 #reference.Local #reference.Variable #..Reference
+      (#..Function (list))
+      (#..Apply value)))
+
+(def: #export (apply [abstraction inputs])
+  (-> (Application Analysis) Analysis)
+  (list/fold (function (_ input abstraction')
+               (#Apply input abstraction'))
+             abstraction
+             inputs))
+
+(def: #export (application analysis)
+  (-> Analysis (Application Analysis))
+  (loop [abstraction analysis
+         inputs (list)]
+    (case abstraction
+      (#Apply input next)
+      (recur next (#.Cons input inputs))
+
+      _
+      [abstraction inputs])))
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable #reference.Variable]
+  [constant #reference.Constant]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Complex
+          <tag>
+          content))]
+
+  [pattern/variant #..Variant]
+  [pattern/tuple   #..Tuple]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Structure
+          <tag>
+          content))]
+
+  [variant #..Variant]
+  [tuple   #..Tuple]
+  )
+
+(template: #export (pattern/unit)
+  (#..Simple #..Unit))
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (#..Simple (<tag> content)))]
+  
+  [pattern/bit  #..Bit]
+  [pattern/nat  #..Nat]
+  [pattern/int  #..Int]
+  [pattern/rev  #..Rev]
+  [pattern/frac #..Frac]
+  [pattern/text #..Text]
+  )
+
+(template: #export (pattern/bind register)
+  (#..Bind register))
+
+(def: #export (%analysis analysis)
+  (Format Analysis)
+  (case analysis
+    (#Primitive primitive)
+    (case primitive
+      #Unit
+      "[]"
+
+      (^template [<tag> <format>]
+        (<tag> value)
+        (<format> value))
+      ([#Bit %b]
+       [#Nat %n]
+       [#Int %i]
+       [#Rev %r]
+       [#Frac %f]
+       [#Text %t]))
+    
+    (#Structure structure)
+    (case structure
+      (#Variant [lefts right? value])
+      (format "(" (%n lefts) " " (%b right?) " " (%analysis value) ")")
+      
+      (#Tuple members)
+      (|> members
+          (list/map %analysis)
+          (text.join-with " ")
+          (text.enclose ["[" "]"])))
+    
+    (#Reference reference)
+    (case reference
+      (#reference.Variable variable)
+      (reference.%variable variable)
+      
+      (#reference.Constant constant)
+      (%name constant))
+    
+    (#Case analysis match)
+    "{?}"
+    
+    (#Function environment body)
+    (|> (%analysis body)
+        (format " ")
+        (format (|> environment
+                    (list/map reference.%variable)
+                    (text.join-with " ")
+                    (text.enclose ["[" "]"])))
+        (text.enclose ["(" ")"]))
+    
+    (#Apply _)
+    (|> analysis
+        ..application
+        #.Cons
+        (list/map %analysis)
+        (text.join-with " ")
+        (text.enclose ["(" ")"]))
+    
+    (#Extension name parameters)
+    (|> parameters
+        (list/map %analysis)
+        (text.join-with " ")
+        (format (%t name) " ")
+        (text.enclose ["(" ")"]))))
+
+(do-template [<special> <general>]
+  [(type: #export <special>
+     (<general> .Lux Code Analysis))]
+
+  [State+    extension.State]
+  [Operation extension.Operation]
+  [Phase     extension.Phase]
+  [Handler   extension.Handler]
+  [Bundle    extension.Bundle]
+  )
+
+(def: #export (with-source-code source action)
+  (All [a] (-> Source (Operation a) (Operation a)))
+  (function (_ [bundle state])
+    (let [old-source (get@ #.source state)]
+      (case (action [bundle (set@ #.source source state)])
+        (#error.Success [[bundle' state'] output])
+        (#error.Success [[bundle' (set@ #.source old-source state')]
+                         output])
+
+        (#error.Failure error)
+        (#error.Failure error)))))
+
+(def: fresh-bindings
+  (All [k v] (Bindings k v))
+  {#.counter 0
+   #.mappings (list)})
+
+(def: fresh-scope
+  Scope
+  {#.name     (list)
+   #.inner    0
+   #.locals   fresh-bindings
+   #.captured fresh-bindings})
+
+(def: #export (with-scope action)
+  (All [a] (-> (Operation a) (Operation [Scope a])))
+  (function (_ [bundle state])
+    (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)])
+      (#error.Success [[bundle' state'] output])
+      (case (get@ #.scopes state')
+        (#.Cons head tail)
+        (#error.Success [[bundle' (set@ #.scopes tail state')]
+                         [head output]])
+
+        #.Nil
+        (#error.Failure "Impossible error: Drained scopes!"))
+
+      (#error.Failure error)
+      (#error.Failure error))))
+
+(def: #export (with-current-module name)
+  (All [a] (-> Text (Operation a) (Operation a)))
+  (extension.localized (get@ #.current-module)
+                       (set@ #.current-module)
+                       (function.constant (#.Some name))))
+
+(def: #export (with-cursor cursor action)
+  (All [a] (-> Cursor (Operation a) (Operation a)))
+  (if (text/= "" (product.left cursor))
+    action
+    (function (_ [bundle state])
+      (let [old-cursor (get@ #.cursor state)]
+        (case (action [bundle (set@ #.cursor cursor state)])
+          (#error.Success [[bundle' state'] output])
+          (#error.Success [[bundle' (set@ #.cursor old-cursor state')]
+                           output])
+
+          (#error.Failure error)
+          (#error.Failure (format "@ " (%cursor cursor) text.new-line
+                                  error)))))))
+
+(do-template [<name> <type> <field> <value>]
+  [(def: #export (<name> value)
+     (-> <type> (Operation Any))
+     (extension.update (set@ <field> <value>)))]
+
+  [set-source-code    Source #.source         value]
+  [set-current-module Text   #.current-module (#.Some value)]
+  [set-cursor         Cursor #.cursor         value]
+  )
+
+(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: type-context
+  Type-Context
+  {#.ex-counter 0
+   #.var-counter 0
+   #.var-bindings (list)})
+
+(def: #export (state info host)
+  (-> Info 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/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux
new file mode 100644
index 000000000..37bcfef6e
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux
@@ -0,0 +1,300 @@
+(.module:
+  [lux (#- case)
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." product]
+    ["." error]
+    ["." maybe]
+    [text
+     format]
+    [collection
+     ["." list ("#/." fold monoid functor)]]]
+   ["." type
+    ["." check]]
+   ["." macro
+    ["." code]]]
+  ["." // (#+ Pattern Analysis Operation Phase)
+   ["." scope]
+   ["//." type]
+   ["." structure]
+   ["/." //
+    ["." extension]]]
+  [/
+   ["." coverage (#+ Coverage)]])
+
+(exception: #export (cannot-match-with-pattern {type Type} {pattern Code})
+  (ex.report ["Type" (%type type)]
+             ["Pattern" (%code pattern)]))
+
+(exception: #export (sum-has-no-case {case Nat} {type Type})
+  (ex.report ["Case" (%n case)]
+             ["Type" (%type type)]))
+
+(exception: #export (not-a-pattern {code Code})
+  (ex.report ["Code" (%code code)]))
+
+(exception: #export (cannot-simplify-for-pattern-matching {type Type})
+  (ex.report ["Type" (%type type)]))
+
+(exception: #export (non-exhaustive-pattern-matching {input Code} {branches (List [Code Code])} {coverage Coverage})
+  (ex.report ["Input" (%code input)]
+             ["Branches" (%code (code.record branches))]
+             ["Coverage" (coverage.%coverage coverage)]))
+
+(exception: #export (cannot-have-empty-branches {message Text})
+  message)
+
+(def: (re-quantify envs baseT)
+  (-> (List (List Type)) Type Type)
+  (.case envs
+    #.Nil
+    baseT
+
+    (#.Cons head tail)
+    (re-quantify tail (#.UnivQ head baseT))))
+
+## Type-checking on the input value is done during the analysis of a
+## "case" expression, to ensure that the patterns being used make
+## sense for the type of the input value.
+## Sometimes, that input value is complex, by depending on
+## type-variables or quantifications.
+## This function makes it easier for "case" analysis to properly
+## type-check the input with respect to the patterns.
+(def: (simplify-case caseT)
+  (-> Type (Operation Type))
+  (loop [envs (: (List (List Type))
+                 (list))
+         caseT caseT]
+    (.case caseT
+      (#.Var id)
+      (do ///.monad
+        [?caseT' (//type.with-env
+                   (check.read id))]
+        (.case ?caseT'
+          (#.Some caseT')
+          (recur envs caseT')
+
+          _
+          (///.throw cannot-simplify-for-pattern-matching caseT)))
+
+      (#.Named name unnamedT)
+      (recur envs unnamedT)
+
+      (#.UnivQ env unquantifiedT)
+      (recur (#.Cons env envs) unquantifiedT)
+
+      (#.ExQ _)
+      (do ///.monad
+        [[ex-id exT] (//type.with-env
+                       check.existential)]
+        (recur envs (maybe.assume (type.apply (list exT) caseT))))
+
+      (#.Apply inputT funcT)
+      (.case funcT
+        (#.Var funcT-id)
+        (do ///.monad
+          [funcT' (//type.with-env
+                    (do check.monad
+                      [?funct' (check.read funcT-id)]
+                      (.case ?funct'
+                        (#.Some funct')
+                        (wrap funct')
+
+                        _
+                        (check.throw cannot-simplify-for-pattern-matching caseT))))]
+          (recur envs (#.Apply inputT funcT')))
+
+        _
+        (.case (type.apply (list inputT) funcT)
+          (#.Some outputT)
+          (recur envs outputT)
+
+          #.None
+          (///.throw cannot-simplify-for-pattern-matching caseT)))
+
+      (#.Product _)
+      (|> caseT
+          type.flatten-tuple
+          (list/map (re-quantify envs))
+          type.tuple
+          (:: ///.monad wrap))
+
+      _
+      (:: ///.monad wrap (re-quantify envs caseT)))))
+
+(def: (analyse-primitive type inputT cursor output next)
+  (All [a] (-> Type Type Cursor Pattern (Operation a) (Operation [Pattern a])))
+  (//.with-cursor cursor
+    (do ///.monad
+      [_ (//type.with-env
+           (check.check inputT type))
+       outputA next]
+      (wrap [output outputA]))))
+
+## This function handles several concerns at once, but it must be that
+## way because those concerns are interleaved when doing
+## pattern-matching and they cannot be separated.
+## The pattern is analysed in order to get a general feel for what is
+## expected of the input value. This, in turn, informs the
+## type-checking of the input.
+## A kind of "continuation" value is passed around which signifies
+## what needs to be done _after_ analysing a pattern.
+## In general, this is done to analyse the "body" expression
+## associated to a particular pattern _in the context of_ said
+## pattern.
+## The reason why *context* is important is because patterns may bind
+## values to local variables, which may in turn be referenced in the
+## body expressions.
+## That is why the body must be analysed in the context of the
+## pattern, and not separately.
+(def: (analyse-pattern num-tags inputT pattern next)
+  (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
+  (.case pattern
+    [cursor (#.Identifier ["" name])]
+    (//.with-cursor cursor
+      (do ///.monad
+        [outputA (scope.with-local [name inputT]
+                   next)
+         idx scope.next-local]
+        (wrap [(#//.Bind idx) outputA])))
+
+    (^template [<type> <input> <output>]
+      [cursor <input>]
+      (analyse-primitive <type> inputT cursor (#//.Simple <output>) next))
+    ([Bit  (#.Bit pattern-value)  (#//.Bit pattern-value)]
+     [Nat  (#.Nat pattern-value)  (#//.Nat pattern-value)]
+     [Int  (#.Int pattern-value)  (#//.Int pattern-value)]
+     [Rev  (#.Rev pattern-value)  (#//.Rev pattern-value)]
+     [Frac (#.Frac pattern-value) (#//.Frac pattern-value)]
+     [Text (#.Text pattern-value) (#//.Text pattern-value)]
+     [Any  (#.Tuple #.Nil)        #//.Unit])
+    
+    (^ [cursor (#.Tuple (list singleton))])
+    (analyse-pattern #.None inputT singleton next)
+    
+    [cursor (#.Tuple sub-patterns)]
+    (//.with-cursor cursor
+      (do ///.monad
+        [inputT' (simplify-case inputT)]
+        (.case inputT'
+          (#.Product _)
+          (let [subs (type.flatten-tuple inputT')
+                num-subs (maybe.default (list.size subs)
+                                        num-tags)
+                num-sub-patterns (list.size sub-patterns)
+                matches (cond (n/< num-subs num-sub-patterns)
+                              (let [[prefix suffix] (list.split (dec num-sub-patterns) subs)]
+                                (list.zip2 (list/compose prefix (list (type.tuple suffix))) sub-patterns))
+
+                              (n/> num-subs num-sub-patterns)
+                              (let [[prefix suffix] (list.split (dec num-subs) sub-patterns)]
+                                (list.zip2 subs (list/compose prefix (list (code.tuple suffix)))))
+                              
+                              ## (n/= num-subs num-sub-patterns)
+                              (list.zip2 subs sub-patterns))]
+            (do @
+              [[memberP+ thenA] (list/fold (: (All [a]
+                                                (-> [Type Code] (Operation [(List Pattern) a])
+                                                    (Operation [(List Pattern) a])))
+                                              (function (_ [memberT memberC] then)
+                                                (do @
+                                                  [[memberP [memberP+ thenA]] ((:coerce (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
+                                                                                        analyse-pattern)
+                                                                               #.None memberT memberC then)]
+                                                  (wrap [(list& memberP memberP+) thenA]))))
+                                           (do @
+                                             [nextA next]
+                                             (wrap [(list) nextA]))
+                                           (list.reverse matches))]
+              (wrap [(//.pattern/tuple memberP+)
+                     thenA])))
+
+          _
+          (///.throw cannot-match-with-pattern [inputT pattern])
+          )))
+
+    [cursor (#.Record record)]
+    (do ///.monad
+      [record (structure.normalize record)
+       [members recordT] (structure.order record)
+       _ (//type.with-env
+           (check.check inputT recordT))]
+      (analyse-pattern (#.Some (list.size members)) inputT [cursor (#.Tuple members)] next))
+
+    [cursor (#.Tag tag)]
+    (//.with-cursor cursor
+      (analyse-pattern #.None inputT (` ((~ pattern))) next))
+
+    (^ [cursor (#.Form (list& [_ (#.Nat idx)] values))])
+    (//.with-cursor cursor
+      (do ///.monad
+        [inputT' (simplify-case inputT)]
+        (.case inputT'
+          (#.Sum _)
+          (let [flat-sum (type.flatten-variant inputT')
+                size-sum (list.size flat-sum)
+                num-cases (maybe.default size-sum num-tags)]
+            (.case (list.nth idx flat-sum)
+              (^multi (#.Some caseT)
+                      (n/< num-cases idx))
+              (do ///.monad
+                [[testP nextA] (if (and (n/> num-cases size-sum)
+                                        (n/= (dec num-cases) idx))
+                                 (analyse-pattern #.None
+                                                  (type.variant (list.drop (dec num-cases) flat-sum))
+                                                  (` [(~+ values)])
+                                                  next)
+                                 (analyse-pattern #.None caseT (` [(~+ values)]) next))
+                 #let [right? (n/= (dec num-cases) idx)
+                       lefts (if right?
+                               (dec idx)
+                               idx)]]
+                (wrap [(//.pattern/variant [lefts right? testP])
+                       nextA]))
+
+              _
+              (///.throw sum-has-no-case [idx inputT])))
+
+          _
+          (///.throw cannot-match-with-pattern [inputT pattern]))))
+
+    (^ [cursor (#.Form (list& [_ (#.Tag tag)] values))])
+    (//.with-cursor cursor
+      (do ///.monad
+        [tag (extension.lift (macro.normalize tag))
+         [idx group variantT] (extension.lift (macro.resolve-tag tag))
+         _ (//type.with-env
+             (check.check inputT variantT))]
+        (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next)))
+
+    _
+    (///.throw not-a-pattern pattern)
+    ))
+
+(def: #export (case analyse inputC branches)
+  (-> Phase Code (List [Code Code]) (Operation Analysis))
+  (.case 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 [inputC branches coverage]
+                       (coverage.exhaustive? coverage))
+
+           (#error.Failure error)
+           (///.fail error))]
+      (wrap (#//.Case inputA [outputH outputT])))
+
+    #.Nil
+    (///.throw cannot-have-empty-branches "")))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux
new file mode 100644
index 000000000..cd6ccd83d
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux
@@ -0,0 +1,366 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]
+    equivalence]
+   [data
+    ["." bit ("#/." equivalence)]
+    ["." number]
+    ["." error (#+ Error) ("#/." monad)]
+    ["." maybe]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor fold)]
+     ["." dictionary (#+ Dictionary)]]]]
+  ["." //// ("#/." monad)]
+  ["." /// (#+ Pattern Variant Operation)])
+
+(exception: #export (invalid-tuple-pattern)
+  "Tuple size must be >= 2")
+
+(def: cases
+  (-> (Maybe Nat) Nat)
+  (|>> (maybe.default 0)))
+
+(def: known-cases?
+  (-> Nat Bit)
+  (n/> 0))
+
+## The coverage of a pattern-matching expression summarizes how well
+## all the possible values of an input are being covered by the
+## different patterns involved.
+## Ideally, the pattern-matching has "exhaustive" coverage, which just
+## means that every possible value can be matched by at least 1
+## pattern.
+## Every other coverage is considered partial, and it would be valued
+## as insuficient (since it could lead to runtime errors due to values
+## not being handled by any pattern).
+## The #Partial tag covers arbitrary partial coverages in a general
+## way, while the other tags cover more specific cases for bits
+## and variants.
+(type: #export #rec Coverage
+  #Partial
+  (#Bit Bit)
+  (#Variant (Maybe Nat) (Dictionary Nat Coverage))
+  (#Seq Coverage Coverage)
+  (#Alt Coverage Coverage)
+  #Exhaustive)
+
+(def: #export (exhaustive? coverage)
+  (-> Coverage Bit)
+  (case coverage
+    (#Exhaustive _)
+    #1
+
+    _
+    #0))
+
+(def: #export (%coverage value)
+  (Format Coverage)
+  (case value
+    #Partial
+    "#Partial"
+    
+    (#Bit value')
+    (|> value'
+        %b
+        (text.enclose ["(#Bit " ")"]))
+    
+    (#Variant ?max-cases cases)
+    (|> cases
+        dictionary.entries
+        (list/map (function (_ [idx coverage])
+                    (format (%n idx) " " (%coverage coverage))))
+        (text.join-with " ")
+        (text.enclose ["{" "}"])
+        (format (%n (..cases ?max-cases)) " ")
+        (text.enclose ["(#Variant " ")"]))
+
+    (#Seq left right)
+    (format "(#Seq " (%coverage left) " " (%coverage right) ")")
+    
+    (#Alt left right)
+    (format "(#Alt " (%coverage left) " " (%coverage right) ")")
+
+    #Exhaustive
+    "#Exhaustive"))
+
+(def: #export (determine pattern)
+  (-> Pattern (Operation Coverage))
+  (case pattern
+    (^or (#///.Simple #///.Unit)
+         (#///.Bind _))
+    (/////wrap #Exhaustive)
+
+    ## Primitive patterns always have partial coverage because there
+    ## are too many possibilities as far as values go.
+    (^template [<tag>]
+      (#///.Simple (<tag> _))
+      (/////wrap #Partial))
+    ([#///.Nat]
+     [#///.Int]
+     [#///.Rev]
+     [#///.Frac]
+     [#///.Text])
+
+    ## Bits are the exception, since there is only "#1" and
+    ## "#0", which means it is possible for bit
+    ## pattern-matching to become exhaustive if complementary parts meet.
+    (#///.Simple (#///.Bit value))
+    (/////wrap (#Bit value))
+
+    ## Tuple patterns can be exhaustive if there is exhaustiveness for all of
+    ## their sub-patterns.
+    (#///.Complex (#///.Tuple membersP+))
+    (case (list.reverse membersP+)
+      (^or #.Nil (#.Cons _ #.Nil))
+      (////.throw invalid-tuple-pattern [])
+      
+      (#.Cons lastP prevsP+)
+      (do ////.monad
+        [lastC (determine lastP)]
+        (monad.fold ////.monad
+                    (function (_ leftP rightC)
+                      (do ////.monad
+                        [leftC (determine leftP)]
+                        (case rightC
+                          #Exhaustive
+                          (wrap leftC)
+
+                          _
+                          (wrap (#Seq leftC rightC)))))
+                    lastC prevsP+)))
+
+    ## Variant patterns can be shown to be exhaustive if all the possible
+    ## cases are handled exhaustively.
+    (#///.Complex (#///.Variant [lefts right? value]))
+    (do ////.monad
+      [value-coverage (determine value)
+       #let [idx (if right?
+                   (inc lefts)
+                   lefts)]]
+      (wrap (#Variant (if right?
+                        (#.Some idx)
+                        #.None)
+                      (|> (dictionary.new number.hash)
+                          (dictionary.put idx value-coverage)))))))
+
+(def: (xor left right)
+  (-> Bit Bit Bit)
+  (or (and left (not right))
+      (and (not left) right)))
+
+## The coverage checker not only verifies that pattern-matching is
+## exhaustive, but also that there are no redundant patterns.
+## Redundant patterns will never be executed, since there will
+## always be a pattern prior to them that would match the input.
+## Because of that, the presence of redundant patterns is assumed to
+## be a bug, likely due to programmer carelessness.
+(exception: #export (redundant-pattern {so-far Coverage} {addition Coverage})
+  (ex.report ["Coverage so-far" (%coverage so-far)]
+             ["Coverage addition" (%coverage addition)]))
+
+(def: (flatten-alt coverage)
+  (-> Coverage (List Coverage))
+  (case coverage
+    (#Alt left right)
+    (list& left (flatten-alt right))
+
+    _
+    (list coverage)))
+
+(structure: _ (Equivalence Coverage)
+  (def: (= reference sample)
+    (case [reference sample]
+      [#Exhaustive #Exhaustive]
+      #1
+
+      [(#Bit sideR) (#Bit sideS)]
+      (bit/= sideR sideS)
+
+      [(#Variant allR casesR) (#Variant allS casesS)]
+      (and (n/= (cases allR)
+                (cases allS))
+           (:: (dictionary.equivalence =) = casesR casesS))
+      
+      [(#Seq leftR rightR) (#Seq leftS rightS)]
+      (and (= leftR leftS)
+           (= rightR rightS))
+
+      [(#Alt _) (#Alt _)]
+      (let [flatR (flatten-alt reference)
+            flatS (flatten-alt sample)]
+        (and (n/= (list.size flatR) (list.size flatS))
+             (list.every? (function (_ [coverageR coverageS])
+                            (= coverageR coverageS))
+                          (list.zip2 flatR flatS))))
+
+      _
+      #0)))
+
+(open: "coverage/." ..equivalence)
+
+(exception: #export (variants-do-not-match {addition-cases Nat} {so-far-cases Nat})
+  (ex.report ["So-far Cases" (%n so-far-cases)]
+             ["Addition Cases" (%n addition-cases)]))
+
+## 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 (Error Coverage))
+  (case [addition so-far]
+    [#Partial #Partial]
+    (error/wrap #Partial)
+
+    ## 2 bit coverages are exhaustive if they complement one another.
+    (^multi [(#Bit sideA) (#Bit sideSF)]
+            (xor sideA sideSF))
+    (error/wrap #Exhaustive)
+
+    [(#Variant allA casesA) (#Variant allSF casesSF)]
+    (let [addition-cases (cases allSF)
+          so-far-cases (cases allA)]
+      (cond (and (known-cases? addition-cases)
+                 (known-cases? so-far-cases)
+                 (not (n/= addition-cases so-far-cases)))
+            (ex.throw variants-do-not-match [addition-cases so-far-cases])
+
+            (:: (dictionary.equivalence ..equivalence) = casesSF casesA)
+            (ex.throw redundant-pattern [so-far addition])
+
+            ## else
+            (do error.monad
+              [casesM (monad.fold @
+                                  (function (_ [tagA coverageA] casesSF')
+                                    (case (dictionary.get tagA casesSF')
+                                      (#.Some coverageSF)
+                                      (do @
+                                        [coverageM (merge coverageA coverageSF)]
+                                        (wrap (dictionary.put tagA coverageM casesSF')))
+
+                                      #.None
+                                      (wrap (dictionary.put tagA coverageA casesSF'))))
+                                  casesSF (dictionary.entries casesA))]
+              (wrap (if (and (or (known-cases? addition-cases)
+                                 (known-cases? so-far-cases))
+                             (n/= (inc (n/max addition-cases so-far-cases))
+                                  (dictionary.size casesM))
+                             (list.every? exhaustive? (dictionary.values casesM)))
+                      #Exhaustive
+                      (#Variant (case allSF
+                                  (#.Some _)
+                                  allSF
+
+                                  _
+                                  allA)
+                                casesM))))))
+
+    [(#Seq leftA rightA) (#Seq leftSF rightSF)]
+    (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)]
+      ## Same prefix
+      [#1 #0]
+      (do error.monad
+        [rightM (merge rightA rightSF)]
+        (if (exhaustive? rightM)
+          ## If all that follows is exhaustive, then it can be safely dropped
+          ## (since only the "left" part would influence whether the
+          ## merged coverage is exhaustive or not).
+          (wrap leftSF)
+          (wrap (#Seq leftSF rightM))))
+
+      ## Same suffix
+      [#0 #1]
+      (do error.monad
+        [leftM (merge leftA leftSF)]
+        (wrap (#Seq leftM rightA)))
+
+      ## The 2 sequences cannot possibly be merged.
+      [#0 #0]
+      (error/wrap (#Alt so-far addition))
+
+      ## There is nothing the addition adds to the coverage.
+      [#1 #1]
+      (ex.throw redundant-pattern [so-far addition]))
+
+    ## The addition cannot possibly improve the coverage.
+    [_ #Exhaustive]
+    (ex.throw redundant-pattern [so-far addition])
+
+    ## The addition completes the coverage.
+    [#Exhaustive _]
+    (error/wrap #Exhaustive)
+    
+    ## The left part will always match, so the addition is redundant.
+    (^multi [(#Seq left right) single]
+            (coverage/= left single))
+    (ex.throw redundant-pattern [so-far addition])
+
+    ## The right part is not necessary, since it can always match the left.
+    (^multi [single (#Seq left right)]
+            (coverage/= left single))
+    (error/wrap single)
+
+    ## When merging a new coverage against one based on Alt, it may be
+    ## that one of the many coverages in the Alt is complementary to
+    ## the new one, so effort must be made to fuse carefully, to match
+    ## the right coverages together.
+    ## If one of the Alt sub-coverages matches the new one, the cycle
+    ## must be repeated, in case the resulting coverage can now match
+    ## other ones in the original Alt.
+    ## This process must be repeated until no further productive
+    ## merges can be done.
+    [_ (#Alt leftS rightS)]
+    (do error.monad
+      [#let [fuse-once (: (-> Coverage (List Coverage)
+                              (Error [(Maybe Coverage)
+                                      (List Coverage)]))
+                          (function (_ coverageA possibilitiesSF)
+                            (loop [altsSF possibilitiesSF]
+                              (case altsSF
+                                #.Nil
+                                (wrap [#.None (list coverageA)])
+                                
+                                (#.Cons altSF altsSF')
+                                (case (merge coverageA altSF)
+                                  (#error.Success altMSF)
+                                  (case altMSF
+                                    (#Alt _)
+                                    (do @
+                                      [[success altsSF+] (recur altsSF')]
+                                      (wrap [success (#.Cons altSF altsSF+)]))
+
+                                    _
+                                    (wrap [(#.Some altMSF) altsSF']))
+                                  
+                                  (#error.Failure error)
+                                  (error.fail error))
+                                ))))]
+       [successA possibilitiesSF] (fuse-once addition (flatten-alt so-far))]
+      (loop [successA successA
+             possibilitiesSF possibilitiesSF]
+        (case successA
+          (#.Some coverageA')
+          (do @
+            [[successA' possibilitiesSF'] (fuse-once coverageA' possibilitiesSF)]
+            (recur successA' possibilitiesSF'))
+          
+          #.None
+          (case (list.reverse possibilitiesSF)
+            (#.Cons last prevs)
+            (wrap (list/fold (function (_ left right) (#Alt left right))
+                             last
+                             prevs))
+
+            #.Nil
+            (undefined)))))
+
+    _
+    (if (coverage/= so-far addition)
+      ## The addition cannot possibly improve the coverage.
+      (ex.throw redundant-pattern [so-far addition])
+      ## There are now 2 alternative paths.
+      (error/wrap (#Alt so-far addition)))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux
new file mode 100644
index 000000000..3ce70fe9b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux
@@ -0,0 +1,109 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error]
+    [text
+     format]]
+   ["." macro]]
+  ["." // (#+ Analysis Operation Phase)
+   ["." type]
+   ["." primitive]
+   ["." structure]
+   ["//." reference]
+   ["." case]
+   ["." function]
+   ["//." macro]
+   ["/." //
+    ["." extension]
+    [//
+     ["." reference]]]])
+
+(exception: #export (unrecognized-syntax {code Code})
+  (ex.report ["Code" (%code code)]))
+
+(def: #export (compile code)
+  Phase
+  (do ///.monad
+    [expectedT (extension.lift macro.expected-type)]
+    (let [[cursor code'] code]
+      ## The cursor must be set in the state for the sake
+      ## of having useful error messages.
+      (//.with-cursor cursor
+        (case code'
+          (^template [<tag> <analyser>]
+            (<tag> value)
+            (<analyser> value))
+          ([#.Bit  primitive.bit]
+           [#.Nat  primitive.nat]
+           [#.Int  primitive.int]
+           [#.Rev  primitive.rev]
+           [#.Frac primitive.frac]
+           [#.Text primitive.text])
+
+          (^template [<tag> <analyser>]
+            (^ (#.Form (list& [_ (<tag> tag)]
+                              values)))
+            (case values
+              (#.Cons value #.Nil)
+              (<analyser> compile tag value)
+
+              _
+              (<analyser> 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)
+
+          (#.Identifier reference)
+          (//reference.reference reference)
+
+          (^ (#.Form (list [_ (#.Record branches)] input)))
+          (case.case compile input branches)
+
+          (^ (#.Form (list& [_ (#.Text extension-name)] extension-args)))
+          (extension.apply "Analysis" compile [extension-name extension-args])
+
+          (^ (#.Form (list [_ (#.Tuple (list [_ (#.Identifier ["" function-name])]
+                                             [_ (#.Identifier ["" arg-name])]))]
+                           body)))
+          (function.function compile function-name arg-name body)
+
+          (^ (#.Form (list& functionC argsC+)))
+          (do @
+            [[functionT functionA] (type.with-inference
+                                     (compile functionC))]
+            (case functionA
+              (#//.Reference (#reference.Constant def-name))
+              (do @
+                [?macro (extension.lift (macro.find-macro def-name))]
+                (case ?macro
+                  (#.Some macro)
+                  (do @
+                    [expansion (extension.lift (//macro.expand-one def-name macro argsC+))]
+                    (compile expansion))
+
+                  _
+                  (function.apply compile functionT functionA argsC+)))
+
+              _
+              (function.apply compile functionT functionA argsC+)))
+
+          _
+          (///.throw unrecognized-syntax code)
+          )))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux
new file mode 100644
index 000000000..cbea165f8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/function.lux
@@ -0,0 +1,102 @@
+(.module:
+  [lux (#- function)
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." maybe]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." fold monoid monad)]]]
+   ["." type
+    ["." check]]
+   ["." macro]]
+  ["." // (#+ Analysis Operation Phase)
+   ["." scope]
+   ["//." type]
+   ["." inference]
+   ["/." //
+    ["." extension]]])
+
+(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code})
+  (ex.report ["Type" (%type expected)]
+             ["Function" function]
+             ["Argument" argument]
+             ["Body" (%code body)]))
+
+(exception: #export (cannot-apply {function Type} {arguments (List Code)})
+  (ex.report ["Function" (%type function)]
+             ["Arguments" (|> arguments
+                              list.enumerate
+                              (list/map (.function (_ [idx argC])
+                                          (format text.new-line "  " (%n idx) " " (%code argC))))
+                              (text.join-with ""))]))
+
+(def: #export (function analyse function-name arg-name body)
+  (-> Phase Text Text Code (Operation Analysis))
+  (do ///.monad
+    [functionT (extension.lift macro.expected-type)]
+    (loop [expectedT functionT]
+      (///.with-stack cannot-analyse [expectedT function-name arg-name body]
+        (case expectedT
+          (#.Named name unnamedT)
+          (recur unnamedT)
+
+          (#.Apply argT funT)
+          (case (type.apply (list argT) funT)
+            (#.Some value)
+            (recur value)
+
+            #.None
+            (///.fail (ex.construct cannot-analyse [expectedT function-name arg-name body])))
+
+          (^template [<tag> <instancer>]
+            (<tag> _)
+            (do @
+              [[_ instanceT] (//type.with-env <instancer>)]
+              (recur (maybe.assume (type.apply (list instanceT) expectedT)))))
+          ([#.UnivQ check.existential]
+           [#.ExQ check.var])
+          
+          (#.Var id)
+          (do @
+            [?expectedT' (//type.with-env
+                           (check.read id))]
+            (case ?expectedT'
+              (#.Some expectedT')
+              (recur expectedT')
+
+              ## Inference
+              _
+              (do @
+                [[input-id inputT] (//type.with-env check.var)
+                 [output-id outputT] (//type.with-env check.var)
+                 #let [functionT (#.Function inputT outputT)]
+                 functionA (recur functionT)
+                 _ (//type.with-env
+                     (check.check expectedT functionT))]
+                (wrap functionA))
+              ))
+
+          (#.Function inputT outputT)
+          (<| (:: @ map (.function (_ [scope bodyA])
+                          (#//.Function (scope.environment scope) bodyA)))
+              //.with-scope
+              ## Functions have access not only to their argument, but
+              ## also to themselves, through a local variable.
+              (scope.with-local [function-name expectedT])
+              (scope.with-local [arg-name inputT])
+              (//type.with-type outputT)
+              (analyse body))
+          
+          _
+          (///.fail "")
+          )))))
+
+(def: #export (apply analyse functionT functionA argsC+)
+  (-> Phase Type Analysis (List Code) (Operation Analysis))
+  (<| (///.with-stack cannot-apply [functionT argsC+])
+      (do ///.monad
+        [[applyT argsA+] (inference.general analyse functionT argsC+)])
+      (wrap (//.apply [functionA argsA+]))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux
new file mode 100644
index 000000000..4ce9c6985
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/inference.lux
@@ -0,0 +1,259 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." maybe]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor)]]]
+   ["." type
+    ["." check]]
+   ["." macro]]
+  ["." /// ("#/." monad)
+   ["." extension]]
+  [// (#+ Tag Analysis Operation Phase)]
+  ["." //type])
+
+(exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type})
+  (ex.report ["Tag" (%n tag)]
+             ["Variant size" (%i (.int size))]
+             ["Variant type" (%type type)]))
+
+(exception: #export (cannot-infer {type Type} {args (List Code)})
+  (ex.report ["Type" (%type type)]
+             ["Arguments" (|> args
+                              list.enumerate
+                              (list/map (function (_ [idx argC])
+                                          (format text.new-line "  " (%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 [<name>]
+  [(exception: #export (<name> {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 [<tag>]
+      (<tag> left right)
+      (<tag> (replace parameter-idx replacement left)
+             (replace parameter-idx replacement right)))
+    ([#.Sum]
+     [#.Product]
+     [#.Function]
+     [#.Apply])
+    
+    (#.Parameter idx)
+    (if (n/= parameter-idx idx)
+      replacement
+      type)
+
+    (^template [<tag>]
+      (<tag> env quantified)
+      (<tag> (list/map (replace parameter-idx replacement) env)
+             (replace (n/+ 2 parameter-idx) replacement quantified)))
+    ([#.UnivQ]
+     [#.ExQ])
+    
+    _
+    type))
+
+(def: (named-type cursor id)
+  (-> Cursor Nat Type)
+  (let [name (format "{New Type @ " (.cursor-description cursor) " " (%n id) "}")]
+    (#.Primitive name (list))))
+
+(def: new-named-type
+  (Operation Type)
+  (do ///.monad
+    [cursor (extension.lift macro.cursor)
+     [ex-id _] (//type.with-env check.existential)]
+    (wrap (named-type cursor ex-id))))
+
+## Type-inference works by applying some (potentially quantified) type
+## to a sequence of values.
+## Function types are used for this, although inference is not always
+## done for function application (alternative uses may be records and
+## tagged variants).
+## But, so long as the type being used for the inference can be treated
+## as a function type, this method of inference should work.
+(def: #export (general analyse inferT args)
+  (-> Phase Type (List Code) (Operation [Type (List Analysis)]))
+  (case args
+    #.Nil
+    (do ///.monad
+      [_ (//type.infer inferT)]
+      (wrap [inferT (list)]))
+    
+    (#.Cons argC args')
+    (case inferT
+      (#.Named name unnamedT)
+      (general analyse unnamedT args)
+
+      (#.UnivQ _)
+      (do ///.monad
+        [[var-id varT] (//type.with-env check.var)]
+        (general analyse (maybe.assume (type.apply (list varT) inferT)) args))
+
+      (#.ExQ _)
+      (do ///.monad
+        [[var-id varT] (//type.with-env check.var)
+         output (general analyse
+                         (maybe.assume (type.apply (list varT) inferT))
+                         args)
+         bound? (//type.with-env
+                  (check.bound? var-id))
+         _ (if bound?
+             (wrap [])
+             (do @
+               [newT new-named-type]
+               (//type.with-env
+                 (check.check varT newT))))]
+        (wrap output))
+
+      (#.Apply inputT transT)
+      (case (type.apply (list inputT) transT)
+        (#.Some outputT)
+        (general analyse outputT args)
+
+        #.None
+        (///.throw invalid-type-application inferT))
+
+      ## Arguments are inferred back-to-front because, by convention,
+      ## Lux functions take the most important arguments *last*, which
+      ## means that the most information for doing proper inference is
+      ## located in the last arguments to a function call.
+      ## By inferring back-to-front, a lot of type-annotations can be
+      ## avoided in Lux code, since the inference algorithm can piece
+      ## things together more easily.
+      (#.Function inputT outputT)
+      (do ///.monad
+        [[outputT' args'A] (general analyse outputT args')
+         argA (<| (///.with-stack cannot-infer-argument [inputT argC])
+                  (//type.with-type inputT)
+                  (analyse argC))]
+        (wrap [outputT' (list& argA args'A)]))
+
+      (#.Var infer-id)
+      (do ///.monad
+        [?inferT' (//type.with-env (check.read infer-id))]
+        (case ?inferT'
+          (#.Some inferT')
+          (general analyse inferT' args)
+
+          _
+          (///.throw cannot-infer [inferT args])))
+
+      _
+      (///.throw cannot-infer [inferT args]))
+    ))
+
+## Turns a record type into the kind of function type suitable for inference.
+(def: #export (record inferT)
+  (-> Type (Operation Type))
+  (case inferT
+    (#.Named name unnamedT)
+    (record unnamedT)
+
+    (^template [<tag>]
+      (<tag> env bodyT)
+      (do ///.monad
+        [bodyT+ (record bodyT)]
+        (wrap (<tag> env bodyT+))))
+    ([#.UnivQ]
+     [#.ExQ])
+
+    (#.Apply inputT funcT)
+    (case (type.apply (list inputT) funcT)
+      (#.Some outputT)
+      (record outputT)
+
+      #.None
+      (///.throw invalid-type-application inferT))
+
+    (#.Product _)
+    (////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 [<tag>]
+        (<tag> env bodyT)
+        (do ///.monad
+          [bodyT+ (recur (inc depth) bodyT)]
+          (wrap (<tag> 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)
+                (////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))]
+                (////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/tool/compiler/phase/analysis/macro.lux b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux
new file mode 100644
index 000000000..18455b837
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux
@@ -0,0 +1,79 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    ["." text
+     format]
+    [collection
+     [array (#+ Array)]
+     ["." list ("#/." functor)]]]
+   ["." macro]
+   ["." host (#+ import:)]]
+  ["." ///])
+
+(exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text})
+  (ex.report ["Macro" (%name macro)]
+             ["Inputs" (|> inputs
+                           (list/map (|>> %code (format text.new-line text.tab)))
+                           (text.join-with ""))]
+             ["Error" error]))
+
+(exception: #export (must-have-single-expansion {macro Name} {inputs (List Code)})
+  (ex.report ["Macro" (%name macro)]
+             ["Inputs" (|> inputs
+                           (list/map (|>> %code (format text.new-line text.tab)))
+                           (text.join-with ""))]))
+
+(import: java/lang/reflect/Method
+  (invoke [Object (Array Object)] #try Object))
+
+(import: (java/lang/Class c)
+  (getMethod [String (Array (Class Object))] #try Method))
+
+(import: java/lang/Object
+  (getClass [] (Class Object)))
+
+(def: _object-class
+  (Class Object)
+  (host.class-for Object))
+
+(def: _apply-args
+  (Array (Class Object))
+  (|> (host.array (Class Object) 2)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)))
+
+(def: #export (expand name macro inputs)
+  (-> Name Macro (List Code) (Meta (List Code)))
+  (function (_ state)
+    (do error.monad
+      [apply-method (|> macro
+                        (:coerce Object)
+                        (Object::getClass)
+                        (Class::getMethod "apply" _apply-args))
+       output (Method::invoke (:coerce Object macro)
+                              (|> (host.array Object 2)
+                                  (host.array-write 0 (:coerce Object inputs))
+                                  (host.array-write 1 (:coerce Object state)))
+                              apply-method)]
+      (case (:coerce (Error [Lux (List Code)])
+                     output)
+        (#error.Success output)
+        (#error.Success output)
+        
+        (#error.Failure error)
+        ((///.throw expansion-failed [name inputs error]) state)))))
+
+(def: #export (expand-one name macro inputs)
+  (-> Name Macro (List Code) (Meta Code))
+  (do macro.monad
+    [expansion (expand name macro inputs)]
+    (case expansion
+      (^ (list single))
+      (wrap single)
+
+      _
+      (///.throw must-have-single-expansion [name inputs]))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux
new file mode 100644
index 000000000..29865f352
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux
@@ -0,0 +1,255 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]
+    pipe]
+   [data
+    ["." text ("#/." equivalence)
+     format]
+    ["." error]
+    [collection
+     ["." list ("#/." fold functor)]
+     [dictionary
+      ["." plist]]]]
+   ["." macro]]
+  ["." // (#+ Operation)
+   ["/." //
+    ["." extension]]])
+
+(type: #export Tag Text)
+
+(exception: #export (unknown-module {module Text})
+  (ex.report ["Module" module]))
+
+(exception: #export (cannot-declare-tag-twice {module Text} {tag Text})
+  (ex.report ["Module" module]
+             ["Tag" tag]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {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 Name})
+  (ex.report ["Definition" (%name 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: #export (new hash)
+  (-> Nat Module)
+  {#.module-hash        hash
+   #.module-aliases     (list)
+   #.definitions        (list)
+   #.imports            (list)
+   #.tags               (list)
+   #.types              (list)
+   #.module-annotations #.None
+   #.module-state       #.Active})
+
+(def: #export (set-annotations annotations)
+  (-> Code (Operation Any))
+  (do ///.monad
+    [self-name (extension.lift macro.current-module-name)
+     self (extension.lift macro.current-module)]
+    (case (get@ #.module-annotations self)
+      #.None
+      (extension.lift
+       (function (_ state)
+         (#error.Success [(update@ #.modules
+                                   (plist.put self-name (set@ #.module-annotations (#.Some annotations) self))
+                                   state)
+                          []])))
+      
+      (#.Some old)
+      (///.throw cannot-set-module-annotations-more-than-once [self-name old annotations]))))
+
+(def: #export (import module)
+  (-> Text (Operation Any))
+  (do ///.monad
+    [self-name (extension.lift macro.current-module-name)]
+    (extension.lift
+     (function (_ state)
+       (#error.Success [(update@ #.modules
+                                 (plist.update self-name (update@ #.imports (|>> (#.Cons module))))
+                                 state)
+                        []])))))
+
+(def: #export (alias alias module)
+  (-> Text Text (Operation Any))
+  (do ///.monad
+    [self-name (extension.lift macro.current-module-name)]
+    (extension.lift
+     (function (_ state)
+       (#error.Success [(update@ #.modules
+                                 (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
+                                                                                      (|>> (#.Cons [alias module])))))
+                                 state)
+                        []])))))
+
+(def: #export (exists? module)
+  (-> Text (Operation Bit))
+  (extension.lift
+   (function (_ state)
+     (|> state
+         (get@ #.modules)
+         (plist.get module)
+         (case> (#.Some _) #1 #.None #0)
+         [state] #error.Success))))
+
+(def: #export (define name definition)
+  (-> Text Definition (Operation Any))
+  (do ///.monad
+    [self-name (extension.lift macro.current-module-name)
+     self (extension.lift macro.current-module)]
+    (extension.lift
+     (function (_ state)
+       (case (plist.get name (get@ #.definitions self))
+         #.None
+         (#error.Success [(update@ #.modules
+                                   (plist.put self-name
+                                              (update@ #.definitions
+                                                       (: (-> (List [Text Definition]) (List [Text Definition]))
+                                                          (|>> (#.Cons [name definition])))
+                                                       self))
+                                   state)
+                          []])
+
+         (#.Some already-existing)
+         ((///.throw cannot-define-more-than-once [self-name name]) state))))))
+
+(def: #export (create hash name)
+  (-> Nat Text (Operation Any))
+  (extension.lift
+   (function (_ state)
+     (let [module (new hash)]
+       (#error.Success [(update@ #.modules
+                                 (plist.put name module)
+                                 state)
+                        []])))))
+
+(def: #export (with-module hash name action)
+  (All [a] (-> Nat Text (Operation a) (Operation [Module a])))
+  (do ///.monad
+    [_ (create hash name)
+     output (//.with-current-module name
+              action)
+     module (extension.lift (macro.find-module name))]
+    (wrap [module output])))
+
+(do-template [<setter> <asker> <tag>]
+  [(def: #export (<setter> module-name)
+     (-> Text (Operation Any))
+     (extension.lift
+      (function (_ state)
+        (case (|> state (get@ #.modules) (plist.get module-name))
+          (#.Some module)
+          (let [active? (case (get@ #.module-state module)
+                          #.Active #1
+                          _        #0)]
+            (if active?
+              (#error.Success [(update@ #.modules
+                                        (plist.put module-name (set@ #.module-state <tag> module))
+                                        state)
+                               []])
+              ((///.throw can-only-change-state-of-active-module [module-name <tag>])
+               state)))
+
+          #.None
+          ((///.throw unknown-module module-name) state)))))
+   
+   (def: #export (<asker> module-name)
+     (-> Text (Operation Bit))
+     (extension.lift
+      (function (_ state)
+        (case (|> state (get@ #.modules) (plist.get module-name))
+          (#.Some module)
+          (#error.Success [state
+                           (case (get@ #.module-state module)
+                             <tag> #1
+                             _     #0)])
+
+          #.None
+          ((///.throw unknown-module module-name) state)))))]
+
+  [set-active   active?   #.Active]
+  [set-compiled compiled? #.Compiled]
+  [set-cached   cached?   #.Cached]
+  )
+
+(do-template [<name> <tag> <type>]
+  [(def: (<name> module-name)
+     (-> Text (Operation <type>))
+     (extension.lift
+      (function (_ state)
+        (case (|> state (get@ #.modules) (plist.get module-name))
+          (#.Some module)
+          (#error.Success [state (get@ <tag> module)])
+
+          #.None
+          ((///.throw unknown-module module-name) state)))))]
+
+  [tags  #.tags        (List [Text [Nat (List Name) Bit Type]])]
+  [types #.types       (List [Text [(List Name) Bit Type]])]
+  [hash  #.module-hash Nat]
+  )
+
+(def: (ensure-undeclared-tags module-name tags)
+  (-> Text (List Tag) (Operation Any))
+  (do ///.monad
+    [bindings (..tags module-name)
+     _ (monad.map @
+                  (function (_ tag)
+                    (case (plist.get tag bindings)
+                      #.None
+                      (wrap [])
+
+                      (#.Some _)
+                      (///.throw cannot-declare-tag-twice [module-name tag])))
+                  tags)]
+    (wrap [])))
+
+(def: #export (declare-tags tags exported? type)
+  (-> (List Tag) Bit Type (Operation Any))
+  (do ///.monad
+    [self-name (extension.lift macro.current-module-name)
+     [type-module type-name] (case type
+                               (#.Named type-name _)
+                               (wrap type-name)
+
+                               _
+                               (///.throw cannot-declare-tags-for-unnamed-type [tags type]))
+     _ (ensure-undeclared-tags self-name tags)
+     _ (///.assert cannot-declare-tags-for-foreign-type [tags type]
+                   (text/= self-name type-module))]
+    (extension.lift
+     (function (_ state)
+       (case (|> state (get@ #.modules) (plist.get self-name))
+         (#.Some module)
+         (let [namespaced-tags (list/map (|>> [self-name]) tags)]
+           (#error.Success [(update@ #.modules
+                                     (plist.update self-name
+                                                   (|>> (update@ #.tags (function (_ tag-bindings)
+                                                                          (list/fold (function (_ [idx tag] table)
+                                                                                       (plist.put tag [idx namespaced-tags exported? type] table))
+                                                                                     tag-bindings
+                                                                                     (list.enumerate tags))))
+                                                        (update@ #.types (plist.put type-name [namespaced-tags exported? type]))))
+                                     state)
+                            []]))
+         #.None
+         ((///.throw unknown-module self-name) state))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux
new file mode 100644
index 000000000..b46983293
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux
@@ -0,0 +1,29 @@
+(.module:
+  [lux (#- nat int rev)
+   [control
+    monad]]
+  ["." // (#+ Analysis Operation)
+   [".A" type]
+   ["/." //]])
+
+## [Analysers]
+(do-template [<name> <type> <tag>]
+  [(def: #export (<name> value)
+     (-> <type> (Operation Analysis))
+     (do ///.monad
+       [_ (typeA.infer <type>)]
+       (wrap (#//.Primitive (<tag> value)))))]
+
+  [bit  Bit  #//.Bit]
+  [nat  Nat  #//.Nat]
+  [int  Int  #//.Int]
+  [rev  Rev  #//.Rev]
+  [frac Frac #//.Frac]
+  [text Text #//.Text]
+  )
+
+(def: #export unit
+  (Operation Analysis)
+  (do ///.monad
+    [_ (typeA.infer Any)]
+    (wrap (#//.Primitive #//.Unit))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux
new file mode 100644
index 000000000..5969b9f5c
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux
@@ -0,0 +1,79 @@
+(.module:
+  [lux #*
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   ["." macro]
+   [data
+    ["." text ("#/." equivalence)
+     format]]]
+  ["." // (#+ Analysis Operation)
+   ["." scope]
+   ["." type]
+   ["/." //
+    ["." extension]
+    [//
+     ["." reference]]]])
+
+(exception: #export (foreign-module-has-not-been-imported {current Text} {foreign Text})
+  (ex.report ["Current" current]
+             ["Foreign" foreign]))
+
+(exception: #export (definition-has-not-been-expored {definition Name})
+  (ex.report ["Definition" (%name definition)]))
+
+## [Analysers]
+(def: (definition def-name)
+  (-> Name (Operation Analysis))
+  (with-expansions [<return> (wrap (|> def-name reference.constant #//.Reference))]
+    (do ///.monad
+      [[actualT def-anns _] (extension.lift (macro.find-def def-name))]
+      (case (macro.get-identifier-ann (name-of #.alias) def-anns)
+        (#.Some real-def-name)
+        (definition real-def-name)
+
+        _
+        (do @
+          [_ (type.infer actualT)
+           (^@ def-name [::module ::name]) (extension.lift (macro.normalize def-name))
+           current (extension.lift macro.current-module-name)]
+          (if (text/= current ::module)
+            <return>
+            (if (macro.export? def-anns)
+              (do @
+                [imported! (extension.lift (macro.imported-by? ::module current))]
+                (if imported!
+                  <return>
+                  (///.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)
+  (-> Name (Operation Analysis))
+  (case reference
+    ["" simple-name]
+    (do ///.monad
+      [?var (variable simple-name)]
+      (case ?var
+        (#.Some varA)
+        (wrap varA)
+
+        #.None
+        (do @
+          [this-module (extension.lift macro.current-module-name)]
+          (definition [this-module simple-name]))))
+
+    _
+    (definition reference)))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux
new file mode 100644
index 000000000..69d7c80a9
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux
@@ -0,0 +1,206 @@
+(.module:
+  [lux #*
+   [control
+    monad
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." text ("#/." equivalence)
+     format]
+    ["." maybe ("#/." monad)]
+    ["." product]
+    ["e" error]
+    [collection
+     ["." list ("#/." functor fold monoid)]
+     [dictionary
+      ["." plist]]]]]
+  [// (#+ Operation Phase)
+   ["/." //
+    ["." extension]
+    [//
+     ["." reference (#+ Register Variable)]]]])
+
+(type: Local (Bindings Text [Type Register]))
+(type: Foreign (Bindings Text [Type Variable]))
+
+(def: (local? name scope)
+  (-> Text Scope Bit)
+  (|> scope
+      (get@ [#.locals #.mappings])
+      (plist.contains? name)))
+
+(def: (local name scope)
+  (-> Text Scope (Maybe [Type Variable]))
+  (|> scope
+      (get@ [#.locals #.mappings])
+      (plist.get name)
+      (maybe/map (function (_ [type value])
+                   [type (#reference.Local value)]))))
+
+(def: (captured? name scope)
+  (-> Text Scope Bit)
+  (|> scope
+      (get@ [#.captured #.mappings])
+      (plist.contains? name)))
+
+(def: (captured name scope)
+  (-> Text Scope (Maybe [Type Variable]))
+  (loop [idx 0
+         mappings (get@ [#.captured #.mappings] scope)]
+    (case mappings
+      (#.Cons [_name [_source-type _source-ref]] mappings')
+      (if (text/= name _name)
+        (#.Some [_source-type (#reference.Foreign idx)])
+        (recur (inc idx) mappings'))
+
+      #.Nil
+      #.None)))
+
+(def: (reference? name scope)
+  (-> Text Scope Bit)
+  (or (local? name scope)
+      (captured? name scope)))
+
+(def: (reference name scope)
+  (-> Text Scope (Maybe [Type Variable]))
+  (case (..local name scope)
+    (#.Some type)
+    (#.Some type)
+
+    _
+    (..captured name scope)))
+
+(def: #export (find name)
+  (-> Text (Operation (Maybe [Type Variable])))
+  (extension.lift
+   (function (_ state)
+     (let [[inner outer] (|> state
+                             (get@ #.scopes)
+                             (list.split-with (|>> (reference? name) not)))]
+       (case outer
+         #.Nil
+         (#.Right [state #.None])
+
+         (#.Cons top-outer _)
+         (let [[ref-type init-ref] (maybe.default (undefined)
+                                                  (..reference name top-outer))
+               [ref inner'] (list/fold (: (-> Scope [Variable (List Scope)] [Variable (List Scope)])
+                                          (function (_ scope ref+inner)
+                                            [(#reference.Foreign (get@ [#.captured #.counter] scope))
+                                             (#.Cons (update@ #.captured
+                                                              (: (-> Foreign Foreign)
+                                                                 (|>> (update@ #.counter inc)
+                                                                      (update@ #.mappings (plist.put name [ref-type (product.left ref+inner)]))))
+                                                              scope)
+                                                     (product.right ref+inner))]))
+                                       [init-ref #.Nil]
+                                       (list.reverse inner))
+               scopes (list/compose inner' outer)]
+           (#.Right [(set@ #.scopes scopes state)
+                     (#.Some [ref-type ref])]))
+         )))))
+
+(exception: #export (cannot-create-local-binding-without-a-scope)
+  "")
+
+(exception: #export (invalid-scope-alteration)
+  "")
+
+(def: #export (with-local [name type] action)
+  (All [a] (-> [Text Type] (Operation a) (Operation a)))
+  (function (_ [bundle state])
+    (case (get@ #.scopes state)
+      (#.Cons head tail)
+      (let [old-mappings (get@ [#.locals #.mappings] head)
+            new-var-id (get@ [#.locals #.counter] head)
+            new-head (update@ #.locals
+                              (: (-> Local Local)
+                                 (|>> (update@ #.counter inc)
+                                      (update@ #.mappings (plist.put name [type new-var-id]))))
+                              head)]
+        (case (///.run' [bundle (set@ #.scopes (#.Cons new-head tail) state)]
+                        action)
+          (#e.Success [[bundle' state'] output])
+          (case (get@ #.scopes state')
+            (#.Cons head' tail')
+            (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
+                                  tail')]
+              (#e.Success [[bundle' (set@ #.scopes scopes' state')]
+                           output]))
+
+            _
+            (ex.throw invalid-scope-alteration []))
+
+          (#e.Failure error)
+          (#e.Failure error)))
+
+      _
+      (ex.throw cannot-create-local-binding-without-a-scope []))
+    ))
+
+(do-template [<name> <val-type>]
+  [(def: <name>
+     (Bindings Text [Type <val-type>])
+     {#.counter 0
+      #.mappings (list)})]
+
+  [init-locals   Nat]
+  [init-captured Variable]
+  )
+
+(def: (scope parent-name child-name)
+  (-> (List Text) Text Scope)
+  {#.name     (list& child-name parent-name)
+   #.inner    0
+   #.locals   init-locals
+   #.captured init-captured})
+
+(def: #export (with-scope name action)
+  (All [a] (-> Text (Operation a) (Operation a)))
+  (function (_ [bundle state])
+    (let [parent-name (case (get@ #.scopes state)
+                        #.Nil
+                        (list)
+                        
+                        (#.Cons top _)
+                        (get@ #.name top))]
+      (case (action [bundle (update@ #.scopes
+                                     (|>> (#.Cons (scope parent-name name)))
+                                     state)])
+        (#e.Success [[bundle' state'] output])
+        (#e.Success [[bundle' (update@ #.scopes
+                                       (|>> list.tail (maybe.default (list)))
+                                       state')]
+                     output])
+
+        (#e.Failure error)
+        (#e.Failure error)))
+    ))
+
+(exception: #export (cannot-get-next-reference-when-there-is-no-scope)
+  "")
+
+(def: #export next-local
+  (Operation Register)
+  (extension.lift
+   (function (_ state)
+     (case (get@ #.scopes state)
+       (#.Cons top _)
+       (#e.Success [state (get@ [#.locals #.counter] top)])
+
+       #.Nil
+       (ex.throw cannot-get-next-reference-when-there-is-no-scope [])))))
+
+(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/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux
new file mode 100644
index 000000000..6991c67f7
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux
@@ -0,0 +1,358 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]
+    ["." state]]
+   [data
+    ["." name]
+    ["." number]
+    ["." product]
+    ["." maybe]
+    ["." error]
+    [text
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["dict" dictionary (#+ Dictionary)]]]
+   ["." type
+    ["." check]]
+   ["." macro
+    ["." code]]]
+  ["." // (#+ Tag Analysis Operation Phase)
+   ["//." type]
+   ["." primitive]
+   ["." inference]
+   ["/." //
+    ["." extension]]])
+
+(exception: #export (invalid-variant-type {type Type} {tag Tag} {code Code})
+  (ex.report ["Type" (%type type)]
+             ["Tag" (%n tag)]
+             ["Expression" (%code code)]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {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 [<name>]
+  [(exception: #export (<name> {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 [<name>]
+  [(exception: #export (<name> {key Name} {record (List [Name 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 Name} {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 [Name Code])})
+  (ex.report ["Expected" (|> expected .int %i)]
+             ["Actual" (|> actual .int %i)]
+             ["Type" (%type type)]
+             ["Expression" (%code (|> record
+                                      (list/map (function (_ [keyI valueC])
+                                                  [(code.tag keyI) valueC]))
+                                      code.record))]))
+
+(def: #export (sum analyse tag valueC)
+  (-> Phase Nat Code (Operation Analysis))
+  (do ///.monad
+    [expectedT (extension.lift macro.expected-type)]
+    (///.with-stack cannot-analyse-variant [expectedT tag valueC]
+      (case expectedT
+        (#.Sum _)
+        (let [flat (type.flatten-variant expectedT)
+              type-size (list.size flat)
+              right? (n/= (dec type-size)
+                          tag)
+              lefts (if right?
+                      (dec tag)
+                      tag)]
+          (case (list.nth tag flat)
+            (#.Some variant-type)
+            (do @
+              [valueA (//type.with-type variant-type
+                        (analyse valueC))]
+              (wrap (//.variant [lefts right? valueA])))
+
+            #.None
+            (///.throw inference.variant-tag-out-of-bounds [type-size tag expectedT])))
+
+        (#.Named name unnamedT)
+        (//type.with-type unnamedT
+          (sum analyse tag valueC))
+
+        (#.Var id)
+        (do @
+          [?expectedT' (//type.with-env
+                         (check.read id))]
+          (case ?expectedT'
+            (#.Some expectedT')
+            (//type.with-type expectedT'
+              (sum analyse tag valueC))
+
+            _
+            ## Cannot do inference when the tag is numeric.
+            ## This is because there is no way of knowing how many
+            ## cases the inferred sum type would have.
+            (///.throw cannot-infer-numeric-tag [expectedT tag valueC])
+            ))
+
+        (^template [<tag> <instancer>]
+          (<tag> _)
+          (do @
+            [[instance-id instanceT] (//type.with-env <instancer>)]
+            (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
+              (sum analyse tag valueC))))
+        ([#.UnivQ check.existential]
+         [#.ExQ check.var])
+
+        (#.Apply inputT funT)
+        (case funT
+          (#.Var funT-id)
+          (do @
+            [?funT' (//type.with-env (check.read funT-id))]
+            (case ?funT'
+              (#.Some funT')
+              (//type.with-type (#.Apply inputT funT')
+                (sum analyse tag valueC))
+
+              _
+              (///.throw invalid-variant-type [expectedT tag valueC])))
+
+          _
+          (case (type.apply (list inputT) funT)
+            (#.Some outputT)
+            (//type.with-type outputT
+              (sum analyse tag valueC))
+
+            #.None
+            (///.throw not-a-quantified-type funT)))
+        
+        _
+        (///.throw invalid-variant-type [expectedT tag valueC])))))
+
+(def: (typed-product analyse members)
+  (-> Phase (List Code) (Operation Analysis))
+  (do ///.monad
+    [expectedT (extension.lift macro.expected-type)
+     membersA+ (: (Operation (List Analysis))
+                  (loop [membersT+ (type.flatten-tuple expectedT)
+                         membersC+ members]
+                    (case [membersT+ membersC+]
+                      [(#.Cons memberT #.Nil) _]
+                      (//type.with-type memberT
+                        (:: @ map (|>> list) (analyse (code.tuple membersC+))))
+                      
+                      [_ (#.Cons memberC #.Nil)]
+                      (//type.with-type (type.tuple membersT+)
+                        (:: @ map (|>> list) (analyse memberC)))
+                      
+                      [(#.Cons memberT membersT+') (#.Cons memberC membersC+')]
+                      (do @
+                        [memberA (//type.with-type memberT
+                                   (analyse memberC))
+                         memberA+ (recur membersT+' membersC+')]
+                        (wrap (#.Cons memberA memberA+)))
+
+                      _
+                      (///.throw cannot-analyse-tuple [expectedT members]))))]
+    (wrap (//.tuple membersA+))))
+
+(def: #export (product analyse membersC)
+  (-> Phase (List Code) (Operation Analysis))
+  (do ///.monad
+    [expectedT (extension.lift macro.expected-type)]
+    (///.with-stack cannot-analyse-tuple [expectedT membersC]
+      (case expectedT
+        (#.Product _)
+        (..typed-product analyse membersC)
+
+        (#.Named name unnamedT)
+        (//type.with-type unnamedT
+          (product analyse membersC))
+
+        (#.Var id)
+        (do @
+          [?expectedT' (//type.with-env
+                         (check.read id))]
+          (case ?expectedT'
+            (#.Some expectedT')
+            (//type.with-type expectedT'
+              (product analyse membersC))
+
+            _
+            ## Must do inference...
+            (do @
+              [membersTA (monad.map @ (|>> analyse //type.with-inference)
+                                    membersC)
+               _ (//type.with-env
+                   (check.check expectedT
+                                (type.tuple (list/map product.left membersTA))))]
+              (wrap (//.tuple (list/map product.right membersTA))))))
+
+        (^template [<tag> <instancer>]
+          (<tag> _)
+          (do @
+            [[instance-id instanceT] (//type.with-env <instancer>)]
+            (//type.with-type (maybe.assume (type.apply (list instanceT) expectedT))
+              (product analyse membersC))))
+        ([#.UnivQ check.existential]
+         [#.ExQ check.var])
+
+        (#.Apply inputT funT)
+        (case funT
+          (#.Var funT-id)
+          (do @
+            [?funT' (//type.with-env (check.read funT-id))]
+            (case ?funT'
+              (#.Some funT')
+              (//type.with-type (#.Apply inputT funT')
+                (product analyse membersC))
+
+              _
+              (///.throw invalid-tuple-type [expectedT membersC])))
+
+          _
+          (case (type.apply (list inputT) funT)
+            (#.Some outputT)
+            (//type.with-type outputT
+              (product analyse membersC))
+
+            #.None
+            (///.throw not-a-quantified-type funT)))
+        
+        _
+        (///.throw invalid-tuple-type [expectedT membersC])
+        ))))
+
+(def: #export (tagged-sum analyse tag valueC)
+  (-> Phase Name Code (Operation Analysis))
+  (do ///.monad
+    [tag (extension.lift (macro.normalize tag))
+     [idx group variantT] (extension.lift (macro.resolve-tag tag))
+     expectedT (extension.lift macro.expected-type)]
+    (case expectedT
+      (#.Var _)
+      (do @
+        [#let [case-size (list.size group)]
+         inferenceT (inference.variant idx case-size variantT)
+         [inferredT valueA+] (inference.general analyse inferenceT (list valueC))
+         #let [right? (n/= (dec case-size) idx)
+               lefts (if right?
+                       (dec idx)
+                       idx)]]
+        (wrap (//.variant [lefts right? (|> 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 [Name Code])))
+  (monad.map ///.monad
+             (function (_ [key val])
+               (case key
+                 [_ (#.Tag key)]
+                 (do ///.monad
+                   [key (extension.lift (macro.normalize key))]
+                   (wrap [key val]))
+
+                 _
+                 (///.throw record-keys-must-be-tags [key record])))
+             record))
+
+## Lux already possesses the means to analyse tuples, so
+## re-implementing the same functionality for records makes no sense.
+## Records, thus, get transformed into tuples by ordering the elements.
+(def: #export (order record)
+  (-> (List [Name Code]) (Operation [(List Code) Type]))
+  (case record
+    ## empty-record = empty-tuple = unit = []
+    #.Nil
+    (:: ///.monad wrap [(list) Any])
+
+    (#.Cons [head-k head-v] _)
+    (do ///.monad
+      [head-k (extension.lift (macro.normalize head-k))
+       [_ tag-set recordT] (extension.lift (macro.resolve-tag head-k))
+       #let [size-record (list.size record)
+             size-ts (list.size tag-set)]
+       _ (if (n/= size-ts size-record)
+           (wrap [])
+           (///.throw record-size-mismatch [size-ts size-record recordT record]))
+       #let [tuple-range (list.indices size-ts)
+             tag->idx (dict.from-list name.hash (list.zip2 tag-set tuple-range))]
+       idx->val (monad.fold @
+                            (function (_ [key val] idx->val)
+                              (do @
+                                [key (extension.lift (macro.normalize key))]
+                                (case (dict.get key tag->idx)
+                                  (#.Some idx)
+                                  (if (dict.contains? idx idx->val)
+                                    (///.throw cannot-repeat-tag [key record])
+                                    (wrap (dict.put idx val idx->val)))
+
+                                  #.None
+                                  (///.throw tag-does-not-belong-to-record [key recordT]))))
+                            (: (Dictionary Nat Code)
+                               (dict.new number.hash))
+                            record)
+       #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val)))
+                                     tuple-range)]]
+      (wrap [ordered-tuple recordT]))
+    ))
+
+(def: #export (record analyse members)
+  (-> Phase (List [Code Code]) (Operation Analysis))
+  (do ///.monad
+    [members (normalize members)
+     [membersC recordT] (order members)]
+    (case membersC
+      (^ (list))
+      primitive.unit
+      
+      (^ (list singletonC))
+      (analyse singletonC)
+
+      _
+      (do @
+        [expectedT (extension.lift macro.expected-type)]
+        (case expectedT
+          (#.Var _)
+          (do @
+            [inferenceT (inference.record recordT)
+             [inferredT membersA] (inference.general analyse inferenceT membersC)]
+            (wrap (//.tuple membersA)))
+
+          _
+          (..product analyse membersC))))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/type.lux b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux
new file mode 100644
index 000000000..75d691628
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux
@@ -0,0 +1,52 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." error]]
+   ["." function]
+   [type
+    ["tc" check]]
+   ["." macro]]
+  [// (#+ Operation)
+   ["/." //
+    ["." extension]]])
+
+(def: #export (with-type expected)
+  (All [a] (-> Type (Operation a) (Operation a)))
+  (extension.localized (get@ #.expected) (set@ #.expected)
+                       (function.constant (#.Some expected))))
+
+(def: #export (with-env action)
+  (All [a] (-> (tc.Check a) (Operation a)))
+  (function (_ (^@ stateE [bundle state]))
+    (case (action (get@ #.type-context state))
+      (#error.Success [context' output])
+      (#error.Success [[bundle (set@ #.type-context context' state)]
+                       output])
+
+      (#error.Failure error)
+      ((///.fail error) stateE))))
+
+(def: #export with-fresh-env
+  (All [a] (-> (Operation a) (Operation a)))
+  (extension.localized (get@ #.type-context) (set@ #.type-context)
+                       (function.constant tc.fresh-context)))
+
+(def: #export (infer actualT)
+  (-> Type (Operation Any))
+  (do ///.monad
+    [expectedT (extension.lift macro.expected-type)]
+    (with-env
+      (tc.check expectedT actualT))))
+
+(def: #export (with-inference action)
+  (All [a] (-> (Operation a) (Operation [Type a])))
+  (do ///.monad
+    [[_ varT] (..with-env
+                tc.var)
+     output (with-type varT
+              action)
+     knownT (..with-env
+              (tc.clean varT))]
+    (wrap [knownT output])))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux
new file mode 100644
index 000000000..0d58cf37a
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension.lux
@@ -0,0 +1,140 @@
+(.module:
+  [lux (#- Name)
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    ["." text ("#/." order)
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]
+   ["." function]]
+  ["." //])
+
+(type: #export Name Text)
+
+(type: #export (Extension i)
+  [Name (List i)])
+
+(with-expansions [<Bundle> (as-is (Dictionary Name (Handler s i o)))]
+  (type: #export (Handler s i o)
+    (-> Name
+        (//.Phase [<Bundle> s] i o)
+        (//.Phase [<Bundle> s] (List i) o)))
+
+  (type: #export (Bundle s i o)
+    <Bundle>))
+
+(type: #export (State s i o)
+  {#bundle (Bundle s i o)
+   #state s})
+
+(type: #export (Operation s i o v)
+  (//.Operation (State s i o) v))
+
+(type: #export (Phase s i o)
+  (//.Phase (State s i o) i o))
+
+(do-template [<name>]
+  [(exception: #export (<name> {name Name})
+     (ex.report ["Extension" (%t name)]))]
+
+  [cannot-overwrite]
+  [invalid-syntax]
+  )
+
+(exception: #export [s i o] (unknown {where Text} {name Name} {bundle (Bundle s i o)})
+  (ex.report ["Where" (%t where)]
+             ["Extension" (%t name)]
+             ["Available" (|> bundle
+                              dictionary.keys
+                              (list.sort text/<)
+                              (list/map (|>> %t (format text.new-line text.tab)))
+                              (text.join-with ""))]))
+
+(exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat})
+  (ex.report ["Extension" (%t name)]
+             ["Expected" (%n arity)]
+             ["Actual" (%n args)]))
+
+(def: #export (install name handler)
+  (All [s i o]
+    (-> Text (Handler s i o) (Operation s i o Any)))
+  (function (_ [bundle state])
+    (case (dictionary.get name bundle)
+      #.None
+      (#error.Success [[(dictionary.put name handler bundle) state]
+                       []])
+
+      _
+      (ex.throw cannot-overwrite name))))
+
+(def: #export (apply where phase [name parameters])
+  (All [s i o]
+    (-> Text (Phase s i o) (Extension i) (Operation s i o o)))
+  (function (_ (^@ stateE [bundle state]))
+    (case (dictionary.get name bundle)
+      (#.Some handler)
+      (((handler name phase) parameters)
+       stateE)
+
+      #.None
+      (ex.throw unknown [where name bundle]))))
+
+(def: #export (localized get set transform)
+  (All [s s' i o v]
+    (-> (-> s s') (-> s' s s) (-> s' s')
+        (-> (Operation s i o v) (Operation s i o v))))
+  (function (_ operation)
+    (function (_ [bundle state])
+      (let [old (get state)]
+        (case (operation [bundle (set (transform old) state)])
+          (#error.Success [[bundle' state'] output])
+          (#error.Success [[bundle' (set old state')] output])
+
+          (#error.Failure error)
+          (#error.Failure error))))))
+
+(def: #export (temporary transform)
+  (All [s i o v]
+    (-> (-> s s)
+        (-> (Operation s i o v) (Operation s i o v))))
+  (function (_ operation)
+    (function (_ [bundle state])
+      (case (operation [bundle (transform state)])
+        (#error.Success [[bundle' state'] output])
+        (#error.Success [[bundle' state] output])
+
+        (#error.Failure error)
+        (#error.Failure error)))))
+
+(def: #export (with-state state)
+  (All [s i o v]
+    (-> s (-> (Operation s i o v) (Operation s i o v))))
+  (..temporary (function.constant state)))
+
+(def: #export (read get)
+  (All [s i o v]
+    (-> (-> s v) (Operation s i o v)))
+  (function (_ [bundle state])
+    (#error.Success [[bundle state] (get state)])))
+
+(def: #export (update transform)
+  (All [s i o]
+    (-> (-> s s) (Operation s i o Any)))
+  (function (_ [bundle state])
+    (#error.Success [[bundle (transform state)] []])))
+
+(def: #export (lift action)
+  (All [s i o v]
+    (-> (//.Operation s v)
+        (//.Operation [(Bundle s i o) s] v)))
+  (function (_ [bundle state])
+    (case (action state)
+      (#error.Success [state' output])
+      (#error.Success [[bundle state'] output])
+
+      (#error.Failure error)
+      (#error.Failure error))))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux
new file mode 100644
index 000000000..3b31f3d46
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis.lux
@@ -0,0 +1,18 @@
+(.module:
+  [lux #*
+   [data
+    [collection
+     ["." dictionary]]]]
+  [///
+   [analysis (#+ Bundle)]
+   [//
+    [default
+     [evaluation (#+ Eval)]]]]
+  [/
+   ["." common]
+   ["." host]])
+
+(def: #export (bundle eval)
+  (-> Eval Bundle)
+  (dictionary.merge host.bundle
+                    (common.bundle eval)))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
new file mode 100644
index 000000000..fa9b36270
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
@@ -0,0 +1,219 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]]
+   [data
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]
+   [type
+    ["." check]]
+   ["." macro]
+   [io (#+ IO)]]
+  ["." ///
+   ["." bundle]
+   ["//." //
+    ["." analysis (#+ Analysis Handler Bundle)
+     [".A" type]
+     [".A" case]
+     [".A" function]]
+    [//
+     [default
+      [evaluation (#+ Eval)]]]]])
+
+## [Utils]
+(def: (simple inputsT+ outputT)
+  (-> (List Type) Type Handler)
+  (let [num-expected (list.size inputsT+)]
+    (function (_ extension-name analyse args)
+      (let [num-actual (list.size args)]
+        (if (n/= num-expected num-actual)
+          (do ////.monad
+            [_ (typeA.infer outputT)
+             argsA (monad.map @
+                              (function (_ [argT argC])
+                                (typeA.with-type argT
+                                  (analyse argC)))
+                              (list.zip2 inputsT+ args))]
+            (wrap (#analysis.Extension extension-name argsA)))
+          (////.throw ///.incorrect-arity [extension-name num-expected num-actual]))))))
+
+(def: #export (nullary valueT)
+  (-> Type Handler)
+  (simple (list) valueT))
+
+(def: #export (unary inputT outputT)
+  (-> Type Type Handler)
+  (simple (list inputT) outputT))
+
+(def: #export (binary subjectT paramT outputT)
+  (-> Type Type Type Handler)
+  (simple (list subjectT paramT) outputT))
+
+(def: #export (trinary subjectT param0T param1T outputT)
+  (-> Type Type Type Type Handler)
+  (simple (list subjectT param0T param1T) outputT))
+
+## [Analysers]
+## "lux is" represents reference/pointer equality.
+(def: lux::is
+  Handler
+  (function (_ extension-name analyse args)
+    (do ////.monad
+      [[var-id varT] (typeA.with-env check.var)]
+      ((binary varT varT Bit extension-name)
+       analyse args))))
+
+## "lux try" provides a simple way to interact with the host platform's
+## error-handling facilities.
+(def: lux::try
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list opC))
+      (do ////.monad
+        [[var-id varT] (typeA.with-env check.var)
+         _ (typeA.infer (type (Either Text varT)))
+         opA (typeA.with-type (type (IO varT))
+               (analyse opC))]
+        (wrap (#analysis.Extension extension-name (list opA))))
+      
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: lux::in-module
+  Handler
+  (function (_ extension-name analyse argsC+)
+    (case argsC+
+      (^ (list [_ (#.Text module-name)] exprC))
+      (analysis.with-current-module module-name
+        (analyse exprC))
+      
+      _
+      (////.throw ///.invalid-syntax [extension-name]))))
+
+(do-template [<name> <type>]
+  [(def: (<name> eval)
+     (-> Eval Handler)
+     (function (_ extension-name analyse args)
+       (case args
+         (^ (list typeC valueC))
+         (do ////.monad
+           [count (///.lift macro.count)
+            actualT (:: @ map (|>> (:coerce Type))
+                        (eval count Type typeC))
+            _ (typeA.infer actualT)]
+           (typeA.with-type <type>
+             (analyse valueC)))
+
+         _
+         (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))]
+
+  [lux::check  actualT]
+  [lux::coerce Any]
+  )
+
+(def: lux::check::type
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list valueC))
+      (do ////.monad
+        [_ (typeA.infer Type)
+         valueA (typeA.with-type Type
+                  (analyse valueC))]
+        (wrap valueA))
+      
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: (bundle::lux eval)
+  (-> Eval Bundle)
+  (|> bundle.empty
+      (bundle.install "is" lux::is)
+      (bundle.install "try" lux::try)
+      (bundle.install "check" (lux::check eval))
+      (bundle.install "coerce" (lux::coerce eval))
+      (bundle.install "check type" lux::check::type)
+      (bundle.install "in-module" lux::in-module)))
+
+(def: bundle::io
+  Bundle
+  (<| (bundle.prefix "io")
+      (|> bundle.empty
+          (bundle.install "log" (unary Text Any))
+          (bundle.install "error" (unary Text Nothing))
+          (bundle.install "exit" (unary Int Nothing))
+          (bundle.install "current-time" (nullary Int)))))
+
+(def: I64* (type (I64 Any)))
+
+(def: bundle::i64
+  Bundle
+  (<| (bundle.prefix "i64")
+      (|> bundle.empty
+          (bundle.install "and" (binary I64* I64* I64))
+          (bundle.install "or" (binary I64* I64* I64))
+          (bundle.install "xor" (binary I64* I64* I64))
+          (bundle.install "left-shift" (binary Nat I64* I64))
+          (bundle.install "logical-right-shift" (binary Nat I64* I64))
+          (bundle.install "arithmetic-right-shift" (binary Nat I64* I64))
+          (bundle.install "+" (binary I64* I64* I64))
+          (bundle.install "-" (binary I64* I64* I64))
+          (bundle.install "=" (binary I64* I64* Bit)))))
+
+(def: bundle::int
+  Bundle
+  (<| (bundle.prefix "int")
+      (|> bundle.empty
+          (bundle.install "*" (binary Int Int Int))
+          (bundle.install "/" (binary Int Int Int))
+          (bundle.install "%" (binary Int Int Int))
+          (bundle.install "<" (binary Int Int Bit))
+          (bundle.install "frac" (unary Int Frac))
+          (bundle.install "char" (unary Int Text)))))
+
+(def: bundle::frac
+  Bundle
+  (<| (bundle.prefix "frac")
+      (|> bundle.empty
+          (bundle.install "+" (binary Frac Frac Frac))
+          (bundle.install "-" (binary Frac Frac Frac))
+          (bundle.install "*" (binary Frac Frac Frac))
+          (bundle.install "/" (binary Frac Frac Frac))
+          (bundle.install "%" (binary Frac Frac Frac))
+          (bundle.install "=" (binary Frac Frac Bit))
+          (bundle.install "<" (binary Frac Frac Bit))
+          (bundle.install "smallest" (nullary Frac))
+          (bundle.install "min" (nullary Frac))
+          (bundle.install "max" (nullary Frac))
+          (bundle.install "int" (unary Frac Int))
+          (bundle.install "encode" (unary Frac Text))
+          (bundle.install "decode" (unary Text (type (Maybe Frac)))))))
+
+(def: bundle::text
+  Bundle
+  (<| (bundle.prefix "text")
+      (|> bundle.empty
+          (bundle.install "=" (binary Text Text Bit))
+          (bundle.install "<" (binary Text Text Bit))
+          (bundle.install "concat" (binary Text Text Text))
+          (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat))))
+          (bundle.install "size" (unary Text Nat))
+          (bundle.install "char" (binary Text Nat Nat))
+          (bundle.install "clip" (trinary Text Nat Nat Text))
+          )))
+
+(def: #export (bundle eval)
+  (-> Eval Bundle)
+  (<| (bundle.prefix "lux")
+      (|> bundle.empty
+          (dictionary.merge (bundle::lux eval))
+          (dictionary.merge bundle::i64)
+          (dictionary.merge bundle::int)
+          (dictionary.merge bundle::frac)
+          (dictionary.merge bundle::text)
+          (dictionary.merge bundle::io)
+          )))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux
new file mode 100644
index 000000000..0654e79c4
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/host.jvm.lux
@@ -0,0 +1,1271 @@
+(.module:
+  [lux (#- char int)
+   [control
+    ["." monad (#+ do)]
+    ["p" parser]
+    ["ex" exception (#+ exception:)]
+    pipe]
+   [data
+    ["." error (#+ Error)]
+    ["." maybe]
+    ["." product]
+    ["." text ("#/." equivalence)
+     format]
+    [collection
+     ["." list ("#/." fold functor monoid)]
+     ["." array (#+ Array)]
+     ["." dictionary (#+ Dictionary)]]]
+   ["." type
+    ["." check]]
+   ["." macro
+    ["s" syntax]]
+   ["." host (#+ import:)]]
+  [//
+   ["." common]
+   ["/." //
+    ["." bundle]
+    ["//." // ("#/." monad)
+     ["." analysis (#+ Analysis Operation Handler Bundle)
+      [".A" type]
+      [".A" inference]]]]]
+  )
+
+(type: Method-Signature
+  {#method Type
+   #exceptions (List Type)})
+
+(import: #long java/lang/reflect/Type
+  (getTypeName [] String))
+
+(do-template [<name>]
+  [(exception: #export (<name> {jvm-type java/lang/reflect/Type})
+     (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))]
+
+  [jvm-type-is-not-a-class]
+  [cannot-convert-to-a-class]
+  [cannot-convert-to-a-parameter]
+  [cannot-convert-to-a-lux-type]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {type Type})
+     (%type type))]
+
+  [non-object]
+  [non-array]
+  [non-jvm-type]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {name Text})
+     name)]
+
+  [non-interface]
+  [non-throwable]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [unknown-class]
+  [primitives-cannot-have-type-parameters]
+  [primitives-are-not-objects]
+  [invalid-type-for-array-element]
+
+  [unknown-field]
+  [mistaken-field-owner]
+  [not-a-virtual-field]
+  [not-a-static-field]
+  [cannot-set-a-final-field]
+
+  [cannot-cast]
+
+  [cannot-possibly-be-an-instance]
+
+  [unknown-type-var]
+  [type-parameter-mismatch]
+  [cannot-correspond-type-with-a-class]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {class Text}
+                               {method Text}
+                               {hints (List Method-Signature)})
+     (ex.report ["Class" class]
+                ["Method" method]
+                ["Hints" (|> hints
+                             (list/map (|>> product.left %type (format text.new-line text.tab)))
+                             (text.join-with ""))]))]
+
+  [no-candidates]
+  [too-many-candidates]
+  )
+
+(do-template [<name> <class>]
+  [(def: #export <name> Type (#.Primitive <class> (list)))]
+
+  ## Boxes
+  [Boolean   "java.lang.Boolean"]
+  [Byte      "java.lang.Byte"]
+  [Short     "java.lang.Short"]
+  [Integer   "java.lang.Integer"]
+  [Long      "java.lang.Long"]
+  [Float     "java.lang.Float"]
+  [Double    "java.lang.Double"]
+  [Character "java.lang.Character"]
+  [String    "java.lang.String"]
+
+  ## Primitives
+  [boolean   "boolean"]
+  [byte      "byte"]
+  [short     "short"]
+  [int       "int"]
+  [long      "long"]
+  [float     "float"]
+  [double    "double"]
+  [char      "char"]
+  )
+
+(def: bundle::conversion
+  Bundle
+  (<| (bundle.prefix "convert")
+      (|> bundle.empty
+          (bundle.install "double-to-float" (common.unary Double Float))
+          (bundle.install "double-to-int" (common.unary Double Integer))
+          (bundle.install "double-to-long" (common.unary Double Long))
+          (bundle.install "float-to-double" (common.unary Float Double))
+          (bundle.install "float-to-int" (common.unary Float Integer))
+          (bundle.install "float-to-long" (common.unary Float Long))
+          (bundle.install "int-to-byte" (common.unary Integer Byte))
+          (bundle.install "int-to-char" (common.unary Integer Character))
+          (bundle.install "int-to-double" (common.unary Integer Double))
+          (bundle.install "int-to-float" (common.unary Integer Float))
+          (bundle.install "int-to-long" (common.unary Integer Long))
+          (bundle.install "int-to-short" (common.unary Integer Short))
+          (bundle.install "long-to-double" (common.unary Long Double))
+          (bundle.install "long-to-float" (common.unary Long Float))
+          (bundle.install "long-to-int" (common.unary Long Integer))
+          (bundle.install "long-to-short" (common.unary Long Short))
+          (bundle.install "long-to-byte" (common.unary Long Byte))
+          (bundle.install "char-to-byte" (common.unary Character Byte))
+          (bundle.install "char-to-short" (common.unary Character Short))
+          (bundle.install "char-to-int" (common.unary Character Integer))
+          (bundle.install "char-to-long" (common.unary Character Long))
+          (bundle.install "byte-to-long" (common.unary Byte Long))
+          (bundle.install "short-to-long" (common.unary Short Long))
+          )))
+
+(do-template [<name> <prefix> <type>]
+  [(def: <name>
+     Bundle
+     (<| (bundle.prefix <prefix>)
+         (|> bundle.empty
+             (bundle.install "+" (common.binary <type> <type> <type>))
+             (bundle.install "-" (common.binary <type> <type> <type>))
+             (bundle.install "*" (common.binary <type> <type> <type>))
+             (bundle.install "/" (common.binary <type> <type> <type>))
+             (bundle.install "%" (common.binary <type> <type> <type>))
+             (bundle.install "=" (common.binary <type> <type> Bit))
+             (bundle.install "<" (common.binary <type> <type> Bit))
+             (bundle.install "and" (common.binary <type> <type> <type>))
+             (bundle.install "or" (common.binary <type> <type> <type>))
+             (bundle.install "xor" (common.binary <type> <type> <type>))
+             (bundle.install "shl" (common.binary <type> Integer <type>))
+             (bundle.install "shr" (common.binary <type> Integer <type>))
+             (bundle.install "ushr" (common.binary <type> Integer <type>))
+             )))]
+
+  [bundle::int  "int"  Integer]
+  [bundle::long "long" Long]
+  )
+
+(do-template [<name> <prefix> <type>]
+  [(def: <name>
+     Bundle
+     (<| (bundle.prefix <prefix>)
+         (|> bundle.empty
+             (bundle.install "+" (common.binary <type> <type> <type>))
+             (bundle.install "-" (common.binary <type> <type> <type>))
+             (bundle.install "*" (common.binary <type> <type> <type>))
+             (bundle.install "/" (common.binary <type> <type> <type>))
+             (bundle.install "%" (common.binary <type> <type> <type>))
+             (bundle.install "=" (common.binary <type> <type> Bit))
+             (bundle.install "<" (common.binary <type> <type> Bit))
+             )))]
+
+  [bundle::float  "float"  Float]
+  [bundle::double "double" Double]
+  )
+
+(def: bundle::char
+  Bundle
+  (<| (bundle.prefix "char")
+      (|> bundle.empty
+          (bundle.install "=" (common.binary Character Character Bit))
+          (bundle.install "<" (common.binary Character Character Bit))
+          )))
+
+(def: #export boxes
+  (Dictionary Text Text)
+  (|> (list ["boolean" "java.lang.Boolean"]
+            ["byte"    "java.lang.Byte"]
+            ["short"   "java.lang.Short"]
+            ["int"     "java.lang.Integer"]
+            ["long"    "java.lang.Long"]
+            ["float"   "java.lang.Float"]
+            ["double"  "java.lang.Double"]
+            ["char"    "java.lang.Character"])
+      (dictionary.from-list text.hash)))
+
+(def: array::length
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list arrayC))
+      (do ////.monad
+        [_ (typeA.infer Nat)
+         [var-id varT] (typeA.with-env check.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))]
+        (wrap (#analysis.Extension extension-name (list arrayA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: array::new
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list lengthC))
+      (do ////.monad
+        [lengthA (typeA.with-type Nat
+                   (analyse lengthC))
+         expectedT (///.lift macro.expected-type)
+         [level elem-class] (: (Operation [Nat Text])
+                               (loop [analysisT expectedT
+                                      level 0]
+                                 (case analysisT
+                                   (#.Apply inputT funcT)
+                                   (case (type.apply (list inputT) funcT)
+                                     (#.Some outputT)
+                                     (recur outputT level)
+
+                                     #.None
+                                     (////.throw non-array expectedT))
+
+                                   (^ (#.Primitive "#Array" (list elemT)))
+                                   (recur elemT (inc level))
+
+                                   (#.Primitive class _)
+                                   (wrap [level class])
+                                   
+                                   _
+                                   (////.throw non-array expectedT))))
+         _ (if (n/> 0 level)
+             (wrap [])
+             (////.throw non-array expectedT))]
+        (wrap (#analysis.Extension extension-name (list (analysis.nat (dec level))
+                                                        (analysis.text elem-class)
+                                                        lengthA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: (check-jvm objectT)
+  (-> Type (Operation Text))
+  (case objectT
+    (#.Primitive name _)
+    (/////wrap name)
+
+    (#.Named name unnamed)
+    (check-jvm unnamed)
+
+    (#.Var id)
+    (/////wrap "java.lang.Object")
+
+    (^template [<tag>]
+      (<tag> env unquantified)
+      (check-jvm unquantified))
+    ([#.UnivQ]
+     [#.ExQ])
+
+    (#.Apply inputT funcT)
+    (case (type.apply (list inputT) funcT)
+      (#.Some outputT)
+      (check-jvm outputT)
+
+      #.None
+      (////.throw non-object objectT))
+
+    _
+    (////.throw non-object objectT)))
+
+(def: (check-object objectT)
+  (-> Type (Operation Text))
+  (do ////.monad
+    [name (check-jvm objectT)]
+    (if (dictionary.contains? name boxes)
+      (////.throw primitives-are-not-objects name)
+      (/////wrap name))))
+
+(def: (box-array-element-type elemT)
+  (-> Type (Operation [Type Text]))
+  (case elemT
+    (#.Primitive name #.Nil)
+    (let [boxed-name (|> (dictionary.get name boxes)
+                         (maybe.default name))]
+      (/////wrap [(#.Primitive boxed-name #.Nil)
+                  boxed-name]))
+
+    (#.Primitive name _)
+    (if (dictionary.contains? name boxes)
+      (////.throw primitives-cannot-have-type-parameters name)
+      (/////wrap [elemT name]))
+
+    _
+    (////.throw invalid-type-for-array-element (%type elemT))))
+
+(def: array::read
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list arrayC idxC))
+      (do ////.monad
+        [[var-id varT] (typeA.with-env check.var)
+         _ (typeA.infer varT)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (check.read var-id))
+         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (typeA.with-type Nat
+                (analyse idxC))]
+        (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA arrayA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
+
+(def: array::write
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list arrayC idxC valueC))
+      (do ////.monad
+        [[var-id varT] (typeA.with-env check.var)
+         _ (typeA.infer (type (Array varT)))
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (check.read var-id))
+         [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (typeA.with-type Nat
+                (analyse idxC))
+         valueA (typeA.with-type valueT
+                  (analyse valueC))]
+        (wrap (#analysis.Extension extension-name (list (analysis.text elem-class) idxA valueA arrayA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
+
+(def: bundle::array
+  Bundle
+  (<| (bundle.prefix "array")
+      (|> bundle.empty
+          (bundle.install "length" array::length)
+          (bundle.install "new" array::new)
+          (bundle.install "read" array::read)
+          (bundle.install "write" array::write)
+          )))
+
+(def: object::null
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list))
+      (do ////.monad
+        [expectedT (///.lift macro.expected-type)
+         _ (check-object expectedT)]
+        (wrap (#analysis.Extension extension-name (list))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 0 (list.size args)]))))
+
+(def: object::null?
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list objectC))
+      (do ////.monad
+        [_ (typeA.infer Bit)
+         [objectT objectA] (typeA.with-inference
+                             (analyse objectC))
+         _ (check-object objectT)]
+        (wrap (#analysis.Extension extension-name (list objectA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: object::synchronized
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list monitorC exprC))
+      (do ////.monad
+        [[monitorT monitorA] (typeA.with-inference
+                               (analyse monitorC))
+         _ (check-object monitorT)
+         exprA (analyse exprC)]
+        (wrap (#analysis.Extension extension-name (list monitorA exprA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
+
+(import: java/lang/Object
+  (equals [Object] boolean))
+
+(import: java/lang/ClassLoader)
+
+(import: java/lang/reflect/GenericArrayType
+  (getGenericComponentType [] java/lang/reflect/Type))
+
+(import: java/lang/reflect/ParameterizedType
+  (getRawType [] java/lang/reflect/Type)
+  (getActualTypeArguments [] (Array java/lang/reflect/Type)))
+
+(import: (java/lang/reflect/TypeVariable d)
+  (getName [] String)
+  (getBounds [] (Array java/lang/reflect/Type)))
+
+(import: (java/lang/reflect/WildcardType d)
+  (getLowerBounds [] (Array java/lang/reflect/Type))
+  (getUpperBounds [] (Array java/lang/reflect/Type)))
+
+(import: java/lang/reflect/Modifier
+  (#static isStatic [int] boolean)
+  (#static isFinal [int] boolean)
+  (#static isInterface [int] boolean)
+  (#static isAbstract [int] boolean))
+
+(import: java/lang/reflect/Field
+  (getDeclaringClass [] (java/lang/Class Object))
+  (getModifiers [] int)
+  (getGenericType [] java/lang/reflect/Type))
+
+(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)))
+
+(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)))
+
+(import: (java/lang/Class c)
+  (getName [] String)
+  (getModifiers [] int)
+  (#static forName [String] #try (Class Object))
+  (isAssignableFrom [(Class Object)] boolean)
+  (getTypeParameters [] (Array (TypeVariable (Class c))))
+  (getGenericInterfaces [] (Array java/lang/reflect/Type))
+  (getGenericSuperclass [] java/lang/reflect/Type)
+  (getDeclaredField [String] #try Field)
+  (getConstructors [] (Array (Constructor Object)))
+  (getDeclaredMethods [] (Array Method)))
+
+(def: (load-class name)
+  (-> Text (Operation (Class Object)))
+  (do ////.monad
+    []
+    (case (Class::forName name)
+      (#error.Success [class])
+      (wrap class)
+
+      (#error.Failure error)
+      (////.throw unknown-class name))))
+
+(def: (sub-class? super sub)
+  (-> Text Text (Operation Bit))
+  (do ////.monad
+    [super (load-class super)
+     sub (load-class sub)]
+    (wrap (Class::isAssignableFrom sub super))))
+
+(def: object::throw
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list exceptionC))
+      (do ////.monad
+        [_ (typeA.infer Nothing)
+         [exceptionT exceptionA] (typeA.with-inference
+                                   (analyse exceptionC))
+         exception-class (check-object exceptionT)
+         ? (sub-class? "java.lang.Throwable" exception-class)
+         _ (: (Operation Any)
+              (if ?
+                (wrap [])
+                (////.throw non-throwable exception-class)))]
+        (wrap (#analysis.Extension extension-name (list exceptionA))))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: object::class
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC))
+      (case classC
+        [_ (#.Text class)]
+        (do ////.monad
+          [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
+           _ (load-class class)]
+          (wrap (#analysis.Extension extension-name (list (analysis.text class)))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: object::instance?
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC objectC))
+      (case classC
+        [_ (#.Text class)]
+        (do ////.monad
+          [_ (typeA.infer Bit)
+           [objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           object-class (check-object objectT)
+           ? (sub-class? class object-class)]
+          (if ?
+            (wrap (#analysis.Extension extension-name (list (analysis.text class))))
+            (////.throw cannot-possibly-be-an-instance (format object-class " !<= "  class))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
+
+(def: (java-type-to-class jvm-type)
+  (-> java/lang/reflect/Type (Operation Text))
+  (cond (host.instance? Class jvm-type)
+        (/////wrap (Class::getName (:coerce Class jvm-type)))
+
+        (host.instance? ParameterizedType jvm-type)
+        (java-type-to-class (ParameterizedType::getRawType (:coerce ParameterizedType jvm-type)))
+
+        ## else
+        (////.throw cannot-convert-to-a-class jvm-type)))
+
+(type: Mappings
+  (Dictionary Text Type))
+
+(def: fresh-mappings Mappings (dictionary.new text.hash))
+
+(def: (java-type-to-lux-type mappings java-type)
+  (-> Mappings java/lang/reflect/Type (Operation Type))
+  (cond (host.instance? TypeVariable java-type)
+        (let [var-name (TypeVariable::getName (:coerce TypeVariable java-type))]
+          (case (dictionary.get var-name mappings)
+            (#.Some var-type)
+            (/////wrap var-type)
+            
+            #.None
+            (////.throw unknown-type-var var-name)))
+
+        (host.instance? WildcardType java-type)
+        (let [java-type (:coerce WildcardType java-type)]
+          (case [(array.read 0 (WildcardType::getUpperBounds java-type))
+                 (array.read 0 (WildcardType::getLowerBounds java-type))]
+            (^or [(#.Some bound) _] [_ (#.Some bound)])
+            (java-type-to-lux-type mappings bound)
+            
+            _
+            (/////wrap Any)))
+
+        (host.instance? Class java-type)
+        (let [java-type (:coerce (Class Object) java-type)
+              class-name (Class::getName java-type)]
+          (/////wrap (case (array.size (Class::getTypeParameters java-type))
+                       0
+                       (#.Primitive class-name (list))
+                       
+                       arity
+                       (|> (list.indices arity)
+                           list.reverse
+                           (list/map (|>> (n/* 2) inc #.Parameter))
+                           (#.Primitive class-name)
+                           (type.univ-q arity)))))
+
+        (host.instance? ParameterizedType java-type)
+        (let [java-type (:coerce ParameterizedType java-type)
+              raw (ParameterizedType::getRawType java-type)]
+          (if (host.instance? Class raw)
+            (do ////.monad
+              [paramsT (|> java-type
+                           ParameterizedType::getActualTypeArguments
+                           array.to-list
+                           (monad.map @ (java-type-to-lux-type mappings)))]
+              (/////wrap (#.Primitive (Class::getName (:coerce (Class Object) raw))
+                                      paramsT)))
+            (////.throw jvm-type-is-not-a-class raw)))
+
+        (host.instance? GenericArrayType java-type)
+        (do ////.monad
+          [innerT (|> (:coerce GenericArrayType java-type)
+                      GenericArrayType::getGenericComponentType
+                      (java-type-to-lux-type mappings))]
+          (wrap (#.Primitive "#Array" (list innerT))))
+
+        ## else
+        (////.throw cannot-convert-to-a-lux-type java-type)))
+
+(def: (correspond-type-params class type)
+  (-> (Class Object) Type (Operation Mappings))
+  (case type
+    (#.Primitive name params)
+    (let [class-name (Class::getName class)
+          class-params (array.to-list (Class::getTypeParameters class))
+          num-class-params (list.size class-params)
+          num-type-params (list.size params)]
+      (cond (not (text/= class-name name))
+            (////.throw cannot-correspond-type-with-a-class
+                        (format "Class = " class-name text.new-line
+                                "Type = " (%type type)))
+
+            (not (n/= num-class-params num-type-params))
+            (////.throw type-parameter-mismatch
+                        (format "Expected: " (%i (.int num-class-params)) text.new-line
+                                "  Actual: " (%i (.int num-type-params)) text.new-line
+                                "   Class: " class-name text.new-line
+                                "    Type: " (%type type)))
+
+            ## else
+            (/////wrap (|> params
+                           (list.zip2 (list/map (|>> TypeVariable::getName) class-params))
+                           (dictionary.from-list text.hash)))
+            ))
+
+    _
+    (////.throw non-jvm-type type)))
+
+(def: object::cast
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list valueC))
+      (do ////.monad
+        [toT (///.lift macro.expected-type)
+         to-name (check-jvm toT)
+         [valueT valueA] (typeA.with-inference
+                           (analyse valueC))
+         from-name (check-jvm valueT)
+         can-cast? (: (Operation Bit)
+                      (case [from-name to-name]
+                        (^template [<primitive> <object>]
+                          (^or [<primitive> <object>]
+                               [<object> <primitive>])
+                          (do @
+                            [_ (typeA.infer (#.Primitive to-name (list)))]
+                            (wrap #1)))
+                        (["boolean" "java.lang.Boolean"]
+                         ["byte"    "java.lang.Byte"]
+                         ["short"   "java.lang.Short"]
+                         ["int"     "java.lang.Integer"]
+                         ["long"    "java.lang.Long"]
+                         ["float"   "java.lang.Float"]
+                         ["double"  "java.lang.Double"]
+                         ["char"    "java.lang.Character"])
+
+                        _
+                        (do @
+                          [_ (////.assert primitives-are-not-objects from-name
+                                          (not (dictionary.contains? from-name boxes)))
+                           _ (////.assert primitives-are-not-objects to-name
+                                          (not (dictionary.contains? to-name boxes)))
+                           to-class (load-class to-name)]
+                          (loop [[current-name currentT] [from-name valueT]]
+                            (if (text/= to-name current-name)
+                              (do @
+                                [_ (typeA.infer toT)]
+                                (wrap #1))
+                              (do @
+                                [current-class (load-class current-name)
+                                 _ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line
+                                                                    "  To class/primitive: " to-name text.new-line
+                                                                    "           For value: " (%code valueC) text.new-line)
+                                                (Class::isAssignableFrom current-class to-class))
+                                 candiate-parents (monad.map @
+                                                             (function (_ java-type)
+                                                               (do @
+                                                                 [class-name (java-type-to-class java-type)
+                                                                  class (load-class class-name)]
+                                                                 (wrap [[class-name java-type] (Class::isAssignableFrom class to-class)])))
+                                                             (list& (Class::getGenericSuperclass current-class)
+                                                                    (array.to-list (Class::getGenericInterfaces current-class))))]
+                                (case (|> candiate-parents
+                                          (list.filter product.right)
+                                          (list/map product.left))
+                                  (#.Cons [next-name nextJT] _)
+                                  (do @
+                                    [mapping (correspond-type-params current-class currentT)
+                                     nextT (java-type-to-lux-type mapping nextJT)]
+                                    (recur [next-name nextT]))
+
+                                  #.Nil
+                                  (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line
+                                                                  "  To class/primitive: " to-name text.new-line
+                                                                  "           For value: " (%code valueC) text.new-line)))
+                                ))))))]
+        (if can-cast?
+          (wrap (#analysis.Extension extension-name (list (analysis.text from-name)
+                                                          (analysis.text to-name)
+                                                          valueA)))
+          (////.throw cannot-cast (format "From class/primitive: " from-name text.new-line
+                                          "  To class/primitive: " to-name text.new-line
+                                          "           For value: " (%code valueC) text.new-line))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: bundle::object
+  Bundle
+  (<| (bundle.prefix "object")
+      (|> bundle.empty
+          (bundle.install "null" object::null)
+          (bundle.install "null?" object::null?)
+          (bundle.install "synchronized" object::synchronized)
+          (bundle.install "throw" object::throw)
+          (bundle.install "class" object::class)
+          (bundle.install "instance?" object::instance?)
+          (bundle.install "cast" object::cast)
+          )))
+
+(def: (find-field class-name field-name)
+  (-> Text Text (Operation [(Class Object) Field]))
+  (do ////.monad
+    [class (load-class class-name)]
+    (case (Class::getDeclaredField field-name class)
+      (#error.Success field)
+      (let [owner (Field::getDeclaringClass field)]
+        (if (is? owner class)
+          (wrap [class field])
+          (////.throw mistaken-field-owner
+                      (format "       Field: " field-name text.new-line
+                              " Owner Class: " (Class::getName owner) text.new-line
+                              "Target Class: " class-name text.new-line))))
+
+      (#error.Failure _)
+      (////.throw unknown-field (format class-name "#" field-name)))))
+
+(def: (static-field class-name field-name)
+  (-> Text Text (Operation [Type Bit]))
+  (do ////.monad
+    [[class fieldJ] (find-field class-name field-name)
+     #let [modifiers (Field::getModifiers fieldJ)]]
+    (if (Modifier::isStatic modifiers)
+      (let [fieldJT (Field::getGenericType fieldJ)]
+        (do @
+          [fieldT (java-type-to-lux-type fresh-mappings fieldJT)]
+          (wrap [fieldT (Modifier::isFinal modifiers)])))
+      (////.throw not-a-static-field (format class-name "#" field-name)))))
+
+(def: (virtual-field class-name field-name objectT)
+  (-> Text Text Type (Operation [Type Bit]))
+  (do ////.monad
+    [[class fieldJ] (find-field class-name field-name)
+     #let [modifiers (Field::getModifiers fieldJ)]]
+    (if (not (Modifier::isStatic modifiers))
+      (do @
+        [#let [fieldJT (Field::getGenericType fieldJ)
+               var-names (|> class
+                             Class::getTypeParameters
+                             array.to-list
+                             (list/map (|>> TypeVariable::getName)))]
+         mappings (: (Operation Mappings)
+                     (case objectT
+                       (#.Primitive _class-name _class-params)
+                       (do @
+                         [#let [num-params (list.size _class-params)
+                                num-vars (list.size var-names)]
+                          _ (////.assert type-parameter-mismatch
+                                         (format "Expected: " (%i (.int num-params)) text.new-line
+                                                 "  Actual: " (%i (.int num-vars)) text.new-line
+                                                 "   Class: " _class-name text.new-line
+                                                 "    Type: " (%type objectT))
+                                         (n/= num-params num-vars))]
+                         (wrap (|> (list.zip2 var-names _class-params)
+                                   (dictionary.from-list text.hash))))
+
+                       _
+                       (////.throw non-object objectT)))
+         fieldT (java-type-to-lux-type mappings fieldJT)]
+        (wrap [fieldT (Modifier::isFinal modifiers)]))
+      (////.throw not-a-virtual-field (format class-name "#" field-name)))))
+
+(def: static::get
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC fieldC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do ////.monad
+          [[fieldT final?] (static-field class field)]
+          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field)))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 2 (list.size args)]))))
+
+(def: static::put
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC fieldC valueC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do ////.monad
+          [_ (typeA.infer Any)
+           [fieldT final?] (static-field class field)
+           _ (////.assert cannot-set-a-final-field (format class "#" field)
+                          (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
+
+(def: virtual::get
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC fieldC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do ////.monad
+          [[objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           [fieldT final?] (virtual-field class field objectT)]
+          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) objectA))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 3 (list.size args)]))))
+
+(def: virtual::put
+  Handler
+  (function (_ extension-name analyse args)
+    (case args
+      (^ (list classC fieldC valueC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do ////.monad
+          [[objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           _ (typeA.infer objectT)
+           [fieldT final?] (virtual-field class field objectT)
+           _ (////.assert cannot-set-a-final-field (format class "#" field)
+                          (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysis.Extension extension-name (list (analysis.text class) (analysis.text field) valueA objectA))))
+
+        _
+        (////.throw ///.invalid-syntax extension-name))
+
+      _
+      (////.throw ///.incorrect-arity [extension-name 4 (list.size args)]))))
+
+(def: (java-type-to-parameter type)
+  (-> java/lang/reflect/Type (Operation Text))
+  (cond (host.instance? Class type)
+        (/////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))
+        (/////wrap "java.lang.Object")
+
+        (host.instance? GenericArrayType type)
+        (do ////.monad
+          [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))]
+          (wrap (format componentP "[]")))
+
+        ## else
+        (////.throw cannot-convert-to-a-parameter type)))
+
+(type: Method-Style
+  #Static
+  #Abstract
+  #Virtual
+  #Special
+  #Interface)
+
+(def: (check-method class method-name method-style arg-classes method)
+  (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit))
+  (do ////.monad
+    [parameters (|> (Method::getGenericParameterTypes method)
+                    array.to-list
+                    (monad.map @ java-type-to-parameter))
+     #let [modifiers (Method::getModifiers method)]]
+    (wrap (and (Object::equals class (Method::getDeclaringClass method))
+               (text/= method-name (Method::getName method))
+               (case #Static
+                 #Special
+                 (Modifier::isStatic modifiers)
+
+                 _
+                 #1)
+               (case method-style
+                 #Special
+                 (not (or (Modifier::isInterface (Class::getModifiers class))
+                          (Modifier::isAbstract modifiers)))
+
+                 _
+                 #1)
+               (n/= (list.size arg-classes) (list.size parameters))
+               (list/fold (function (_ [expectedJC actualJC] prev)
+                            (and prev
+                                 (text/= expectedJC actualJC)))
+                          #1
+                          (list.zip2 arg-classes parameters))))))
+
+(def: (check-constructor class arg-classes constructor)
+  (-> (Class Object) (List Text) (Constructor Object) (Operation Bit))
+  (do ////.monad
+    [parameters (|> (Constructor::getGenericParameterTypes constructor)
+                    array.to-list
+                    (monad.map @ java-type-to-parameter))]
+    (wrap (and (Object::equals class (Constructor::getDeclaringClass constructor))
+               (n/= (list.size arg-classes) (list.size parameters))
+               (list/fold (function (_ [expectedJC actualJC] prev)
+                            (and prev
+                                 (text/= expectedJC actualJC)))
+                          #1
+                          (list.zip2 arg-classes parameters))))))
+
+(def: idx-to-parameter
+  (-> Nat Type)
+  (|>> (n/* 2) inc #.Parameter))
+
+(def: (type-vars amount offset)
+  (-> Nat Nat (List Type))
+  (if (n/= 0 amount)
+    (list)
+    (|> (list.indices amount)
+        (list/map (|>> (n/+ offset) idx-to-parameter)))))
+
+(def: (method-signature method-style method)
+  (-> Method-Style Method (Operation Method-Signature))
+  (let [owner (Method::getDeclaringClass method)
+        owner-name (Class::getName owner)
+        owner-tvars (case method-style
+                      #Static
+                      (list)
+
+                      _
+                      (|> (Class::getTypeParameters owner)
+                          array.to-list
+                          (list/map (|>> TypeVariable::getName))))
+        method-tvars (|> (Method::getTypeParameters method)
+                         array.to-list
+                         (list/map (|>> TypeVariable::getName)))
+        num-owner-tvars (list.size owner-tvars)
+        num-method-tvars (list.size method-tvars)
+        all-tvars (list/compose owner-tvars method-tvars)
+        num-all-tvars (list.size all-tvars)
+        owner-tvarsT (type-vars num-owner-tvars 0)
+        method-tvarsT (type-vars num-method-tvars num-owner-tvars)
+        mappings (: Mappings
+                    (if (list.empty? all-tvars)
+                      fresh-mappings
+                      (|> (list/compose owner-tvarsT method-tvarsT)
+                          list.reverse
+                          (list.zip2 all-tvars)
+                          (dictionary.from-list text.hash))))]
+    (do ////.monad
+      [inputsT (|> (Method::getGenericParameterTypes method)
+                   array.to-list
+                   (monad.map @ (java-type-to-lux-type mappings)))
+       outputT (java-type-to-lux-type mappings (Method::getGenericReturnType method))
+       exceptionsT (|> (Method::getGenericExceptionTypes method)
+                       array.to-list
+                       (monad.map @ (java-type-to-lux-type mappings)))
+       #let [methodT (<| (type.univ-q num-all-tvars)
+                         (type.function (case method-style
+                                          #Static
+                                          inputsT
+
+                                          _
+                                          (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
+                                                 inputsT)))
+                         outputT)]]
+      (wrap [methodT exceptionsT]))))
+
+(type: Evaluation
+  (#Pass Method-Signature)
+  (#Hint Method-Signature)
+  #Fail)
+
+(do-template [<name> <tag>]
+  [(def: <name>
+     (-> Evaluation (Maybe Method-Signature))
+     (|>> (case> (<tag> output)
+                 (#.Some output)
+
+                 _
+                 #.None)))]
+
+  [pass! #Pass]
+  [hint! #Hint]
+  )
+
+(def: (method-candidate class-name method-name method-style arg-classes)
+  (-> Text Text Method-Style (List Text) (Operation Method-Signature))
+  (do ////.monad
+    [class (load-class class-name)
+     candidates (|> class
+                    Class::getDeclaredMethods
+                    array.to-list
+                    (monad.map @ (: (-> Method (Operation Evaluation))
+                                    (function (_ method)
+                                      (do @
+                                        [passes? (check-method class method-name method-style arg-classes method)]
+                                        (cond passes?
+                                              (:: @ map (|>> #Pass) (method-signature method-style method))
+
+                                              (text/= method-name (Method::getName method))
+                                              (:: @ map (|>> #Hint) (method-signature method-style method))
+
+                                              ## else
+                                              (wrap #Fail)))))))]
+    (case (list.search-all pass! candidates)
+      (#.Cons method #.Nil)
+      (wrap method)
+
+      #.Nil
+      (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
+      
+      candidates
+      (////.throw too-many-candidates [class-name method-name candidates]))))
+
+(def: (constructor-signature constructor)
+  (-> (Constructor Object) (Operation Method-Signature))
+  (let [owner (Constructor::getDeclaringClass constructor)
+        owner-name (Class::getName owner)
+        owner-tvars (|> (Class::getTypeParameters owner)
+                        array.to-list
+                        (list/map (|>> TypeVariable::getName)))
+        constructor-tvars (|> (Constructor::getTypeParameters constructor)
+                              array.to-list
+                              (list/map (|>> TypeVariable::getName)))
+        num-owner-tvars (list.size owner-tvars)
+        all-tvars (list/compose owner-tvars constructor-tvars)
+        num-all-tvars (list.size all-tvars)
+        owner-tvarsT (type-vars num-owner-tvars 0)
+        constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
+        mappings (: Mappings
+                    (if (list.empty? all-tvars)
+                      fresh-mappings
+                      (|> (list/compose owner-tvarsT constructor-tvarsT)
+                          list.reverse
+                          (list.zip2 all-tvars)
+                          (dictionary.from-list text.hash))))]
+    (do ////.monad
+      [inputsT (|> (Constructor::getGenericParameterTypes constructor)
+                   array.to-list
+                   (monad.map @ (java-type-to-lux-type mappings)))
+       exceptionsT (|> (Constructor::getGenericExceptionTypes constructor)
+                       array.to-list
+                       (monad.map @ (java-type-to-lux-type mappings)))
+       #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT))
+             constructorT (<| (type.univ-q num-all-tvars)
+                              (type.function inputsT)
+                              objectT)]]
+      (wrap [constructorT exceptionsT]))))
+
+(def: constructor-method "<init>")
+
+(def: (constructor-candidate class-name arg-classes)
+  (-> Text (List Text) (Operation Method-Signature))
+  (do ////.monad
+    [class (load-class class-name)
+     candidates (|> class
+                    Class::getConstructors
+                    array.to-list
+                    (monad.map @ (function (_ constructor)
+                                   (do @
+                                     [passes? (check-constructor class arg-classes constructor)]
+                                     (:: @ map
+                                         (if passes? (|>> #Pass) (|>> #Hint))
+                                         (constructor-signature constructor))))))]
+    (case (list.search-all pass! candidates)
+      (#.Cons constructor #.Nil)
+      (wrap constructor)
+
+      #.Nil
+      (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
+      
+      candidates
+      (////.throw too-many-candidates [class-name ..constructor-method candidates]))))
+
+(def: (decorate-inputs typesT inputsA)
+  (-> (List Text) (List Analysis) (List Analysis))
+  (|> inputsA
+      (list.zip2 (list/map analysis.text typesT))
+      (list/map (function (_ [type value])
+                  (analysis.tuple (list type value))))))
+
+(def: invoke::static
+  Handler
+  (function (_ extension-name analyse args)
+    (case (: (Error [Text Text (List [Text Code])])
+             (s.run args ($_ p.and s.text s.text (p.some (s.tuple (p.and s.text s.any))))))
+      (#error.Success [class method argsTC])
+      (do ////.monad
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (method-candidate class method #Static argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
+                                                         (analysis.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: invoke::virtual
+  Handler
+  (function (_ extension-name analyse args)
+    (case (: (Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
+      (#error.Success [class method objectC argsTC])
+      (do ////.monad
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (method-candidate class method #Virtual argsT)
+         [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         #let [[objectA argsA] (case allA
+                                 (#.Cons objectA argsA)
+                                 [objectA argsA]
+
+                                 _
+                                 (undefined))]
+         outputJC (check-jvm outputT)]
+        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
+                                                         (analysis.text outputJC) objectA (decorate-inputs argsT argsA)))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: invoke::special
+  Handler
+  (function (_ extension-name analyse args)
+    (case (: (Error [(List Code) [Text Text Code (List [Text Code]) Any]])
+             (p.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))) s.end!)))
+      (#error.Success [_ [class method objectC argsTC _]])
+      (do ////.monad
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (method-candidate class method #Special argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (analysis.text method)
+                                                         (analysis.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: invoke::interface
+  Handler
+  (function (_ extension-name analyse args)
+    (case (: (Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.and s.text s.text s.any (p.some (s.tuple (p.and s.text s.any))))))
+      (#error.Success [class-name method objectC argsTC])
+      (do ////.monad
+        [#let [argsT (list/map product.left argsTC)]
+         class (load-class class-name)
+         _ (////.assert non-interface class-name
+                        (Modifier::isInterface (Class::getModifiers class)))
+         [methodT exceptionsT] (method-candidate class-name method #Interface argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysis.Extension extension-name
+                                   (list& (analysis.text class-name) (analysis.text method) (analysis.text outputJC)
+                                          (decorate-inputs argsT argsA)))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: invoke::constructor
+  Handler
+  (function (_ extension-name analyse args)
+    (case (: (Error [Text (List [Text Code])])
+             (s.run args ($_ p.and s.text (p.some (s.tuple (p.and s.text s.any))))))
+      (#error.Success [class argsTC])
+      (do ////.monad
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (constructor-candidate class argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))]
+        (wrap (#analysis.Extension extension-name (list& (analysis.text class) (decorate-inputs argsT argsA)))))
+
+      _
+      (////.throw ///.invalid-syntax extension-name))))
+
+(def: bundle::member
+  Bundle
+  (<| (bundle.prefix "member")
+      (|> bundle.empty
+          (dictionary.merge (<| (bundle.prefix "static")
+                                (|> bundle.empty
+                                    (bundle.install "get" static::get)
+                                    (bundle.install "put" static::put))))
+          (dictionary.merge (<| (bundle.prefix "virtual")
+                                (|> bundle.empty
+                                    (bundle.install "get" virtual::get)
+                                    (bundle.install "put" virtual::put))))
+          (dictionary.merge (<| (bundle.prefix "invoke")
+                                (|> bundle.empty
+                                    (bundle.install "static" invoke::static)
+                                    (bundle.install "virtual" invoke::virtual)
+                                    (bundle.install "special" invoke::special)
+                                    (bundle.install "interface" invoke::interface)
+                                    (bundle.install "constructor" invoke::constructor)
+                                    )))
+          )))
+
+(def: #export bundle
+  Bundle
+  (<| (bundle.prefix "jvm")
+      (|> bundle.empty
+          (dictionary.merge bundle::conversion)
+          (dictionary.merge bundle::int)
+          (dictionary.merge bundle::long)
+          (dictionary.merge bundle::float)
+          (dictionary.merge bundle::double)
+          (dictionary.merge bundle::char)
+          (dictionary.merge bundle::array)
+          (dictionary.merge bundle::object)
+          (dictionary.merge bundle::member)
+          )))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux b/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux
new file mode 100644
index 000000000..643e3b38c
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/bundle.lux
@@ -0,0 +1,28 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]
+   [data
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]]
+  [// (#+ Handler Bundle)])
+
+(def: #export empty
+  Bundle
+  (dictionary.new text.hash))
+
+(def: #export (install name anonymous)
+  (All [s i o]
+    (-> Text (Handler s i o)
+        (-> (Bundle s i o) (Bundle s i o))))
+  (dictionary.put name anonymous))
+
+(def: #export (prefix prefix)
+  (All [s i o]
+    (-> Text (-> (Bundle s i o) (Bundle s i o))))
+  (|>> dictionary.entries
+       (list/map (function (_ [key val]) [(format prefix " " key) val]))
+       (dictionary.from-list text.hash)))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
new file mode 100644
index 000000000..c5ae87050
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux
@@ -0,0 +1,199 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    pipe]
+   [data
+    [text
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary]]]
+   ["." macro]
+   [type (#+ :share)
+    ["." check]]]
+  ["." //
+   ["." bundle]
+   ["/." //
+    ["." analysis
+     ["." module]
+     ["." type]]
+    ["." synthesis]
+    ["." translation]
+    ["." statement (#+ Operation Handler Bundle)]]])
+
+(def: (evaluate! type codeC)
+  (All [anchor expression statement]
+    (-> Type Code (Operation anchor expression statement [Type expression Any])))
+  (do ///.monad
+    [state (//.lift ///.get-state)
+     #let [analyse (get@ [#statement.analysis #statement.phase] state)
+           synthesize (get@ [#statement.synthesis #statement.phase] state)
+           translate (get@ [#statement.translation #statement.phase] state)]
+     [_ code//type codeA] (statement.lift-analysis
+                           (analysis.with-scope
+                             (type.with-fresh-env
+                               (type.with-type type
+                                 (do @
+                                   [codeA (analyse codeC)]
+                                   (wrap [type codeA]))))))
+     codeS (statement.lift-synthesis
+            (synthesize codeA))]
+    (statement.lift-translation
+     (translation.with-buffer
+       (do @
+         [codeT (translate codeS)
+          count translation.next
+          codeV (translation.evaluate! (format "evaluate" (%n count)) codeT)]
+         (wrap [code//type codeT codeV]))))))
+
+(def: (define! name ?type codeC)
+  (All [anchor expression statement]
+    (-> Name (Maybe Type) Code
+        (Operation anchor expression statement [Type expression Text Any])))
+  (do ///.monad
+    [state (//.lift ///.get-state)
+     #let [analyse (get@ [#statement.analysis #statement.phase] state)
+           synthesize (get@ [#statement.synthesis #statement.phase] state)
+           translate (get@ [#statement.translation #statement.phase] state)]
+     [_ code//type codeA] (statement.lift-analysis
+                           (analysis.with-scope
+                             (type.with-fresh-env
+                               (case ?type
+                                 (#.Some type)
+                                 (type.with-type type
+                                   (do @
+                                     [codeA (analyse codeC)]
+                                     (wrap [type codeA])))
+
+                                 #.None
+                                 (do @
+                                   [[code//type codeA] (type.with-inference (analyse codeC))
+                                    code//type (type.with-env
+                                                 (check.clean code//type))]
+                                   (wrap [code//type codeA]))))))
+     codeS (statement.lift-synthesis
+            (synthesize codeA))]
+    (statement.lift-translation
+     (translation.with-buffer
+       (do @
+         [codeT (translate codeS)
+          codeN+V (translation.define! name codeT)]
+         (wrap [code//type codeT codeN+V]))))))
+
+(def: lux::def
+  Handler
+  (function (_ extension-name phase inputsC+)
+    (case inputsC+
+      (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC))
+      (do ///.monad
+        [current-module (statement.lift-analysis
+                         (//.lift macro.current-module-name))
+         #let [full-name [current-module short-name]]
+         [_ annotationsT annotationsV] (evaluate! Code annotationsC)
+         #let [annotationsV (:coerce Code annotationsV)]
+         [value//type valueT valueN valueV] (define! full-name
+                                                     (if (macro.type? annotationsV)
+                                                       (#.Some Type)
+                                                       #.None)
+                                                     valueC)
+         _ (statement.lift-analysis
+            (do @
+              [_ (module.define short-name [value//type annotationsV valueV])]
+              (if (macro.type? annotationsV)
+                (case (macro.declared-tags annotationsV)
+                  #.Nil
+                  (wrap [])
+
+                  tags
+                  (module.declare-tags tags (macro.export? annotationsV) (:coerce Type valueV)))
+                (wrap []))))
+         #let [_ (log! (format "Definition " (%name full-name)))]]
+        (statement.lift-translation
+         (translation.learn full-name valueN)))
+
+      _
+      (///.throw //.invalid-syntax [extension-name]))))
+
+(def: (alias! alias def-name)
+  (-> Text Name (analysis.Operation Any))
+  (do ///.monad
+    [definition (//.lift (macro.find-def def-name))]
+    (module.define alias definition)))
+
+(def: def::module
+  Handler
+  (function (_ extension-name phase inputsC+)
+    (case inputsC+
+      (^ (list annotationsC))
+      (do ///.monad
+        [[_ annotationsT annotationsV] (evaluate! Code annotationsC)
+         _ (statement.lift-analysis
+            (module.set-annotations (:coerce Code annotationsV)))]
+        (wrap []))
+
+      _
+      (///.throw //.invalid-syntax [extension-name]))))
+
+(def: def::alias
+  Handler
+  (function (_ extension-name phase inputsC+)
+    (case inputsC+
+      (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)]))
+      (//.lift
+       (///.sub [(get@ [#statement.analysis #statement.state])
+                 (set@ [#statement.analysis #statement.state])]
+                (alias! alias def-name)))
+
+      _
+      (///.throw //.invalid-syntax [extension-name]))))
+
+(do-template [<mame> <type> <scope>]
+  [(def: <mame>
+     (All [anchor expression statement]
+       (Handler anchor expression statement))
+     (function (handler extension-name phase inputsC+)
+       (case inputsC+
+         (^ (list [_ (#.Text name)] valueC))
+         (do ///.monad
+           [[_ handlerT handlerV] (evaluate! (:of (:share [anchor expression statement]
+                                                          {(Handler anchor expression statement)
+                                                           handler}
+                                                          {<type>
+                                                           (:assume [])}))
+                                             valueC)]
+           (<| <scope>
+               (//.install name)
+               (:share [anchor expression statement]
+                       {(Handler anchor expression statement)
+                        handler}
+                       {<type>
+                        (:assume handlerV)})))
+
+         _
+         (///.throw //.invalid-syntax [extension-name]))))]
+
+  [def::analysis    analysis.Handler                                  statement.lift-analysis]
+  [def::synthesis   synthesis.Handler                                 statement.lift-synthesis]
+  [def::translation (translation.Handler anchor expression statement) statement.lift-translation]
+  [def::statement   (statement.Handler anchor expression statement)   (<|)]
+  )
+
+(def: bundle::def
+  Bundle
+  (<| (bundle.prefix "def")
+      (|> bundle.empty
+          (dictionary.put "module"      def::module)
+          (dictionary.put "alias"       def::alias)
+          (dictionary.put "analysis"    def::analysis)
+          (dictionary.put "synthesis"   def::synthesis)
+          (dictionary.put "translation" def::translation)
+          (dictionary.put "statement"   def::statement)
+          )))
+
+(def: #export bundle
+  Bundle
+  (<| (bundle.prefix "lux")
+      (|> bundle.empty
+          (dictionary.put "def" lux::def)
+          (dictionary.merge ..bundle::def))))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux
new file mode 100644
index 000000000..1a2e44f6f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/synthesis.lux
@@ -0,0 +1,10 @@
+(.module:
+  [lux #*]
+  [//
+   ["." bundle]
+   [//
+    [synthesis (#+ Bundle)]]])
+
+(def: #export bundle
+  Bundle
+  bundle.empty)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/translation.lux b/stdlib/source/lux/tool/compiler/phase/extension/translation.lux
new file mode 100644
index 000000000..232c8c168
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/translation.lux
@@ -0,0 +1,10 @@
+(.module:
+  [lux #*]
+  [//
+   ["." bundle]
+   [//
+    [translation (#+ Bundle)]]])
+
+(def: #export bundle
+  Bundle
+  bundle.empty)
diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux
new file mode 100644
index 000000000..c7ff3719f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/statement.lux
@@ -0,0 +1,45 @@
+(.module:
+  [lux #*]
+  ["." //
+   ["." analysis]
+   ["." synthesis]
+   ["." translation]
+   ["." extension]])
+
+(type: #export (Component state phase)
+  {#state state
+   #phase phase})
+
+(type: #export (State anchor expression statement)
+  {#analysis (Component analysis.State+
+                        analysis.Phase)
+   #synthesis (Component synthesis.State+
+                         synthesis.Phase)
+   #translation (Component (translation.State+ anchor expression statement)
+                           (translation.Phase anchor expression statement))})
+
+(do-template [<special> <general>]
+  [(type: #export (<special> anchor expression statement)
+     (<general> (..State anchor expression statement) Code Any))]
+
+  [State+    extension.State]
+  [Operation extension.Operation]
+  [Phase     extension.Phase]
+  [Handler   extension.Handler]
+  [Bundle    extension.Bundle]
+  )
+
+(do-template [<name> <component> <operation>]
+  [(def: #export (<name> operation)
+     (All [anchor expression statement output]
+       (-> (<operation> output)
+           (Operation anchor expression statement output)))
+     (extension.lift
+      (//.sub [(get@ [<component> #..state])
+               (set@ [<component> #..state])]
+              operation)))]
+
+  [lift-analysis    #..analysis    analysis.Operation]
+  [lift-synthesis   #..synthesis   synthesis.Operation]
+  [lift-translation #..translation (translation.Operation anchor expression statement)]
+  )
diff --git a/stdlib/source/lux/tool/compiler/phase/statement/total.lux b/stdlib/source/lux/tool/compiler/phase/statement/total.lux
new file mode 100644
index 000000000..c494b01c6
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/statement/total.lux
@@ -0,0 +1,56 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    [text
+     format]]
+   ["." macro]]
+  ["." // (#+ Phase)
+   ["/." //
+    ["." analysis
+     ["." expression]
+     ["." type]
+     ["///." macro]]
+    ["." extension]]])
+
+(exception: #export (not-a-statement {code Code})
+  (ex.report ["Statement" (%code code)]))
+
+(exception: #export (not-a-macro {code Code})
+  (ex.report ["Code" (%code code)]))
+
+(exception: #export (macro-was-not-found {name Name})
+  (ex.report ["Name" (%name name)]))
+
+(def: #export (phase code)
+  Phase
+  (case code
+    (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
+    (extension.apply "Statement" phase [name inputs])
+
+    (^ [_ (#.Form (list& macro inputs))])
+    (do ///.monad
+      [expansion (//.lift-analysis
+                  (do @
+                    [macroA (type.with-type Macro
+                              (expression.compile macro))]
+                    (case macroA
+                      (^ (analysis.constant macro-name))
+                      (do @
+                        [?macro (extension.lift (macro.find-macro macro-name))
+                         macro (case ?macro
+                                 (#.Some macro)
+                                 (wrap macro)
+                                 
+                                 #.None
+                                 (///.throw macro-was-not-found macro-name))]
+                        (extension.lift (///macro.expand macro-name macro inputs)))
+                      
+                      _
+                      (///.throw not-a-macro code))))]
+      (monad.map @ phase expansion))
+
+    _
+    (///.throw not-a-statement code)))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux
new file mode 100644
index 000000000..4cc9c7336
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux
@@ -0,0 +1,468 @@
+(.module:
+  [lux (#- i64 Scope)
+   [control
+    [monad (#+ do)]
+    [equivalence (#+ Equivalence)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." bit ("#/." equivalence)]
+    ["." text ("#/." equivalence)
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]]
+  ["." //
+   ["." analysis (#+ Environment Arity Composite Analysis)]
+   ["." extension (#+ Extension)]
+   [//
+    ["." reference (#+ Register Variable Reference)]]])
+
+(type: #export Resolver (Dictionary Variable Variable))
+
+(type: #export State
+  {#locals Nat})
+
+(def: #export fresh-resolver
+  Resolver
+  (dictionary.new reference.hash))
+
+(def: #export init
+  State
+  {#locals 0})
+
+(type: #export Primitive
+  (#Bit Bit)
+  (#I64 (I64 Any))
+  (#F64 Frac)
+  (#Text Text))
+
+(type: #export Side
+  (Either Nat Nat))
+
+(type: #export Member
+  (Either Nat Nat))
+
+(type: #export Access
+  (#Side Side)
+  (#Member Member))
+
+(type: #export (Path' s)
+  #Pop
+  (#Test Primitive)
+  (#Access Access)
+  (#Bind Register)
+  (#Alt (Path' s) (Path' s))
+  (#Seq (Path' s) (Path' s))
+  (#Then s))
+
+(type: #export (Abstraction' s)
+  {#environment Environment
+   #arity Arity
+   #body s})
+
+(type: #export (Apply' s)
+  {#function s
+   #arguments (List s)})
+
+(type: #export (Branch s)
+  (#Let s Register s)
+  (#If s s s)
+  (#Case s (Path' s)))
+
+(type: #export (Scope s)
+  {#start Register
+   #inits (List s)
+   #iteration s})
+
+(type: #export (Loop s)
+  (#Scope (Scope s))
+  (#Recur (List s)))
+
+(type: #export (Function s)
+  (#Abstraction (Abstraction' s))
+  (#Apply s (List s)))
+
+(type: #export (Control s)
+  (#Branch (Branch s))
+  (#Loop (Loop s))
+  (#Function (Function s)))
+
+(type: #export #rec Synthesis
+  (#Primitive Primitive)
+  (#Structure (Composite Synthesis))
+  (#Reference Reference)
+  (#Control (Control Synthesis))
+  (#Extension (Extension Synthesis)))
+
+(do-template [<special> <general>]
+  [(type: #export <special>
+     (<general> ..State Analysis Synthesis))]
+
+  [State+    extension.State]
+  [Operation extension.Operation]
+  [Phase     extension.Phase]
+  [Handler   extension.Handler]
+  [Bundle    extension.Bundle]
+  )
+
+(type: #export Path
+  (Path' Synthesis))
+
+(def: #export path/pop
+  Path
+  #Pop)
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (#..Test (<tag> content)))]
+
+  [path/bit  #..Bit]
+  [path/i64  #..I64]
+  [path/f64  #..F64]
+  [path/text #..Text]
+  )
+
+(do-template [<name> <kind>]
+  [(template: #export (<name> content)
+     (.<| #..Access
+          <kind>
+          content))]
+
+  [path/side   #..Side]
+  [path/member #..Member]
+  )
+
+(do-template [<name> <kind> <side>]
+  [(template: #export (<name> content)
+     (.<| #..Access
+          <kind>
+          <side>
+          content))]
+
+  [side/left    #..Side   #.Left]
+  [side/right   #..Side   #.Right]
+  [member/left  #..Member #.Left]
+  [member/right #..Member #.Right]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<tag> content))]
+
+  [path/bind #..Bind]
+  [path/then #..Then]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> left right)
+     (<tag> [left right]))]
+
+  [path/alt  #..Alt]
+  [path/seq  #..Seq]
+  )
+
+(type: #export Abstraction
+  (Abstraction' Synthesis))
+
+(type: #export Apply
+  (Apply' Synthesis))
+
+(def: #export unit Text "")
+
+(do-template [<name> <type> <tag>]
+  [(def: #export (<name> value)
+     (-> <type> (All [a] (-> (Operation a) (Operation a))))
+     (extension.temporary (set@ <tag> value)))]
+
+  [with-locals      Nat      #locals]
+  )
+
+(def: #export (with-abstraction arity resolver)
+  (-> Arity Resolver
+      (All [a] (-> (Operation a) (Operation a))))
+  (extension.with-state {#locals arity}))
+
+(do-template [<name> <tag> <type>]
+  [(def: #export <name>
+     (Operation <type>)
+     (extension.read (get@ <tag>)))]
+
+  [locals      #locals      Nat]
+  )
+
+(def: #export with-new-local
+  (All [a] (-> (Operation a) (Operation a)))
+  (<<| (do //.monad
+         [locals ..locals])
+       (..with-locals (inc locals))))
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (#..Primitive (<tag> content)))]
+
+  [bit  #..Bit]
+  [i64  #..I64]
+  [f64  #..F64]
+  [text #..Text]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<| #..Structure
+         <tag>
+         content))]
+
+  [variant #analysis.Variant]
+  [tuple   #analysis.Tuple]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable/local   reference.local]
+  [variable/foreign reference.foreign]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Reference
+          <tag>
+          content))]
+
+  [variable reference.variable]
+  [constant reference.constant]
+  )
+
+(do-template [<name> <family> <tag>]
+  [(template: #export (<name> content)
+     (.<| #..Control
+          <family>
+          <tag>
+          content))]
+
+  [branch/case          #..Branch   #..Case]
+  [branch/let           #..Branch   #..Let]
+  [branch/if            #..Branch   #..If]
+
+  [loop/recur           #..Loop     #..Recur]
+  [loop/scope           #..Loop     #..Scope]
+
+  [function/abstraction #..Function #..Abstraction]
+  [function/apply       #..Function #..Apply]
+  )
+
+(def: #export (%path' %then value)
+  (All [a] (-> (Format a) (Format (Path' a))))
+  (case value
+    #Pop
+    "_"
+    
+    (#Test primitive)
+    (format "(? "
+            (case primitive
+              (#Bit value)
+              (%b value)
+              
+              (#I64 value)
+              (%i (.int value))
+              
+              (#F64 value)
+              (%f value)
+              
+              (#Text value)
+              (%t value))
+            ")")
+    
+    (#Access access)
+    (case access
+      (#Side side)
+      (case side
+        (#.Left lefts)
+        (format "(" (%n lefts) " #0" ")")
+        
+        (#.Right lefts)
+        (format "(" (%n lefts) " #1" ")"))
+      
+      (#Member member)
+      (case member
+        (#.Left lefts)
+        (format "[" (%n lefts) " #0" "]")
+        
+        (#.Right lefts)
+        (format "[" (%n lefts) " #1" "]")))
+    
+    (#Bind register)
+    (format "(@ " (%n register) ")")
+    
+    (#Alt left right)
+    (format "(| " (%path' %then left) " " (%path' %then right) ")")
+    
+    (#Seq left right)
+    (format "(& " (%path' %then left) " " (%path' %then right) ")")
+    
+    (#Then then)
+    (|> (%then then)
+        (text.enclose ["(! " ")"]))))
+
+(def: #export (%synthesis value)
+  (Format Synthesis)
+  (case value
+    (#Primitive primitive)
+    (case primitive
+      (^template [<pattern> <format>]
+        (<pattern> value)
+        (<format> value))
+      ([#Bit  %b]
+       [#F64  %f]
+       [#Text %t])
+      
+      (#I64 value)
+      (%i (.int value)))
+
+    (#Structure structure)
+    (case structure
+      (#analysis.Variant [lefts right? content])
+      (|> (%synthesis content)
+          (format (%n lefts) " " (%b right?) " ")
+          (text.enclose ["(" ")"]))
+      
+      (#analysis.Tuple members)
+      (|> members
+          (list/map %synthesis)
+          (text.join-with " ")
+          (text.enclose ["[" "]"])))
+
+    (#Reference reference)
+    (|> reference
+        reference.%reference
+        (text.enclose ["(#@ " ")"]))
+
+    (#Control control)
+    (case control
+      (#Function function)
+      (case function
+        (#Abstraction [environment arity body])
+        (|> (%synthesis body)
+            (format (%n arity) " ")
+            (format (|> environment
+                        (list/map reference.%variable)
+                        (text.join-with " ")
+                        (text.enclose ["[" "]"]))
+                    " ")
+            (text.enclose ["(" ")"]))
+        
+        (#Apply func args)
+        (|> (list/map %synthesis args)
+            (text.join-with " ")
+            (format (%synthesis func) " ")
+            (text.enclose ["(" ")"])))
+
+      (#Branch branch)
+      (case branch
+        (#Let input register body)
+        (|> (format (%synthesis input) " " (%n register) " " (%synthesis body))
+            (text.enclose ["(#let " ")"]))
+        
+        (#If test then else)
+        (|> (format (%synthesis test) " " (%synthesis then) " " (%synthesis else))
+            (text.enclose ["(#if " ")"]))
+        
+        (#Case input path)
+        (|> (format (%synthesis input) " " (%path' %synthesis path))
+            (text.enclose ["(#case " ")"])))
+      
+      ## (#Loop loop)
+      _
+      "???")
+
+    (#Extension [name args])
+    (|> (list/map %synthesis args)
+        (text.join-with " ")
+        (format (%t name))
+        (text.enclose ["(" ")"]))))
+
+(def: #export %path
+  (Format Path)
+  (%path' %synthesis))
+
+(structure: #export primitive-equivalence (Equivalence Primitive)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag> <eq> <format>]
+        [(<tag> reference') (<tag> sample')]
+        (<eq> reference' sample'))
+      ([#Bit  bit/=  %b]
+       [#F64  f/=    %f]
+       [#Text text/= %t])
+
+      [(#I64 reference') (#I64 sample')]
+      (i/= (.int reference') (.int sample'))
+
+      _
+      false)))
+
+(structure: #export access-equivalence (Equivalence Access)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag>]
+        [(<tag> reference') (<tag> sample')]
+        (case [reference' sample']
+          (^template [<side>]
+            [(<side> reference'') (<side> sample'')]
+            (n/= reference'' sample''))
+          ([#.Left]
+           [#.Right])
+          
+          _
+          false))
+      ([#Side]
+       [#Member])
+
+      _
+      false)))
+
+(structure: #export (path'-equivalence Equivalence<a>)
+  (All [a] (-> (Equivalence a) (Equivalence (Path' a))))
+
+  (def: (= reference sample)
+    (case [reference sample]
+      [#Pop #Pop]
+      true
+
+      (^template [<tag> <equivalence>]
+        [(<tag> reference') (<tag> sample')]
+        (:: <equivalence> = reference' sample'))
+      ([#Test   primitive-equivalence]
+       [#Access access-equivalence]
+       [#Then   Equivalence<a>])
+      
+      [(#Bind reference') (#Bind sample')]
+      (n/= reference' sample')
+
+      (^template [<tag>]
+        [(<tag> leftR rightR) (<tag> leftS rightS)]
+        (and (= leftR leftS)
+             (= rightR rightS)))
+      ([#Alt]
+       [#Seq])
+
+      _
+      false)))
+
+(structure: #export equivalence (Equivalence Synthesis)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag> <equivalence>]
+        [(<tag> reference') (<tag> sample')]
+        (:: <equivalence> = reference' sample'))
+      ([#Primitive primitive-equivalence])
+
+      _
+      false)))
+
+(def: #export path-equivalence
+  (Equivalence Path)
+  (path'-equivalence equivalence))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux
new file mode 100644
index 000000000..b1890688d
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/case.lux
@@ -0,0 +1,170 @@
+(.module:
+  [lux #*
+   [control
+    [equivalence (#+ Equivalence)]
+    pipe
+    ["." monad (#+ do)]]
+   [data
+    ["." product]
+    ["." bit ("#/." equivalence)]
+    ["." text ("#/." equivalence)
+     format]
+    [number
+     ["." frac ("#/." equivalence)]]
+    [collection
+     ["." list ("#/." fold monoid)]]]]
+  ["." // (#+ Path Synthesis Operation Phase)
+   ["." function]
+   ["/." // ("#/." monad)
+    ["." analysis (#+ Pattern Match Analysis)]
+    [//
+     ["." reference]]]])
+
+(def: clean-up
+  (-> Path Path)
+  (|>> (#//.Seq #//.Pop)))
+
+(def: (path' pattern end? thenC)
+  (-> Pattern Bit (Operation Path) (Operation Path))
+  (case pattern
+    (#analysis.Simple simple)
+    (case simple
+      #analysis.Unit
+      thenC
+      
+      (^template [<from> <to>]
+        (<from> value)
+        (///map (|>> (#//.Seq (#//.Test (|> value <to>))))
+                thenC))
+      ([#analysis.Bit  #//.Bit]
+       [#analysis.Nat  (<| #//.I64 .i64)]
+       [#analysis.Int  (<| #//.I64 .i64)]
+       [#analysis.Rev  (<| #//.I64 .i64)]
+       [#analysis.Frac #//.F64]
+       [#analysis.Text #//.Text]))
+    
+    (#analysis.Bind register)
+    (<| (:: ///.monad map (|>> (#//.Seq (#//.Bind register))))
+        //.with-new-local
+        thenC)
+
+    (#analysis.Complex (#analysis.Variant [lefts right? value-pattern]))
+    (<| (///map (|>> (#//.Seq (#//.Access (#//.Side (if right?
+                                                      (#.Right lefts)
+                                                      (#.Left lefts)))))))
+        (path' value-pattern end?)
+        (when (not end?) (///map ..clean-up))
+        thenC)
+
+    (#analysis.Complex (#analysis.Tuple tuple))
+    (let [tuple::last (dec (list.size tuple))]
+      (list/fold (function (_ [tuple::lefts tuple::member] nextC)
+                   (let [right? (n/= tuple::last tuple::lefts)
+                         end?' (and end? right?)]
+                     (<| (///map (|>> (#//.Seq (#//.Access (#//.Member (if right?
+                                                                         (#.Right (dec tuple::lefts))
+                                                                         (#.Left tuple::lefts)))))))
+                         (path' tuple::member end?')
+                         (when (not end?') (///map ..clean-up))
+                         nextC)))
+                 thenC
+                 (list.reverse (list.enumerate tuple))))))
+
+(def: #export (path synthesize pattern bodyA)
+  (-> Phase Pattern Analysis (Operation Path))
+  (path' pattern true (///map (|>> #//.Then) (synthesize bodyA))))
+
+(def: #export (weave leftP rightP)
+  (-> Path Path Path)
+  (with-expansions [<default> (as-is (#//.Alt leftP rightP))]
+    (case [leftP rightP]
+      [(#//.Seq preL postL)
+       (#//.Seq preR postR)]
+      (case (weave preL preR)
+        (#//.Alt _)
+        <default>
+
+        weavedP
+        (#//.Seq weavedP (weave postL postR)))
+
+      [#//.Pop #//.Pop]
+      rightP
+
+      (^template [<tag> <eq>]
+        [(#//.Test (<tag> leftV))
+         (#//.Test (<tag> rightV))]
+        (if (<eq> leftV rightV)
+          rightP
+          <default>))
+      ([#//.Bit bit/=]
+       [#//.I64 "lux i64 ="]
+       [#//.F64 frac/=]
+       [#//.Text text/=])
+
+      (^template [<access> <side>]
+        [(#//.Access (<access> (<side> leftL)))
+         (#//.Access (<access> (<side> rightL)))]
+        (if (n/= leftL rightL)
+          rightP
+          <default>))
+      ([#//.Side #.Left]
+       [#//.Side #.Right]
+       [#//.Member #.Left]
+       [#//.Member #.Right])
+
+      [(#//.Bind leftR) (#//.Bind rightR)]
+      (if (n/= leftR rightR)
+        rightP
+        <default>)
+
+      _
+      <default>)))
+
+(def: #export (synthesize synthesize^ inputA [headB tailB+])
+  (-> Phase Analysis Match (Operation Synthesis))
+  (do ///.monad
+    [inputS (synthesize^ inputA)]
+    (with-expansions [<unnecesary-let>
+                      (as-is (^multi (^ (#analysis.Reference (reference.local outputR)))
+                                     (n/= inputR outputR))
+                             (wrap inputS))
+
+                      <let>
+                      (as-is [[(#analysis.Bind inputR) headB/bodyA]
+                              #.Nil]
+                             (case headB/bodyA
+                               <unnecesary-let>
+
+                               _
+                               (do @
+                                 [headB/bodyS (//.with-new-local
+                                                (synthesize^ headB/bodyA))]
+                                 (wrap (//.branch/let [inputS inputR headB/bodyS])))))
+
+                      <if>
+                      (as-is (^or (^ [[(analysis.pattern/bit #1) thenA]
+                                      (list [(analysis.pattern/bit #0) elseA])])
+                                  (^ [[(analysis.pattern/bit #0) elseA]
+                                      (list [(analysis.pattern/bit #1) thenA])]))
+                             (do @
+                               [thenS (synthesize^ thenA)
+                                elseS (synthesize^ elseA)]
+                               (wrap (//.branch/if [inputS thenS elseS]))))
+
+                      <case>
+                      (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+]
+        <let>
+        <if>
+        <case>))))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux
new file mode 100644
index 000000000..ac6a82ab8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/expression.lux
@@ -0,0 +1,86 @@
+(.module:
+  [lux (#- primitive)
+   [control
+    ["." monad (#+ do)]
+    pipe]
+   [data
+    ["." maybe]
+    ["." error]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]]
+  ["." // (#+ Synthesis Phase)
+   ["." function]
+   ["." case]
+   ["/." // ("#/." monad)
+    ["." analysis (#+ Analysis)]
+    ["." extension]
+    [//
+     ["." reference]]]])
+
+(def: (primitive analysis)
+  (-> analysis.Primitive //.Primitive)
+  (case analysis
+    #analysis.Unit
+    (#//.Text //.unit)
+    
+    (^template [<analysis> <synthesis>]
+      (<analysis> value)
+      (<synthesis> value))
+    ([#analysis.Bit  #//.Bit]
+     [#analysis.Frac #//.F64]
+     [#analysis.Text #//.Text])
+
+    (^template [<analysis> <synthesis>]
+      (<analysis> value)
+      (<synthesis> (.i64 value)))
+    ([#analysis.Nat #//.I64]
+     [#analysis.Int #//.I64]
+     [#analysis.Rev #//.I64])))
+
+(def: #export (phase analysis)
+  Phase
+  (case analysis
+    (#analysis.Primitive analysis')
+    (///wrap (#//.Primitive (..primitive analysis')))
+
+    (#analysis.Structure structure)
+    (case structure
+      (#analysis.Variant variant)
+      (do ///.monad
+        [valueS (phase (get@ #analysis.value variant))]
+        (wrap (//.variant (set@ #analysis.value valueS variant))))
+
+      (#analysis.Tuple tuple)
+      (|> tuple
+          (monad.map ///.monad phase)
+          (:: ///.monad map (|>> //.tuple))))
+    
+    (#analysis.Reference reference)
+    (///wrap (#//.Reference reference))
+
+    (#analysis.Case inputA branchesAB+)
+    (case.synthesize phase inputA branchesAB+)
+
+    (^ (analysis.no-op value))
+    (phase value)
+
+    (#analysis.Apply _)
+    (function.apply phase analysis)
+
+    (#analysis.Function environmentA bodyA)
+    (function.abstraction phase environmentA bodyA)
+
+    (#analysis.Extension name args)
+    (function (_ state)
+      (|> (extension.apply "Synthesis" phase [name args])
+          (///.run' state)
+          (case> (#error.Success output)
+                 (#error.Success output)
+                 
+                 (#error.Failure error)
+                 (<| (///.run' state)
+                     (do ///.monad
+                       [argsS+ (monad.map @ phase args)]
+                       (wrap (#//.Extension [name argsS+])))))))
+    ))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux
new file mode 100644
index 000000000..ce9efe59b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux
@@ -0,0 +1,211 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." maybe]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor monoid fold)]
+     ["dict" dictionary (#+ Dictionary)]]]]
+  ["." // (#+ Path Synthesis Operation Phase)
+   ["." loop (#+ Transform)]
+   ["/." // ("#/." monad)
+    ["." analysis (#+ Environment Arity Analysis)]
+    [//
+     ["." reference (#+ Register Variable)]]]])
+
+(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment})
+  (ex.report ["Foreign" (%n foreign)]
+             ["Environment" (|> environment
+                                (list/map reference.%variable)
+                                (text.join-with " "))]))
+
+(def: arity-arguments
+  (-> Arity (List Synthesis))
+  (|>> dec
+       (list.n/range 1)
+       (list/map (|>> //.variable/local))))
+
+(template: #export (self-reference)
+  (//.variable/local 0))
+
+(def: (expanded-nested-self-reference arity)
+  (-> Arity Synthesis)
+  (//.function/apply [(..self-reference) (arity-arguments arity)]))
+
+(def: #export (apply phase)
+  (-> Phase Phase)
+  (function (_ exprA)
+    (let [[funcA argsA] (analysis.application exprA)]
+      (do ///.monad
+        [funcS (phase funcA)
+         argsS (monad.map @ phase argsA)
+         ## locals //.locals
+         ]
+        (with-expansions [<apply> (as-is (//.function/apply [funcS argsS]))]
+          (case funcS
+            ## (^ (//.function/abstraction functionS))
+            ## (wrap (|> functionS
+            ##           (loop.loop (get@ #//.environment functionS) locals argsS)
+            ##           (maybe.default <apply>)))
+
+            (^ (//.function/apply [funcS' argsS']))
+            (wrap (//.function/apply [funcS' (list/compose argsS' argsS)]))
+
+            _
+            (wrap <apply>)))))))
+
+(def: (find-foreign environment register)
+  (-> Environment Register (Operation Variable))
+  (case (list.nth register environment)
+    (#.Some aliased)
+    (///wrap aliased)
+
+    #.None
+    (///.throw cannot-find-foreign-variable-in-environment [register environment])))
+
+(def: (grow-path grow path)
+  (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path))
+  (case path
+    (#//.Bind register)
+    (///wrap (#//.Bind (inc register)))
+
+    (^template [<tag>]
+      (<tag> left right)
+      (do ///.monad
+        [left' (grow-path grow left)
+         right' (grow-path grow right)]
+        (wrap (<tag> left' right'))))
+    ([#//.Alt] [#//.Seq])
+    
+    (#//.Then thenS)
+    (|> thenS
+        grow
+        (///map (|>> #//.Then)))
+
+    _
+    (///wrap path)))
+
+(def: (grow-sub-environment super sub)
+  (-> Environment Environment (Operation Environment))
+  (monad.map ///.monad
+             (function (_ variable)
+               (case variable
+                 (#reference.Local register)
+                 (///wrap (#reference.Local (inc register)))
+                 
+                 (#reference.Foreign register)
+                 (find-foreign super register)))
+             sub))
+
+(def: (grow environment expression)
+  (-> Environment Synthesis (Operation Synthesis))
+  (case expression
+    (#//.Structure structure)
+    (case structure
+      (#analysis.Variant [lefts right? subS])
+      (|> subS
+          (grow environment)
+          (///map (|>> [lefts right?] //.variant)))
+      
+      (#analysis.Tuple membersS+)
+      (|> membersS+
+          (monad.map ///.monad (grow environment))
+          (///map (|>> //.tuple))))
+
+    (^ (..self-reference))
+    (///wrap (//.function/apply [expression (list (//.variable/local 1))]))
+    
+    (#//.Reference reference)
+    (case reference
+      (#reference.Variable variable)
+      (case variable
+        (#reference.Local register)
+        (///wrap (//.variable/local (inc register)))
+        
+        (#reference.Foreign register)
+        (|> register
+            (find-foreign environment)
+            (///map (|>> //.variable))))
+      
+      (#reference.Constant constant)
+      (///wrap expression))
+    
+    (#//.Control control)
+    (case control
+      (#//.Branch branch)
+      (case branch
+        (#//.Let [inputS register bodyS])
+        (do ///.monad
+          [inputS' (grow environment inputS)
+           bodyS' (grow environment bodyS)]
+          (wrap (//.branch/let [inputS' (inc register) bodyS'])))
+        
+        (#//.If [testS thenS elseS])
+        (do ///.monad
+          [testS' (grow environment testS)
+           thenS' (grow environment thenS)
+           elseS' (grow environment elseS)]
+          (wrap (//.branch/if [testS' thenS' elseS'])))
+        
+        (#//.Case [inputS pathS])
+        (do ///.monad
+          [inputS' (grow environment inputS)
+           pathS' (grow-path (grow environment) pathS)]
+          (wrap (//.branch/case [inputS' pathS']))))
+      
+      (#//.Loop loop)
+      (case loop
+        (#//.Scope [start initsS+ iterationS])
+        (do ///.monad
+          [initsS+' (monad.map @ (grow environment) initsS+)
+           iterationS' (grow environment iterationS)]
+          (wrap (//.loop/scope [start initsS+' iterationS'])))
+        
+        (#//.Recur argumentsS+)
+        (|> argumentsS+
+            (monad.map ///.monad (grow environment))
+            (///map (|>> //.loop/recur))))
+      
+      (#//.Function function)
+      (case function
+        (#//.Abstraction [_env _arity _body])
+        (do ///.monad
+          [_env' (grow-sub-environment environment _env)]
+          (wrap (//.function/abstraction [_env' _arity _body])))
+        
+        (#//.Apply funcS argsS+)
+        (case funcS
+          (^ (//.function/apply [(..self-reference) pre-argsS+]))
+          (///wrap (//.function/apply [(..self-reference)
+                                       (list/compose pre-argsS+ argsS+)]))
+          
+          _
+          (do ///.monad
+            [funcS' (grow environment funcS)
+             argsS+' (monad.map @ (grow environment) argsS+)]
+            (wrap (//.function/apply [funcS' argsS+']))))))
+    
+    (#//.Extension name argumentsS+)
+    (|> argumentsS+
+        (monad.map ///.monad (grow environment))
+        (///map (|>> (#//.Extension name))))
+
+    _
+    (///wrap expression)))
+
+(def: #export (abstraction phase environment bodyA)
+  (-> Phase Environment Analysis (Operation Synthesis))
+  (do ///.monad
+    [bodyS (phase bodyA)]
+    (case bodyS
+      (^ (//.function/abstraction [env' down-arity' bodyS']))
+      (|> bodyS'
+          (grow env')
+          (:: @ map (|>> [environment (inc down-arity')] //.function/abstraction)))
+      
+      _
+      (wrap (//.function/abstraction [environment 1 bodyS])))))
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux
new file mode 100644
index 000000000..28517bd42
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux
@@ -0,0 +1,291 @@
+(.module:
+  [lux (#- loop)
+   [control
+    ["." monad (#+ do)]
+    ["p" parser]]
+   [data
+    ["." maybe ("#/." monad)]
+    [collection
+     ["." list ("#/." functor)]]]
+   [macro
+    ["." code]
+    ["." syntax]]]
+  ["." // (#+ Path Abstraction Synthesis)
+   [//
+    ["." analysis (#+ Environment)]
+    ["." extension]
+    [//
+     ["." reference (#+ Register Variable)]]]])
+
+(type: #export (Transform a)
+  (-> a (Maybe a)))
+
+(def: (some? maybe)
+  (All [a] (-> (Maybe a) Bit))
+  (case maybe
+    (#.Some _) #1
+    #.None     #0))
+
+(template: #export (self)
+  (#//.Reference (reference.local 0)))
+
+(template: (recursive-apply args)
+  (#//.Apply (self) args))
+
+(def: improper #0)
+(def: proper #1)
+
+(def: (proper? exprS)
+  (-> Synthesis Bit)
+  (case exprS
+    (^ (self))
+    improper
+
+    (#//.Structure structure)
+    (case structure
+      (#analysis.Variant variantS)
+      (proper? (get@ #analysis.value variantS))
+      
+      (#analysis.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 [<tag>]
+        (<tag> leftS rightS)
+        (do maybe.monad
+          [leftS' (recur leftS)
+           rightS' (recur rightS)]
+          (wrap (<tag> 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
+        (#analysis.Variant variantS)
+        (do maybe.monad
+          [valueS' (|> variantS (get@ #analysis.value) recur)]
+          (wrap (|> variantS
+                    (set@ #analysis.value valueS')
+                    #analysis.Variant
+                    #//.Structure)))
+        
+        (#analysis.Tuple membersS+)
+        (|> membersS+
+            (monad.map maybe.monad recur)
+            (maybe/map (|>> #analysis.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/tool/compiler/phase/translation.lux b/stdlib/source/lux/tool/compiler/phase/translation.lux
new file mode 100644
index 000000000..d8522adcd
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation.lux
@@ -0,0 +1,250 @@
+(.module:
+  [lux #*
+   [control
+    ["ex" exception (#+ exception:)]
+    [monad (#+ do)]]
+   [data
+    ["." product]
+    ["." error (#+ Error)]
+    ["." name ("#/." equivalence)]
+    ["." text
+     format]
+    [collection
+     ["." row (#+ Row)]
+     ["." dictionary (#+ Dictionary)]]]
+   [world
+    [file (#+ File)]]]
+  ["." //
+   ["." extension]]
+  [//synthesis (#+ Synthesis)])
+
+(do-template [<name>]
+  [(exception: #export (<name>)
+     "")]
+
+  [no-active-buffer]
+  [no-anchor]
+  )
+
+(exception: #export (cannot-interpret {error Text})
+  (ex.report ["Error" error]))
+
+(exception: #export (unknown-lux-name {name Name})
+  (ex.report ["Name" (%name name)]))
+
+(exception: #export (cannot-overwrite-lux-name {lux-name Name}
+                                               {old-host-name Text}
+                                               {new-host-name Text})
+  (ex.report ["Lux Name" (%name lux-name)]
+             ["Old Host Name" old-host-name]
+             ["New Host Name" new-host-name]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {name Name})
+     (ex.report ["Output" (%name name)]))]
+
+  [cannot-overwrite-output]
+  [no-buffer-for-saving-code]
+  )
+
+(type: #export Context
+  {#scope-name Text
+   #inner-functions Nat})
+
+(signature: #export (Host expression statement)
+  (: (-> Text expression (Error Any))
+     evaluate!)
+  (: (-> Text statement (Error Any))
+     execute!)
+  (: (-> Name expression (Error [Text Any]))
+     define!))
+
+(type: #export (Buffer statement) (Row [Name statement]))
+
+(type: #export (Outputs statement) (Dictionary File (Buffer statement)))
+
+(type: #export (State anchor expression statement)
+  {#context Context
+   #anchor (Maybe anchor)
+   #host (Host expression statement)
+   #buffer (Maybe (Buffer statement))
+   #outputs (Outputs statement)
+   #counter Nat
+   #name-cache (Dictionary Name Text)})
+
+(do-template [<special> <general>]
+  [(type: #export (<special> anchor expression statement)
+     (<general> (State anchor expression statement) Synthesis expression))]
+
+  [State+    extension.State]
+  [Operation extension.Operation]
+  [Phase     extension.Phase]
+  [Handler   extension.Handler]
+  [Bundle    extension.Bundle]
+  )
+
+(def: #export (state host)
+  (All [anchor expression statement]
+    (-> (Host expression statement)
+        (..State anchor expression statement)))
+  {#context {#scope-name ""
+             #inner-functions 0}
+   #anchor #.None
+   #host host
+   #buffer #.None
+   #outputs (dictionary.new text.hash)
+   #counter 0
+   #name-cache (dictionary.new name.hash)})
+
+(def: #export (with-context expr)
+  (All [anchor expression statement output]
+    (-> (Operation anchor expression statement output)
+        (Operation anchor expression statement [Text output])))
+  (function (_ [bundle state])
+    (let [[old-scope old-inner] (get@ #context state)
+          new-scope (format old-scope "c" (%n old-inner))]
+      (case (expr [bundle (set@ #context [new-scope 0] state)])
+        (#error.Success [[bundle' state'] output])
+        (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')]
+                         [new-scope output]])
+
+        (#error.Failure error)
+        (#error.Failure error)))))
+
+(def: #export context
+  (All [anchor expression statement]
+    (Operation anchor expression statement Text))
+  (extension.read (|>> (get@ #context)
+                       (get@ #scope-name))))
+
+(do-template [<tag>
+              <with-declaration> <with-type> <with-value>
+              <get> <get-type> <exception>]
+  [(def: #export <with-declaration>
+     (All [anchor expression statement output] <with-type>)
+     (function (_ body)
+       (function (_ [bundle state])
+         (case (body [bundle (set@ <tag> (#.Some <with-value>) state)])
+           (#error.Success [[bundle' state'] output])
+           (#error.Success [[bundle' (set@ <tag> (get@ <tag> state) state')]
+                            output])
+
+           (#error.Failure error)
+           (#error.Failure error)))))
+
+   (def: #export <get>
+     (All [anchor expression statement]
+       (Operation anchor expression statement <get-type>))
+     (function (_ (^@ stateE [bundle state]))
+       (case (get@ <tag> state)
+         (#.Some output)
+         (#error.Success [stateE output])
+
+         #.None
+         (ex.throw <exception> []))))]
+
+  [#anchor
+   (with-anchor anchor)
+   (-> anchor (Operation anchor expression statement output)
+       (Operation anchor expression statement output))
+   anchor
+   anchor anchor no-anchor]
+
+  [#buffer
+   with-buffer
+   (-> (Operation anchor expression statement output)
+       (Operation anchor expression statement output))
+   row.empty
+   buffer (Buffer statement) no-active-buffer]
+  )
+
+(def: #export outputs
+  (All [anchor expression statement]
+    (Operation anchor expression statement (Outputs statement)))
+  (extension.read (get@ #outputs)))
+
+(def: #export next
+  (All [anchor expression statement]
+    (Operation anchor expression statement Nat))
+  (do //.monad
+    [count (extension.read (get@ #counter))
+     _ (extension.update (update@ #counter inc))]
+    (wrap count)))
+
+(do-template [<name> <inputT>]
+  [(def: #export (<name> label code)
+     (All [anchor expression statement]
+       (-> Text <inputT> (Operation anchor expression statement Any)))
+     (function (_ (^@ state+ [bundle state]))
+       (case (:: (get@ #host state) <name> label code)
+         (#error.Success output)
+         (#error.Success [state+ output])
+
+         (#error.Failure error)
+         (ex.throw cannot-interpret error))))]
+
+  [evaluate! expression]
+  [execute!  statement]
+  )
+
+(def: #export (define! name code)
+  (All [anchor expression statement]
+    (-> Name expression (Operation anchor expression statement [Text Any])))
+  (function (_ (^@ stateE [bundle state]))
+    (case (:: (get@ #host state) define! name code)
+      (#error.Success output)
+      (#error.Success [stateE output])
+
+      (#error.Failure error)
+      (ex.throw cannot-interpret error))))
+
+(def: #export (save! name code)
+  (All [anchor expression statement]
+    (-> Name statement (Operation anchor expression statement Any)))
+  (do //.monad
+    [count ..next
+     _ (execute! (format "save" (%n count)) code)
+     ?buffer (extension.read (get@ #buffer))]
+    (case ?buffer
+      (#.Some buffer)
+      (if (row.any? (|>> product.left (name/= name)) buffer)
+        (//.throw cannot-overwrite-output name)
+        (extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
+      
+      #.None
+      (//.throw no-buffer-for-saving-code name))))
+
+(def: #export (save-buffer! target)
+  (All [anchor expression statement]
+    (-> File (Operation anchor expression statement Any)))
+  (do //.monad
+    [buffer ..buffer]
+    (extension.update (update@ #outputs (dictionary.put target buffer)))))
+
+(def: #export (remember lux-name)
+  (All [anchor expression statement]
+    (-> Name (Operation anchor expression statement Text)))
+  (function (_ (^@ stateE [_ state]))
+    (let [cache (get@ #name-cache state)]
+      (case (dictionary.get lux-name cache)
+        (#.Some host-name)
+        (#error.Success [stateE host-name])
+        
+        #.None
+        (ex.throw unknown-lux-name lux-name)))))
+
+(def: #export (learn lux-name host-name)
+  (All [anchor expression statement]
+    (-> Name Text (Operation anchor expression statement Any)))
+  (function (_ [bundle state])
+    (let [cache (get@ #name-cache state)]
+      (case (dictionary.get lux-name cache)
+        #.None
+        (#error.Success [[bundle
+                          (update@ #name-cache
+                                   (dictionary.put lux-name host-name)
+                                   state)]
+                         []])
+
+        (#.Some old-host-name)
+        (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
new file mode 100644
index 000000000..92b55cb80
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/case.jvm.lux
@@ -0,0 +1,177 @@
+(.module:
+  [lux (#- case let if)
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." number]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor fold)]
+     [set (#+ Set)]]]]
+  [//
+   ["." runtime (#+ Operation Phase)]
+   ["." reference]
+   ["/." /// ("#/." monad)
+    ["." synthesis (#+ Synthesis Path)]
+    [//
+     [reference (#+ Register)]
+     [//
+      [host
+       ["_" scheme (#+ Expression Computation Var)]]]]]])
+
+(def: #export (let translate [valueS register bodyS])
+  (-> Phase [Synthesis Register Synthesis]
+      (Operation Computation))
+  (do ////.monad
+    [valueO (translate valueS)
+     bodyO (translate bodyS)]
+    (wrap (_.let (list [(reference.local' register) valueO])
+            bodyO))))
+
+(def: #export (record-get translate valueS pathP)
+  (-> Phase Synthesis (List [Nat Bit])
+      (Operation Expression))
+  (do ////.monad
+    [valueO (translate valueS)]
+    (wrap (list/fold (function (_ [idx tail?] source)
+                       (.let [method (.if tail?
+                                       runtime.product//right
+                                       runtime.product//left)]
+                         (method source (_.int (:coerce Int idx)))))
+                     valueO
+                     pathP))))
+
+(def: #export (if translate [testS thenS elseS])
+  (-> Phase [Synthesis Synthesis Synthesis]
+      (Operation Computation))
+  (do ////.monad
+    [testO (translate testS)
+     thenO (translate thenS)
+     elseO (translate elseS)]
+    (wrap (_.if testO thenO elseO))))
+
+(def: @savepoint (_.var "lux_pm_cursor_savepoint"))
+
+(def: @cursor (_.var "lux_pm_cursor"))
+
+(def: top _.length/1)
+
+(def: (push! value var)
+  (-> Expression Var Computation)
+  (_.set! var (_.cons/2 value var)))
+
+(def: (pop! var)
+  (-> Var Computation)
+  (_.set! var var))
+
+(def: (push-cursor! value)
+  (-> Expression Computation)
+  (push! value @cursor))
+
+(def: save-cursor!
+  Computation
+  (push! @cursor @savepoint))
+
+(def: restore-cursor!
+  Computation
+  (_.set! @cursor (_.car/1 @savepoint)))
+
+(def: cursor-top
+  Computation
+  (_.car/1 @cursor))
+
+(def: pop-cursor!
+  Computation
+  (pop! @cursor))
+
+(def: pm-error (_.string "PM-ERROR"))
+
+(def: fail-pm! (_.raise/1 pm-error))
+
+(def: @temp (_.var "lux_pm_temp"))
+
+(exception: #export (unrecognized-path)
+  "")
+
+(def: $alt_error (_.var "alt_error"))
+
+(def: (pm-catch handler)
+  (-> Expression Computation)
+  (_.lambda [(list $alt_error) #.None]
+       (_.if (|> $alt_error (_.eqv?/2 pm-error))
+         handler
+         (_.raise/1 $alt_error))))
+
+(def: (pattern-matching' translate pathP)
+  (-> Phase Path (Operation Expression))
+  (.case pathP
+    (^ (synthesis.path/then bodyS))
+    (translate bodyS)
+
+    #synthesis.Pop
+    (/////wrap pop-cursor!)
+
+    (#synthesis.Bind register)
+    (/////wrap (_.define (reference.local' register) [(list) #.None]
+                         cursor-top))
+
+    (^template [<tag> <format> <=>]
+      (^ (<tag> value))
+      (/////wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
+                         fail-pm!)))
+    ([synthesis.path/bit  _.bool          _.eqv?/2]
+     [synthesis.path/i64  (<| _.int .int) _.=/2]
+     [synthesis.path/f64  _.float         _.=/2]
+     [synthesis.path/text _.string        _.eqv?/2])
+
+    (^template [<pm> <flag> <prep>]
+      (^ (<pm> idx))
+      (/////wrap (_.let (list [@temp (|> idx <prep> .int _.int (runtime.sum//get cursor-top <flag>))])
+                   (_.if (_.null?/1 @temp)
+                     fail-pm!
+                     (push-cursor! @temp)))))
+    ([synthesis.side/left  _.nil         (<|)]
+     [synthesis.side/right (_.string "") inc])
+
+    (^template [<pm> <getter> <prep>]
+      (^ (<pm> idx))
+      (/////wrap (|> idx <prep> .int _.int (<getter> cursor-top) push-cursor!)))
+    ([synthesis.member/left  runtime.product//left  (<|)]
+     [synthesis.member/right runtime.product//right inc])
+
+    (^template [<tag> <computation>]
+      (^ (<tag> leftP rightP))
+      (do ////.monad
+        [leftO (pattern-matching' translate leftP)
+         rightO (pattern-matching' translate rightP)]
+        (wrap <computation>)))
+    ([synthesis.path/seq (_.begin (list leftO
+                                        rightO))]
+     [synthesis.path/alt (_.with-exception-handler
+                           (pm-catch (_.begin (list restore-cursor!
+                                                    rightO)))
+                           (_.lambda [(list) #.None]
+                                (_.begin (list save-cursor!
+                                               leftO))))])
+    
+    _
+    (////.throw unrecognized-path [])))
+
+(def: (pattern-matching translate pathP)
+  (-> Phase Path (Operation Computation))
+  (do ////.monad
+    [pattern-matching! (pattern-matching' translate pathP)]
+    (wrap (_.with-exception-handler
+            (pm-catch (_.raise/1 (_.string "Invalid expression for pattern-matching.")))
+            (_.lambda [(list) #.None]
+                 pattern-matching!)))))
+
+(def: #export (case translate [valueS pathP])
+  (-> Phase [Synthesis Path] (Operation Computation))
+  (do ////.monad
+    [valueO (translate valueS)]
+    (<| (:: @ map (_.let (list [@cursor (_.list/* (list valueO))]
+                               [@savepoint (_.list/* (list))])))
+        (pattern-matching translate pathP))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/expression.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/expression.jvm.lux
new file mode 100644
index 000000000..53d7bbbcb
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/expression.jvm.lux
@@ -0,0 +1,59 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]]]
+  [//
+   [runtime (#+ Phase)]
+   ["." primitive]
+   ["." structure]
+   ["." reference]
+   ["." function]
+   ["." case]
+   ["." loop]
+   ["." ///
+    ["." synthesis]
+    ["." extension]]])
+
+(def: #export (translate synthesis)
+  Phase
+  (case synthesis
+    (^template [<tag> <generator>]
+      (^ (<tag> value))
+      (<generator> value))
+    ([synthesis.bit  primitive.bit]
+     [synthesis.i64  primitive.i64]
+     [synthesis.f64  primitive.f64]
+     [synthesis.text primitive.text])
+
+    (^ (synthesis.variant variantS))
+    (structure.variant translate variantS)
+
+    (^ (synthesis.tuple members))
+    (structure.tuple translate members)
+
+    (#synthesis.Reference reference)
+    (reference.reference reference)
+
+    (^ (synthesis.branch/case case))
+    (case.case translate case)
+
+    (^ (synthesis.branch/let let))
+    (case.let translate let)
+
+    (^ (synthesis.branch/if if))
+    (case.if translate if)
+
+    (^ (synthesis.loop/scope scope))
+    (loop.scope translate scope)
+
+    (^ (synthesis.loop/recur updates))
+    (loop.recur translate updates)
+
+    (^ (synthesis.function/abstraction abstraction))
+    (function.function translate abstraction)
+
+    (^ (synthesis.function/apply application))
+    (function.apply translate application)
+
+    (#synthesis.Extension extension)
+    (extension.apply translate extension)))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension.jvm.lux
new file mode 100644
index 000000000..a40b4953f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension.jvm.lux
@@ -0,0 +1,15 @@
+(.module:
+  [lux #*
+   [data
+    [collection
+     ["." dictionary]]]]
+  [//
+   [runtime (#+ Bundle)]]
+  [/
+   ["." common]
+   ["." host]])
+
+(def: #export bundle
+  Bundle
+  (|> common.bundle
+      (dictionary.merge host.bundle)))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/common.jvm.lux
new file mode 100644
index 000000000..1c55abf83
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/common.jvm.lux
@@ -0,0 +1,245 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["e" error]
+    ["." product]
+    ["." text
+     format]
+    [number (#+ hex)]
+    [collection
+     ["." list ("#/." functor)]
+     ["dict" dictionary (#+ Dictionary)]]]
+   ["." macro (#+ with-gensyms)
+    ["." code]
+    ["s" syntax (#+ syntax:)]]
+   [host (#+ import:)]]
+  [///
+   ["." runtime (#+ Operation Phase Handler Bundle)]
+   ["//." ///
+    ["." synthesis (#+ Synthesis)]
+    ["." extension
+     ["." bundle]]
+    [///
+     [host
+      ["_" scheme (#+ Expression Computation)]]]]])
+
+(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))
+
+(syntax: (arity: {name s.local-identifier} {arity s.nat})
+  (with-gensyms [g!_ g!extension g!name g!phase g!inputs]
+    (do @
+      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+      (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension))
+                       (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation)
+                           Handler)
+                       (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs))
+                         (case (~ g!inputs)
+                           (^ (list (~+ g!input+)))
+                           (do /////.monad
+                             [(~+ (|> g!input+
+                                      (list/map (function (_ g!input)
+                                                  (list g!input (` ((~ g!phase) (~ g!input))))))
+                                      list.concat))]
+                             ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
+
+                           (~' _)
+                           (/////.throw extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))
+
+(arity: nullary 0)
+(arity: unary 1)
+(arity: binary 2)
+(arity: trinary 3)
+
+(def: #export (variadic extension)
+  (-> Variadic Handler)
+  (function (_ extension-name)
+    (function (_ phase inputsS)
+      (do /////.monad
+        [inputsI (monad.map @ phase inputsS)]
+        (wrap (extension inputsI))))))
+
+(def: bundle::lux
+  Bundle
+  (|> bundle.empty
+      (bundle.install "is?" (binary (product.uncurry _.eq?/2)))
+      (bundle.install "try" (unary runtime.lux//try))))
+
+(do-template [<name> <op>]
+  [(def: (<name> [subjectO paramO])
+     Binary
+     (<op> paramO subjectO))]
+  
+  [bit::and _.bit-and/2]
+  [bit::or  _.bit-or/2]
+  [bit::xor _.bit-xor/2]
+  )
+
+(def: (bit::left-shift [subjectO paramO])
+  Binary
+  (_.arithmetic-shift/2 (_.remainder/2 (_.int +64) paramO)
+                        subjectO))
+
+(def: (bit::arithmetic-right-shift [subjectO paramO])
+  Binary
+  (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int +64)) (_.*/2 (_.int -1)))
+                        subjectO))
+
+(def: (bit::logical-right-shift [subjectO paramO])
+  Binary
+  (runtime.bit//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO))
+
+(def: bundle::bit
+  Bundle
+  (<| (bundle.prefix "bit")
+      (|> bundle.empty
+          (bundle.install "and" (binary bit::and))
+          (bundle.install "or" (binary bit::or))
+          (bundle.install "xor" (binary bit::xor))
+          (bundle.install "left-shift" (binary bit::left-shift))
+          (bundle.install "logical-right-shift" (binary bit::logical-right-shift))
+          (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
+          )))
+
+(import: java/lang/Double
+  (#static MIN_VALUE Double)
+  (#static MAX_VALUE Double))
+
+(do-template [<name> <const> <encode>]
+  [(def: (<name> _)
+     Nullary
+     (<encode> <const>))]
+
+  [frac::smallest (Double::MIN_VALUE)            _.float]
+  [frac::min      (f/* -1.0 (Double::MAX_VALUE)) _.float]
+  [frac::max      (Double::MAX_VALUE)            _.float]
+  )
+
+(do-template [<name> <op>]
+  [(def: (<name> [subjectO paramO])
+     Binary
+     (|> subjectO (<op> paramO)))]
+
+  [int::+ _.+/2]
+  [int::- _.-/2]
+  [int::* _.*/2]
+  [int::/ _.quotient/2]
+  [int::% _.remainder/2]
+  )
+
+(do-template [<name> <op>]
+  [(def: (<name> [subjectO paramO])
+     Binary
+     (<op> paramO subjectO))]
+
+  [frac::+ _.+/2]
+  [frac::- _.-/2]
+  [frac::* _.*/2]
+  [frac::/ _.//2]
+  [frac::% _.mod/2]
+  [frac::= _.=/2]
+  [frac::< _.</2]
+
+  [text::= _.string=?/2]
+  [text::< _.string<?/2]
+  )
+
+(do-template [<name> <cmp>]
+  [(def: (<name> [subjectO paramO])
+     Binary
+     (<cmp> paramO subjectO))]
+
+  [int::= _.=/2]
+  [int::< _.</2]
+  )
+
+(def: int::char (|>> _.integer->char/1 _.string/1))
+
+(def: bundle::int
+  Bundle
+  (<| (bundle.prefix "int")
+      (|> bundle.empty
+          (bundle.install "+" (binary int::+))
+          (bundle.install "-" (binary int::-))
+          (bundle.install "*" (binary int::*))
+          (bundle.install "/" (binary int::/))
+          (bundle.install "%" (binary int::%))
+          (bundle.install "=" (binary int::=))
+          (bundle.install "<" (binary int::<))
+          (bundle.install "to-frac" (unary (|>> (_.//2 (_.float +1.0)))))
+          (bundle.install "char" (unary int::char)))))
+
+(def: bundle::frac
+  Bundle
+  (<| (bundle.prefix "frac")
+      (|> bundle.empty
+          (bundle.install "+" (binary frac::+))
+          (bundle.install "-" (binary frac::-))
+          (bundle.install "*" (binary frac::*))
+          (bundle.install "/" (binary frac::/))
+          (bundle.install "%" (binary frac::%))
+          (bundle.install "=" (binary frac::=))
+          (bundle.install "<" (binary frac::<))
+          (bundle.install "smallest" (nullary frac::smallest))
+          (bundle.install "min" (nullary frac::min))
+          (bundle.install "max" (nullary frac::max))
+          (bundle.install "to-int" (unary _.exact/1))
+          (bundle.install "encode" (unary _.number->string/1))
+          (bundle.install "decode" (unary runtime.frac//decode)))))
+
+(def: (text::char [subjectO paramO])
+  Binary
+  (_.string/1 (_.string-ref/2 subjectO paramO)))
+
+(def: (text::clip [subjectO startO endO])
+  Trinary
+  (_.substring/3 subjectO startO endO))
+
+(def: bundle::text
+  Bundle
+  (<| (bundle.prefix "text")
+      (|> bundle.empty
+          (bundle.install "=" (binary text::=))
+          (bundle.install "<" (binary text::<))
+          (bundle.install "concat" (binary (product.uncurry _.string-append/2)))
+          (bundle.install "size" (unary _.string-length/1))
+          (bundle.install "char" (binary text::char))
+          (bundle.install "clip" (trinary text::clip)))))
+
+(def: (io::log input)
+  Unary
+  (_.begin (list (_.display/1 input)
+                 _.newline/0)))
+
+(def: (void code)
+  (-> Expression Computation)
+  (_.begin (list code (_.string synthesis.unit))))
+
+(def: bundle::io
+  Bundle
+  (<| (bundle.prefix "io")
+      (|> bundle.empty
+          (bundle.install "log" (unary (|>> io::log ..void)))
+          (bundle.install "error" (unary _.raise/1))
+          (bundle.install "exit" (unary _.exit/1))
+          (bundle.install "current-time" (nullary (function (_ _) (runtime.io//current-time (_.string synthesis.unit))))))))
+
+(def: #export bundle
+  Bundle
+  (<| (bundle.prefix "lux")
+      (|> bundle::lux
+          (dict.merge bundle::bit)
+          (dict.merge bundle::int)
+          (dict.merge bundle::frac)
+          (dict.merge bundle::text)
+          (dict.merge bundle::io)
+          )))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/host.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/host.jvm.lux
new file mode 100644
index 000000000..b8b2b7612
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/extension/host.jvm.lux
@@ -0,0 +1,11 @@
+(.module:
+  [lux #*]
+  [///
+   [runtime (#+ Bundle)]
+   [///
+    [extension
+     ["." bundle]]]])
+
+(def: #export bundle
+  Bundle
+  bundle.empty)
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux
new file mode 100644
index 000000000..fe08b6a50
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux
@@ -0,0 +1,92 @@
+(.module:
+  [lux (#- function)
+   [control
+    ["." monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    [text
+     format]
+    [collection
+     ["." list ("#/." functor)]]]]
+  [//
+   ["." runtime (#+ Operation Phase)]
+   ["." reference]
+   ["/." //
+    ["//." // ("#/." monad)
+     [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+     [synthesis (#+ Synthesis)]
+     [//
+      [reference (#+ Register Variable)]
+      ["." name]
+      [//
+       [host
+        ["_" scheme (#+ Expression Computation Var)]]]]]]])
+
+(def: #export (apply translate [functionS argsS+])
+  (-> Phase (Application Synthesis) (Operation Computation))
+  (do ////.monad
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply/* functionO argsO+))))
+
+(def: (with-closure function-name inits function-definition)
+  (-> Text (List Expression) Computation (Operation Computation))
+  (let [@closure (_.var (format function-name "___CLOSURE"))]
+    (/////wrap
+     (case inits
+       #.Nil
+       function-definition
+
+       _
+       (_.letrec (list [@closure
+                        (_.lambda [(|> (list.enumerate inits)
+                                  (list/map (|>> product.left reference.foreign')))
+                              #.None]
+                             function-definition)])
+                 (_.apply/* @closure inits))))))
+
+(def: @curried (_.var "curried"))
+(def: @missing (_.var "missing"))
+
+(def: input
+  (|>> inc reference.local'))
+
+(def: #export (function translate [environment arity bodyS])
+  (-> Phase (Abstraction Synthesis) (Operation Computation))
+  (do ////.monad
+    [[function-name bodyO] (///.with-context
+                             (do @
+                               [function-name ///.context]
+                               (///.with-anchor (_.var function-name)
+                                 (translate bodyS))))
+     closureO+ (monad.map @ reference.variable environment)
+     #let [arityO (|> arity .int _.int)
+           @num-args (_.var "num_args")
+           @function (_.var function-name)
+           apply-poly (.function (_ args func)
+                        (_.apply/2 (_.global "apply") func args))]]
+    (with-closure function-name closureO+
+      (_.letrec (list [@function (_.lambda [(list) (#.Some @curried)]
+                                      (_.let (list [@num-args (_.length/1 @curried)])
+                                        (<| (_.if (|> @num-args (_.=/2 arityO))
+                                              (<| (_.let (list [(reference.local' 0) @function]))
+                                                  (_.let-values (list [[(|> (list.indices 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 (_.</2 arityO))
+                                            (_.lambda [(list) (#.Some @missing)]
+                                                 (|> @function
+                                                     (apply-poly (_.append/2 @curried @missing)))))))])
+                @function))
+    ))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
new file mode 100644
index 000000000..0d85654c1
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/loop.jvm.lux
@@ -0,0 +1,41 @@
+(.module:
+  [lux (#- Scope)
+   [control
+    ["." monad (#+ do)]]
+   [data
+    ["." product]
+    ["." text
+     format]
+    [collection
+     ["." list ("#/." functor)]]]]
+  [//
+   [runtime (#+ Operation Phase)]
+   ["." reference]
+   ["/." //
+    ["//." //
+     [synthesis (#+ Scope Synthesis)]
+     [///
+      [host
+       ["_" scheme (#+ Computation Var)]]]]]])
+
+(def: @scope (_.var "scope"))
+
+(def: #export (scope translate [start initsS+ bodyS])
+  (-> Phase (Scope Synthesis) (Operation Computation))
+  (do ////.monad
+    [initsO+ (monad.map @ translate initsS+)
+     bodyO (///.with-anchor @scope
+             (translate bodyS))]
+    (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+
+                                            list.enumerate
+                                            (list/map (|>> product.left (n/+ start) reference.local')))
+                                        #.None]
+                                       bodyO)])
+                    (_.apply/* @scope initsO+)))))
+
+(def: #export (recur translate argsS+)
+  (-> Phase (List Synthesis) (Operation Computation))
+  (do ////.monad
+    [@scope ///.anchor
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply/* @scope argsO+))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux
new file mode 100644
index 000000000..dc643bcbc
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/primitive.jvm.lux
@@ -0,0 +1,25 @@
+(.module:
+  [lux (#- i64)]
+  [//
+   [runtime (#+ Operation)]
+   [// (#+ State)
+    ["//." // ("#/." monad)
+     [///
+      [host
+       ["_" scheme (#+ Expression)]]]]]])
+
+(def: #export bit
+  (-> Bit (Operation Expression))
+  (|>> _.bool /////wrap))
+
+(def: #export i64
+  (-> (I64 Any) (Operation Expression))
+  (|>> .int _.int /////wrap))
+
+(def: #export f64
+  (-> Frac (Operation Expression))
+  (|>> _.float /////wrap))
+
+(def: #export text
+  (-> Text (Operation Expression))
+  (|>> _.string /////wrap))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux
new file mode 100644
index 000000000..161d2adea
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/reference.jvm.lux
@@ -0,0 +1,48 @@
+(.module:
+  [lux #*
+   [control
+    pipe]
+   [data
+    [text
+     format]]]
+  [//
+   [runtime (#+ Operation)]
+   ["/." //
+    ["//." // ("#/." monad)
+     [analysis (#+ Variant Tuple)]
+     [synthesis (#+ Synthesis)]
+     [//
+      ["." reference (#+ Register Variable Reference)]
+      [//
+       [host
+        ["_" scheme (#+ Expression Global Var)]]]]]]])
+
+(do-template [<name> <prefix>]
+  [(def: #export <name>
+     (-> Register Var)
+     (|>> .int %i (format <prefix>) _.var))]
+
+  [local'   "l"]
+  [foreign' "f"]
+  )
+
+(def: #export variable
+  (-> Variable (Operation Var))
+  (|>> (case> (#reference.Local register)
+              (local' register)
+              
+              (#reference.Foreign register)
+              (foreign' register))
+       /////wrap))
+
+(def: #export constant
+  (-> Name (Operation Global))
+  (|>> ///.remember (/////map _.global)))
+
+(def: #export reference
+  (-> Reference (Operation Expression))
+  (|>> (case> (#reference.Constant value)
+              (..constant value)
+              
+              (#reference.Variable value)
+              (..variable value))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux
new file mode 100644
index 000000000..d254e8c7d
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/runtime.jvm.lux
@@ -0,0 +1,322 @@
+(.module:
+  [lux #*
+   [control
+    ["p" parser ("#/." monad)]
+    [monad (#+ do)]]
+   [data
+    [number (#+ hex)]
+    [text
+     format]
+    [collection
+     ["." list ("#/." monad)]]]
+   ["." function]
+   [macro
+    ["." code]
+    ["s" syntax (#+ syntax:)]]]
+  ["." ///
+   ["//." //
+    [analysis (#+ Variant)]
+    ["." synthesis]
+    [//
+     ["." name]
+     [//
+      [host
+       ["_" scheme (#+ Expression Computation Var)]]]]]])
+
+(do-template [<name> <base>]
+  [(type: #export <name>
+     (<base> Var Expression Expression))]
+
+  [Operation ///.Operation]
+  [Phase ///.Phase]
+  [Handler ///.Handler]
+  [Bundle ///.Bundle]
+  )
+
+(def: prefix Text "LuxRuntime")
+
+(def: unit (_.string synthesis.unit))
+
+(def: #export variant-tag "lux-variant")
+
+(def: (flag value)
+  (-> Bit Computation)
+  (if value
+    (_.string "")
+    _.nil))
+
+(def: (variant' tag last? value)
+  (-> Expression Expression Expression Computation)
+  (<| (_.cons/2 (_.symbol ..variant-tag))
+      (_.cons/2 tag)
+      (_.cons/2 last?)
+      value))
+
+(def: #export (variant [lefts right? value])
+  (-> (Variant Expression) Computation)
+  (variant' (_.int (.int lefts)) (flag right?) value))
+
+(def: #export none
+  Computation
+  (variant [0 #0 ..unit]))
+
+(def: #export some
+  (-> Expression Computation)
+  (|>> [0 #1] ..variant))
+
+(def: #export left
+  (-> Expression Computation)
+  (|>> [0 #0] ..variant))
+
+(def: #export right
+  (-> Expression Computation)
+  (|>> [0 #1] ..variant))
+
+(def: declaration
+  (s.Syntax [Text (List Text)])
+  (p.either (p.and s.local-identifier (p/wrap (list)))
+            (s.form (p.and s.local-identifier (p.some s.local-identifier)))))
+
+(syntax: (runtime: {[name args] declaration}
+           definition)
+  (let [implementation (code.local-identifier (format "@@" name))
+        runtime (format prefix "__" (name.normalize name))
+        @runtime (` (_.var (~ (code.text runtime))))
+        argsC+ (list/map code.local-identifier args)
+        argsLC+ (list/map (|>> name.normalize (format "LRV__") code.text (~) (_.var) (`))
+                          args)
+        declaration (` ((~ (code.local-identifier 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-identifier))}
+                   body)
+  (wrap (list (` (let [(~+ (|> vars
+                               (list/map (function (_ var)
+                                           (list (code.local-identifier 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 (_.</2 @index_min_length))]
+    (_.begin
+     (list
+      (_.define @index_min_length [(list) #.None] (minimum-index-length index))
+      (_.define @product_length [(list) #.None] (_.length/1 product))
+      (<| (_.if last-element?
+            (product-element index product))
+          (_.if needs-recursion?
+            (product//right (product-tail product)
+                            (updated-index @index_min_length product)))
+          ## Must slice
+          (_.begin
+           (list (_.define @slice [(list) #.None]
+                           (_.make-vector/1 (|> @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 (_.</2 sum-tag))))
+            (variant' (|> 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: (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: runtime
+  Computation
+  (_.begin (list @@slice
+                 runtime//lux
+                 runtime//bit
+                 runtime//adt
+                 runtime//frac
+                 runtime//array
+                 runtime//box
+                 runtime//io
+                 )))
+
+(def: #export translate
+  (Operation Any)
+  (///.with-buffer
+    (do ////.monad
+      [_ (///.save! ["" ..prefix] ..runtime)]
+      (///.save-buffer! ""))))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux
new file mode 100644
index 000000000..dc1b88591
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/structure.jvm.lux
@@ -0,0 +1,33 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]]]
+  [//
+   ["." runtime (#+ Operation Phase)]
+   ["." primitive]
+   ["." ///
+    [analysis (#+ Variant Tuple)]
+    ["." synthesis (#+ Synthesis)]
+    [///
+     [host
+      ["_" scheme (#+ Expression)]]]]])
+
+(def: #export (tuple translate elemsS+)
+  (-> Phase (Tuple Synthesis) (Operation Expression))
+  (case elemsS+
+    #.Nil
+    (primitive.text synthesis.unit)
+
+    (#.Cons singletonS #.Nil)
+    (translate singletonS)
+
+    _
+    (do ///.monad
+      [elemsT+ (monad.map @ translate elemsS+)]
+      (wrap (_.vector/* elemsT+)))))
+
+(def: #export (variant translate [lefts right? valueS])
+  (-> Phase (Variant Synthesis) (Operation Expression))
+  (do ///.monad
+    [valueT (translate valueS)]
+    (wrap (runtime.variant [lefts right? valueT]))))
diff --git a/stdlib/source/lux/tool/compiler/reference.lux b/stdlib/source/lux/tool/compiler/reference.lux
new file mode 100644
index 000000000..a20691986
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/reference.lux
@@ -0,0 +1,88 @@
+(.module:
+  [lux #*
+   [control
+    [equivalence (#+ Equivalence)]
+    [hash (#+ Hash)]
+    pipe]
+   [data
+    [text
+     format]]])
+
+(type: #export Register Nat)
+
+(type: #export Variable
+  (#Local Register)
+  (#Foreign Register))
+
+(type: #export Reference
+  (#Variable Variable)
+  (#Constant Name))
+
+(structure: #export equivalence (Equivalence Variable)
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag>]
+        [(<tag> reference') (<tag> sample')]
+        (n/= reference' sample'))
+      ([#Local] [#Foreign])
+
+      _
+      #0)))
+
+(structure: #export hash (Hash Variable)
+  (def: &equivalence ..equivalence)
+  (def: (hash var)
+    (case var
+      (#Local register)
+      (n/* 1 register)
+      
+      (#Foreign register)
+      (n/* 2 register))))
+
+(do-template [<name> <family> <tag>]
+  [(template: #export (<name> content)
+     (<| <family>
+         <tag>
+         content))]
+
+  [local   #..Variable #..Local]
+  [foreign #..Variable #..Foreign]
+  )
+
+(do-template [<name> <tag>]
+  [(template: #export (<name> content)
+     (<| <tag>
+         content))]
+
+  [variable #..Variable]
+  [constant #..Constant]
+  )
+
+(def: #export self Reference (..local 0))
+
+(def: #export self?
+  (-> Variable Bit)
+  (|>> ..variable
+       (case> (^ (..local 0))
+              #1
+
+              _
+              #0)))
+
+(def: #export (%variable variable)
+  (Format Variable)
+  (case variable
+    (#Local local)
+    (format "+" (%n local))
+    
+    (#Foreign foreign)
+    (format "-" (%n foreign))))
+
+(def: #export (%reference reference)
+  (Format Reference)
+  (case reference
+    (#Variable variable)
+    (%variable variable)
+    
+    (#Constant constant)
+    (%name constant)))
diff --git a/stdlib/source/lux/tool/interpreter.lux b/stdlib/source/lux/tool/interpreter.lux
new file mode 100644
index 000000000..d2fbccfdc
--- /dev/null
+++ b/stdlib/source/lux/tool/interpreter.lux
@@ -0,0 +1,221 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ Monad do)]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." error (#+ Error)]
+    ["." text ("#/." equivalence)
+     format]]
+   [type (#+ :share)
+    ["." check]]
+   [compiler
+    ["." phase
+     ["." analysis
+      ["." module]
+      ["." type]]
+     ["." translation]
+     ["." statement (#+ State+ Operation)
+      ["." total]]
+     ["." extension]]
+    ["." default
+     ["." syntax]
+     ["." platform (#+ Platform)]
+     ["." init]]
+    ["." cli (#+ Configuration)]]
+   [world
+    ["." file (#+ File)]
+    ["." console (#+ Console)]]]
+  ["." /type])
+
+(exception: #export (error {message Text})
+  message)
+
+(def: #export module "<INTERPRETER>")
+
+(def: fresh-source Source [[..module 1 0] 0 ""])
+
+(def: (add-line line [where offset input])
+  (-> Text Source Source)
+  [where offset (format input text.new-line line)])
+
+(def: exit-command Text "exit")
+
+(def: welcome-message
+  Text
+  (format text.new-line
+          "Welcome to the interpreter!" text.new-line
+          "Type '" ..exit-command "' to leave." text.new-line
+          text.new-line))
+
+(def: farewell-message
+  Text
+  "Till next time...")
+
+(def: enter-module
+  (All [anchor expression statement]
+    (Operation anchor expression statement Any))
+  (statement.lift-analysis
+   (do phase.monad
+     [_ (module.create 0 ..module)]
+     (analysis.set-current-module ..module))))
+
+(def: (initialize Monad<!> Console<!> platform configuration translation-bundle)
+  (All [! anchor expression statement]
+    (-> (Monad !)
+        (Console !) (Platform ! anchor expression statement)
+        Configuration
+        (translation.Bundle anchor expression statement)
+        (! (State+ anchor expression statement))))
+  (do Monad<!>
+    [state (platform.initialize platform translation-bundle)
+     state (platform.compile platform
+                             (set@ #cli.module syntax.prelude configuration)
+                             (set@ [#extension.state
+                                    #statement.analysis #statement.state
+                                    #extension.state
+                                    #.info #.mode]
+                                   #.Interpreter
+                                   state))
+     [state _] (:: (get@ #platform.file-system platform)
+                   lift (phase.run' state enter-module))
+     _ (:: Console<!> write ..welcome-message)]
+    (wrap state)))
+
+(with-expansions [<Interpretation> (as-is (Operation anchor expression statement [Type Any]))]
+  
+  (def: (interpret-statement code)
+    (All [anchor expression statement]
+      (-> Code <Interpretation>))
+    (do phase.monad
+      [_ (total.phase code)
+       _ init.refresh]
+      (wrap [Any []])))
+
+  (def: (interpret-expression code)
+    (All [anchor expression statement]
+      (-> Code <Interpretation>))
+    (do phase.monad
+      [state (extension.lift phase.get-state)
+       #let [analyse (get@ [#statement.analysis #statement.phase] state)
+             synthesize (get@ [#statement.synthesis #statement.phase] state)
+             translate (get@ [#statement.translation #statement.phase] state)]
+       [_ codeT codeA] (statement.lift-analysis
+                        (analysis.with-scope
+                          (type.with-fresh-env
+                            (do @
+                              [[codeT codeA] (type.with-inference
+                                               (analyse code))
+                               codeT (type.with-env
+                                       (check.clean codeT))]
+                              (wrap [codeT codeA])))))
+       codeS (statement.lift-synthesis
+              (synthesize codeA))]
+      (statement.lift-translation
+       (translation.with-buffer
+         (do @
+           [codeH (translate codeS)
+            count translation.next
+            codeV (translation.evaluate! (format "interpretation_" (%n count)) codeH)]
+           (wrap [codeT codeV]))))))
+
+  (def: (interpret configuration code)
+    (All [anchor expression statement]
+      (-> Configuration Code <Interpretation>))
+    (function (_ state)
+      (case (<| (phase.run' state)
+                (:share [anchor expression statement]
+                        {(State+ anchor expression statement)
+                         state}
+                        {<Interpretation>
+                         (interpret-statement code)}))
+        (#error.Success [state' output])
+        (#error.Success [state' output])
+
+        (#error.Failure error)
+        (if (ex.match? total.not-a-statement error)
+          (<| (phase.run' state)
+              (:share [anchor expression statement]
+                      {(State+ anchor expression statement)
+                       state}
+                      {<Interpretation>
+                       (interpret-expression code)}))
+          (#error.Failure error)))))
+  )
+
+(def: (execute configuration code)
+  (All [anchor expression statement]
+    (-> Configuration Code (Operation anchor expression statement Text)))
+  (do phase.monad
+    [[codeT codeV] (interpret configuration code)
+     state phase.get-state]
+    (wrap (/type.represent (get@ [#extension.state
+                                  #statement.analysis #statement.state
+                                  #extension.state]
+                                 state)
+                           codeT
+                           codeV))))
+
+(type: (Context anchor expression statement)
+  {#configuration Configuration
+   #state (State+ anchor expression statement)
+   #source Source})
+
+(with-expansions [<Context> (as-is (Context anchor expression statement))]
+  (def: (read-eval-print context)
+    (All [anchor expression statement]
+      (-> <Context> (Error [<Context> Text])))
+    (do error.monad
+      [#let [[_where _offset _code] (get@ #source context)]
+       [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context))
+       [state' representation] (let [## TODO: Simplify ASAP
+                                     state (:share [anchor expression statement]
+                                                   {<Context>
+                                                    context}
+                                                   {(State+ anchor expression statement)
+                                                    (get@ #state context)})]
+                                 (<| (phase.run' state)
+                                     ## TODO: Simplify ASAP
+                                     (:share [anchor expression statement]
+                                             {<Context>
+                                              context}
+                                             {(Operation anchor expression statement Text)
+                                              (execute (get@ #configuration context) input)})))]
+      (wrap [(|> context
+                 (set@ #state state')
+                 (set@ #source source'))
+             representation]))))
+
+(def: #export (run Monad<!> Console<!> platform configuration translation-bundle)
+  (All [! anchor expression statement]
+    (-> (Monad !)
+        (Console !) (Platform ! anchor expression statement)
+        Configuration
+        (translation.Bundle anchor expression statement)
+        (! Any)))
+  (do Monad<!>
+    [state (initialize Monad<!> Console<!> platform configuration)]
+    (loop [context {#configuration configuration
+                    #state state
+                    #source ..fresh-source}
+           multi-line? #0]
+      (do @
+        [_ (if multi-line?
+             (:: Console<!> write "  ")
+             (:: Console<!> write "> "))
+         line (:: Console<!> read-line)]
+        (if (and (not multi-line?)
+                 (text/= ..exit-command line))
+          (:: Console<!> write ..farewell-message)
+          (case (read-eval-print (update@ #source (add-line line) context))
+            (#error.Success [context' representation])
+            (do @
+              [_ (:: Console<!> write representation)]
+              (recur context' #0))
+
+            (#error.Failure error)
+            (if (ex.match? syntax.end-of-file error)
+              (recur context #1)
+              (exec (log! (ex.construct ..error error))
+                (recur (set@ #source ..fresh-source context) #0))))))
+      )))
diff --git a/stdlib/source/lux/tool/interpreter/type.lux b/stdlib/source/lux/tool/interpreter/type.lux
new file mode 100644
index 000000000..f6a66a76a
--- /dev/null
+++ b/stdlib/source/lux/tool/interpreter/type.lux
@@ -0,0 +1,203 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ do)]
+    ["ex" exception (#+ exception:)]
+    ["p" parser]
+    pipe]
+   [data
+    ["." error (#+ Error)]
+    [text
+     format]
+    [format
+     [xml (#+ XML)]
+     [json (#+ JSON)]]
+    [collection
+     ["." list]]]
+   [time
+    [instant (#+ Instant)]
+    [duration (#+ Duration)]
+    [date (#+ Date)]]
+   ["." function]
+   ["." type]
+   ["." macro
+    ["." code]
+    ["." poly (#+ Poly)]]])
+
+(exception: #export (cannot-represent-value {type Type})
+  (ex.report ["Type" (%type type)]))
+
+(type: Representation (-> Any Text))
+
+(def: primitive-representation
+  (Poly Representation)
+  (`` ($_ p.either
+          (do p.monad
+            [_ (poly.exactly Any)]
+            (wrap (function.constant "[]")))
+          
+          (~~ (do-template [<type> <formatter>]
+                [(do p.monad
+                   [_ (poly.sub <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Bit %b]
+                [Nat %n]
+                [Int %i]
+                [Rev %r]
+                [Frac %f]
+                [Text %t])))))
+
+(def: (special-representation representation)
+  (-> (Poly Representation) (Poly Representation))
+  (`` ($_ p.either
+          (~~ (do-template [<type> <formatter>]
+                [(do p.monad
+                   [_ (poly.sub <type>)]
+                   (wrap (|>> (:coerce <type>) <formatter>)))]
+
+                [Type %type]
+                [Code %code]
+                [Instant %instant]
+                [Duration %duration]
+                [Date %date]
+                [JSON %json]
+                [XML %xml]))
+
+          (do p.monad
+            [[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any))
+             elemR (poly.local (list elemT) representation)]
+            (wrap (|>> (:coerce (List Any)) (%list elemR))))
+
+          (do p.monad
+            [[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any))
+             elemR (poly.local (list elemT) representation)]
+            (wrap (|>> (:coerce (Maybe Any))
+                       (case> #.None
+                              "#.None"
+
+                              (#.Some elemV)
+                              (format "(#.Some " (elemR elemV) ")"))))))))
+
+(def: (record-representation tags representation)
+  (-> (List Name) (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 Name) (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.indices 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.Failure 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.and 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.Failure error)
+    (ex.construct cannot-represent-value [type])))
diff --git a/stdlib/source/lux/tool/mediator.lux b/stdlib/source/lux/tool/mediator.lux
new file mode 100644
index 000000000..4481b6e2e
--- /dev/null
+++ b/stdlib/source/lux/tool/mediator.lux
@@ -0,0 +1,20 @@
+(.module:
+  [lux (#- Source Module)
+   [data
+    ["." error (#+ Error)]]
+   [world
+    ["." binary (#+ Binary)]
+    ["." file (#+ File)]]]
+  [//
+   [compiler (#+ Compiler)
+    [meta
+     ["." archive (#+ Archive)
+      [descriptor (#+ Module)]]]]])
+
+(type: #export Source File)
+
+(type: #export (Mediator !)
+  (-> Archive Module (! Archive)))
+
+(type: #export (Instancer ! d o)
+  (-> (file.System !) (List Source) (Compiler d o) (Mediator !)))
diff --git a/stdlib/source/lux/tool/mediator/parallelism.lux b/stdlib/source/lux/tool/mediator/parallelism.lux
new file mode 100644
index 000000000..c694f0490
--- /dev/null
+++ b/stdlib/source/lux/tool/mediator/parallelism.lux
@@ -0,0 +1,169 @@
+(.module:
+  [lux (#- Source Module)
+   [control
+    ["." monad (#+ Monad do)]
+    ["ex" exception (#+ exception:)]]
+   [concurrency
+    ["." promise (#+ Promise) ("#/." functor)]
+    ["." task (#+ Task)]
+    ["." stm (#+ Var STM)]]
+   [data
+    ["." error (#+ Error) ("#/." monad)]
+    ["." text ("#/." equivalence)
+     format]
+    [collection
+     ["." list ("#/." functor)]
+     ["." dictionary (#+ Dictionary)]]]
+   ["." io]]
+  ["." // (#+ Source Mediator)
+   [//
+    ["." compiler (#+ Input Output Compilation Compiler)
+     [meta
+      ["." archive (#+ Archive)
+       ["." descriptor (#+ Module Descriptor)]
+       [document (#+ Document)]]
+      [io
+       ["." context]]]]]])
+
+(exception: #export (self-dependency {module Module})
+  (ex.report ["Module" module]))
+
+(exception: #export (circular-dependency {module Module} {dependency Module})
+  (ex.report ["Module" module]
+             ["Dependency" dependency]))
+
+(type: Pending-Compilation
+  (Promise (Error (Ex [d] (Document d)))))
+
+(type: Active-Compilations
+  (Dictionary Module [Descriptor Pending-Compilation]))
+
+(def: (self-dependence? module dependency)
+  (-> Module Module Bit)
+  (text/= module dependency))
+
+(def: (circular-dependence? active dependency)
+  (-> Active-Compilations Module Bit)
+  (case (dictionary.get dependency active)
+    (#.Some [descriptor pending])
+    (case (get@ #descriptor.state descriptor)
+      #.Active
+      true
+
+      _
+      false)
+
+    #.None
+    false))
+
+(def: (ensure-valid-dependencies! active dependencies module)
+  (-> Active-Compilations (List Module) Module (Task Any))
+  (do task.monad
+    [_ (: (Task Any)
+          (if (list.any? (self-dependence? module) dependencies)
+            (task.throw self-dependency module)
+            (wrap [])))]
+    (: (Task Any)
+       (case (list.find (circular-dependence? active) dependencies)
+         (#.Some dependency)
+         (task.throw circular-dependency module dependency)
+
+         #.None
+         (wrap [])))))
+
+(def: (share-compilation archive pending)
+  (-> Active-Compilations Pending-Compilation (Task Archive))
+  (promise/map (|>> (error/map (function (_ document)
+                                 (archive.add module document archive)))
+                    error/join)
+               pending))
+
+(def: (import Monad<!> mediate archive dependencies)
+  (All [!] (-> (Monad !) (Mediator !) Active-Compilations (List Module) (! (List Archive))))
+  (|> dependencies
+      (list/map (mediate archive))
+      (monad.seq Monad<!>)))
+
+(def: (step-compilation archive imports [dependencies process])
+  (All [d o] (-> Archive (List Archive) (Compilation d o)
+                 [Archive (Either (Compilation d o)
+                                  [(Document d) (Output o)])]))
+  (do error.monad
+    [archive' (monad.fold error.monad archive.merge archive imports)
+     outcome (process archive')]
+    (case outcome
+      (#.Right [document output])
+      (do @
+        [archive'' (archive.add module document archive')]
+        (wrap [archive'' (#.Right [document output])]))
+
+      (#.Left continue)
+      (wrap [archive' outcome]))))
+
+(def: (request-compilation file-system sources module compilations)
+  (All [!]
+    (-> (file.System Task) (List Source) Module (Var Active-Compilations)
+        (Task (Either Pending-Compilation
+                      [Pending-Compilation Active-Compilations Input]))))
+  (do (:: file-system &monad)
+    [current (|> (stm.read compilations)
+                 stm.commit
+                 task.from-promise)]
+    (case (dictionary.get module current)
+      (#.Some [descriptor pending])
+      (wrap (#.Left pending))
+
+      #.None
+      (do @
+        [input (context.read file-system sources module)]
+        (do stm.monad
+          [stale (stm.read compilations)]
+          (case (dictionary.get module stale)
+            (#.Some [descriptor pending])
+            (wrap (#.Left [pending current]))
+
+            #.None
+            (do @
+              [#let [base-descriptor {#descriptor.hash (get@ #compiler.hash input)
+                                      #descriptor.name (get@ #compiler.module input)
+                                      #descriptor.file (get@ #compiler.file input)
+                                      #descriptor.references (list)
+                                      #descriptor.state #.Active}
+                     pending (promise.promise (: (Maybe (Error (Ex [d] (Document d))))
+                                                 #.None))]
+               updated (stm.update (dictionary.put (get@ #compiler.module input)
+                                                   [base-descriptor pending])
+                                   compilations)]
+              (wrap (is? current stale)
+                    (#.Right [pending updated input])))))))))
+
+(def: (mediate-compilation Monad<!> mediate compiler input archive pending)
+  (All [! d o] (-> (Monad !) (Mediator ! d o) (Compiler d o) Input Archive Pending-Compilation (Task Archive)))
+  (loop [archive archive
+         compilation (compiler input)]
+    (do Monad<!>
+      [#let [[dependencies process] compilation]
+       _ (ensure-valid-dependencies! active dependencies (get@ #compiler.module input))
+       imports (import @ mediate archive dependencies)
+       [archive' next] (promise/wrap (step-compilation archive imports compilation))]
+      (case next
+        (#.Left continue)
+        (recur archive' continue)
+        
+        (#.Right [document output])
+        (exec (io.run (promise.resolve (#error.Success document) pending))
+          (wrap archive'))))))
+
+(def: #export (mediator file-system sources compiler)
+  (//.Instancer Task)
+  (let [compilations (: (Var Active-Compilations)
+                        (stm.var (dictionary.new text.hash)))]
+    (function (mediate archive module)
+      (do (:: file-system &monad)
+        [request (request-compilation file-system sources module compilations)]
+        (case request
+          (#.Left pending)
+          (share-compilation archive pending)
+          
+          (#.Right [pending active input])
+          (mediate-compilation @ mediate compiler input archive pending))))))