From 8a51602b3507a18a5ffae1710ba4e915cf31fe39 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 5 Dec 2017 16:40:15 -0400
Subject: - All analysis procedures have been turned into extensions.

---
 new-luxc/source/luxc/lang/analysis/expression.lux  |    8 +-
 new-luxc/source/luxc/lang/analysis/procedure.lux   |   26 -
 .../source/luxc/lang/analysis/procedure/common.lux |  421 -------
 .../luxc/lang/analysis/procedure/host.jvm.lux      | 1242 -------------------
 new-luxc/source/luxc/lang/extension.lux            |   32 +-
 new-luxc/source/luxc/lang/extension/analysis.lux   |   18 +-
 .../source/luxc/lang/extension/analysis/common.lux |  419 +++++++
 .../luxc/lang/extension/analysis/host.jvm.lux      | 1243 ++++++++++++++++++++
 new-luxc/source/luxc/lang/extension/statement.lux  |    8 +-
 new-luxc/source/luxc/lang/extension/synthesis.lux  |    2 +-
 .../source/luxc/lang/extension/translation.lux     |    2 +-
 .../luxc/lang/translation/procedure/host.jvm.lux   |    2 +-
 12 files changed, 1708 insertions(+), 1715 deletions(-)
 delete mode 100644 new-luxc/source/luxc/lang/analysis/procedure.lux
 delete mode 100644 new-luxc/source/luxc/lang/analysis/procedure/common.lux
 delete mode 100644 new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
 create mode 100644 new-luxc/source/luxc/lang/extension/analysis/common.lux
 create mode 100644 new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux

(limited to 'new-luxc/source')

diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index 1463e7ec5..d19e98bd8 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -13,14 +13,14 @@
         (lang ["&." module]
               [".L" host]
               [".L" macro]
+              [".L" extension]
               ["la" analysis]
               (translation [".T" common])))
   (// [".A" common]
       [".A" function]
       [".A" primitive]
       [".A" reference]
-      [".A" structure]
-      [".A" procedure]))
+      [".A" structure]))
 
 (exception: #export Macro-Expression-Must-Have-Single-Expansion)
 (exception: #export Unrecognized-Syntax)
@@ -64,7 +64,9 @@
                (referenceA.analyse-reference reference)
 
                (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
-               (procedureA.analyse-procedure analyse eval proc-name proc-args)
+               (do macro.Monad<Meta>
+                 [procedure (extensionL.find-analysis proc-name)]
+                 (procedure analyse eval proc-args))
 
                (^template [<tag> <analyser>]
                  (^ (#.Form (list& [_ (<tag> tag)]
diff --git a/new-luxc/source/luxc/lang/analysis/procedure.lux b/new-luxc/source/luxc/lang/analysis/procedure.lux
deleted file mode 100644
index 25e1be335..000000000
--- a/new-luxc/source/luxc/lang/analysis/procedure.lux
+++ /dev/null
@@ -1,26 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data [maybe]
-             [text]
-             text/format
-             (coll [dict])))
-  (luxc ["&" lang]
-        (lang ["la" analysis]))
-  (/ ["/." common]
-     ["/." host]))
-
-(exception: #export Unknown-Procedure)
-
-(def: procedures
-  /common.Bundle
-  (|> /common.procedures
-      (dict.merge /host.procedures)))
-
-(def: #export (analyse-procedure analyse eval proc-name proc-args)
-  (-> &.Analyser &.Eval Text (List Code) (Meta la.Analysis))
-  (<| (maybe.default (&.throw Unknown-Procedure (%t proc-name)))
-      (do maybe.Monad<Maybe>
-        [proc (dict.get proc-name procedures)]
-        (wrap ((proc proc-name) analyse eval proc-args)))))
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
deleted file mode 100644
index ecdcd0bfd..000000000
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ /dev/null
@@ -1,421 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (concurrency [atom #+ Atom])
-       (data [text]
-             text/format
-             (coll [list "list/" Functor<List>]
-                   [array]
-                   [dict #+ Dict]))
-       [macro]
-       (macro [code])
-       (lang (type ["tc" check]))
-       [io])
-  (luxc ["&" lang]
-        (lang ["la" analysis]
-              (analysis ["&." common]
-                        [".A" function]
-                        [".A" case]
-                        [".A" type]))))
-
-(exception: #export Incorrect-Procedure-Arity)
-(exception: #export Invalid-Syntax)
-
-## [Utils]
-(type: #export Proc
-  (-> &.Analyser &.Eval (List Code) (Meta la.Analysis)))
-
-(type: #export Bundle
-  (Dict Text (-> Text Proc)))
-
-(def: #export (install name unnamed)
-  (-> Text (-> Text Proc)
-      (-> Bundle Bundle))
-  (dict.put name unnamed))
-
-(def: #export (prefix prefix bundle)
-  (-> Text Bundle Bundle)
-  (|> bundle
-      dict.entries
-      (list/map (function [[key val]] [(format prefix " " key) val]))
-      (dict.from-list text.Hash<Text>)))
-
-(def: #export (wrong-arity proc expected actual)
-  (-> Text Nat Nat Text)
-  (format "      Procedure: " (%t proc) "\n"
-          " Expected Arity: " (|> expected nat-to-int %i) "\n"
-          "   Actual Arity: " (|> actual nat-to-int %i)))
-
-(def: (simple proc inputsT+ outputT)
-  (-> Text (List Type) Type Proc)
-  (let [num-expected (list.size inputsT+)]
-    (function [analyse eval args]
-      (let [num-actual (list.size args)]
-        (if (n/= num-expected num-actual)
-          (do macro.Monad<Meta>
-            [_ (&.infer outputT)
-             argsA (monad.map @
-                              (function [[argT argC]]
-                                (&.with-type argT
-                                  (analyse argC)))
-                              (list.zip2 inputsT+ args))]
-            (wrap (la.procedure proc argsA)))
-          (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual)))))))
-
-(def: #export (nullary valueT proc)
-  (-> Type Text Proc)
-  (simple proc (list) valueT))
-
-(def: #export (unary inputT outputT proc)
-  (-> Type Type Text Proc)
-  (simple proc (list inputT) outputT))
-
-(def: #export (binary subjectT paramT outputT proc)
-  (-> Type Type Type Text Proc)
-  (simple proc (list subjectT paramT) outputT))
-
-(def: #export (trinary subjectT param0T param1T outputT proc)
-  (-> Type Type Type Type Text Proc)
-  (simple proc (list subjectT param0T param1T) outputT))
-
-## [Analysers]
-## "lux is" represents reference/pointer equality.
-(def: (lux//is proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((binary varT varT Bool proc)
-       analyse eval args))))
-
-## "lux try" provides a simple way to interact with the host platform's
-## error-handling facilities.
-(def: (lux//try proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list opC))
-      (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
-         _ (&.infer (type (Either Text varT)))
-         opA (&.with-type (type (io.IO varT))
-               (analyse opC))]
-        (wrap (la.procedure proc (list opA))))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: (lux//function proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list [_ (#.Symbol ["" func-name])]
-               [_ (#.Symbol ["" arg-name])]
-               body))
-      (functionA.analyse-function analyse func-name arg-name body)
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args))))))
-
-(def: (lux//case proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list input [_ (#.Record branches)]))
-      (caseA.analyse-case analyse input branches)
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
-
-(def: (lux//in-module proc)
-  (-> Text Proc)
-  (function [analyse eval argsC+]
-    (case argsC+
-      (^ (list [_ (#.Text module-name)] exprC))
-      (&.with-current-module module-name
-        (analyse exprC))
-      
-      _
-      (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
-                                      "   Inputs:" (|> argsC+
-                                                       list.enumerate
-                                                       (list/map (function [[idx argC]]
-                                                                   (format "\n  " (%n idx) " " (%code argC))))
-                                                       (text.join-with "")) "\n")))))
-
-(do-template [<name> <analyser>]
-  [(def: (<name> proc)
-     (-> Text Proc)
-     (function [analyse eval args]
-       (case args
-         (^ (list typeC valueC))
-         (<analyser> analyse eval typeC valueC)
-         
-         _
-         (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))]
-
-  [lux//check typeA.analyse-check]
-  [lux//coerce typeA.analyse-coerce])
-
-(def: (lux//check//type proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list valueC))
-      (do macro.Monad<Meta>
-        [_ (&.infer (type Type))
-         valueA (&.with-type Type
-                  (analyse valueC))]
-        (wrap valueA))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: lux-procs
-  Bundle
-  (|> (dict.new text.Hash<Text>)
-      (install "is" lux//is)
-      (install "try" lux//try)
-      (install "function" lux//function)
-      (install "case" lux//case)
-      (install "check" lux//check)
-      (install "coerce" lux//coerce)
-      (install "check type" lux//check//type)
-      (install "in-module" lux//in-module)))
-
-(def: io-procs
-  Bundle
-  (<| (prefix "io")
-      (|> (dict.new text.Hash<Text>)
-          (install "log" (unary Text Unit))
-          (install "error" (unary Text Bottom))
-          (install "exit" (unary Int Bottom))
-          (install "current-time" (nullary Int)))))
-
-(def: bit-procs
-  Bundle
-  (<| (prefix "bit")
-      (|> (dict.new text.Hash<Text>)
-          (install "count" (unary Nat Nat))
-          (install "and" (binary Nat Nat Nat))
-          (install "or" (binary Nat Nat Nat))
-          (install "xor" (binary Nat Nat Nat))
-          (install "shift-left" (binary Nat Nat Nat))
-          (install "unsigned-shift-right" (binary Nat Nat Nat))
-          (install "shift-right" (binary Int Nat Int))
-          )))
-
-(def: nat-procs
-  Bundle
-  (<| (prefix "nat")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Nat Nat Nat))
-          (install "-" (binary Nat Nat Nat))
-          (install "*" (binary Nat Nat Nat))
-          (install "/" (binary Nat Nat Nat))
-          (install "%" (binary Nat Nat Nat))
-          (install "=" (binary Nat Nat Bool))
-          (install "<" (binary Nat Nat Bool))
-          (install "min" (nullary Nat))
-          (install "max" (nullary Nat))
-          (install "to-int" (unary Nat Int))
-          (install "char" (unary Nat Text)))))
-
-(def: int-procs
-  Bundle
-  (<| (prefix "int")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Int Int Int))
-          (install "-" (binary Int Int Int))
-          (install "*" (binary Int Int Int))
-          (install "/" (binary Int Int Int))
-          (install "%" (binary Int Int Int))
-          (install "=" (binary Int Int Bool))
-          (install "<" (binary Int Int Bool))
-          (install "min" (nullary Int))
-          (install "max" (nullary Int))
-          (install "to-nat" (unary Int Nat))
-          (install "to-frac" (unary Int Frac)))))
-
-(def: deg-procs
-  Bundle
-  (<| (prefix "deg")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Deg Deg Deg))
-          (install "-" (binary Deg Deg Deg))
-          (install "*" (binary Deg Deg Deg))
-          (install "/" (binary Deg Deg Deg))
-          (install "%" (binary Deg Deg Deg))
-          (install "=" (binary Deg Deg Bool))
-          (install "<" (binary Deg Deg Bool))
-          (install "scale" (binary Deg Nat Deg))
-          (install "reciprocal" (binary Deg Nat Deg))
-          (install "min" (nullary Deg))
-          (install "max" (nullary Deg))
-          (install "to-frac" (unary Deg Frac)))))
-
-(def: frac-procs
-  Bundle
-  (<| (prefix "frac")
-      (|> (dict.new text.Hash<Text>)
-          (install "+" (binary Frac Frac Frac))
-          (install "-" (binary Frac Frac Frac))
-          (install "*" (binary Frac Frac Frac))
-          (install "/" (binary Frac Frac Frac))
-          (install "%" (binary Frac Frac Frac))
-          (install "=" (binary Frac Frac Bool))
-          (install "<" (binary Frac Frac Bool))
-          (install "smallest" (nullary Frac))
-          (install "min" (nullary Frac))
-          (install "max" (nullary Frac))
-          (install "not-a-number" (nullary Frac))
-          (install "positive-infinity" (nullary Frac))
-          (install "negative-infinity" (nullary Frac))
-          (install "to-deg" (unary Frac Deg))
-          (install "to-int" (unary Frac Int))
-          (install "encode" (unary Frac Text))
-          (install "decode" (unary Text (type (Maybe Frac)))))))
-
-(def: text-procs
-  Bundle
-  (<| (prefix "text")
-      (|> (dict.new text.Hash<Text>)
-          (install "=" (binary Text Text Bool))
-          (install "<" (binary Text Text Bool))
-          (install "concat" (binary Text Text Text))
-          (install "index" (trinary Text Text Nat (type (Maybe Nat))))
-          (install "size" (unary Text Nat))
-          (install "hash" (unary Text Nat))
-          (install "replace-once" (trinary Text Text Text Text))
-          (install "replace-all" (trinary Text Text Text Text))
-          (install "char" (binary Text Nat (type (Maybe Nat))))
-          (install "clip" (trinary Text Nat Nat (type (Maybe Text))))
-          (install "upper" (unary Text Text))
-          (install "lower" (unary Text Text))
-          )))
-
-(def: (array//get proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((binary (type (Array varT)) Nat (type (Maybe varT)) proc)
-       analyse eval args))))
-
-(def: (array//put proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc)
-       analyse eval args))))
-
-(def: (array//remove proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((binary (type (Array varT)) Nat (type (Array varT)) proc)
-       analyse eval args))))
-
-(def: array-procs
-  Bundle
-  (<| (prefix "array")
-      (|> (dict.new text.Hash<Text>)
-          (install "new" (unary Nat Array))
-          (install "get" array//get)
-          (install "put" array//put)
-          (install "remove" array//remove)
-          (install "size" (unary (type (Ex [a] (Array a))) Nat))
-          )))
-
-(def: math-procs
-  Bundle
-  (<| (prefix "math")
-      (|> (dict.new text.Hash<Text>)
-          (install "cos" (unary Frac Frac))
-          (install "sin" (unary Frac Frac))
-          (install "tan" (unary Frac Frac))
-          (install "acos" (unary Frac Frac))
-          (install "asin" (unary Frac Frac))
-          (install "atan" (unary Frac Frac))
-          (install "cosh" (unary Frac Frac))
-          (install "sinh" (unary Frac Frac))
-          (install "tanh" (unary Frac Frac))
-          (install "exp" (unary Frac Frac))
-          (install "log" (unary Frac Frac))
-          (install "root2" (unary Frac Frac))
-          (install "root3" (unary Frac Frac))
-          (install "ceil" (unary Frac Frac))
-          (install "floor" (unary Frac Frac))
-          (install "round" (unary Frac Frac))
-          (install "atan2" (binary Frac Frac Frac))
-          (install "pow" (binary Frac Frac Frac))
-          )))
-
-(def: (atom-new proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list initC))
-      (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
-         _ (&.infer (type (Atom varT)))
-         initA (&.with-type varT
-                 (analyse initC))]
-        (wrap (la.procedure proc (list initA))))
-      
-      _
-      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
-
-(def: (atom-read proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((unary (type (Atom varT)) varT proc)
-       analyse eval args))))
-
-(def: (atom//compare-and-swap proc)
-  (-> Text Proc)
-  (function [analyse eval args]
-    (do macro.Monad<Meta>
-      [[var-id varT] (&.with-type-env tc.var)]
-      ((trinary (type (Atom varT)) varT varT Bool proc)
-       analyse eval args))))
-
-(def: atom-procs
-  Bundle
-  (<| (prefix "atom")
-      (|> (dict.new text.Hash<Text>)
-          (install "new" atom-new)
-          (install "read" atom-read)
-          (install "compare-and-swap" atom//compare-and-swap)
-          )))
-
-(def: process-procs
-  Bundle
-  (<| (prefix "process")
-      (|> (dict.new text.Hash<Text>)
-          (install "concurrency-level" (nullary Nat))
-          (install "future" (unary (type (io.IO Top)) Unit))
-          (install "schedule" (binary Nat (type (io.IO Top)) Unit))
-          )))
-
-(def: #export procedures
-  Bundle
-  (<| (prefix "lux")
-      (|> (dict.new text.Hash<Text>)
-          (dict.merge lux-procs)
-          (dict.merge bit-procs)
-          (dict.merge nat-procs)
-          (dict.merge int-procs)
-          (dict.merge deg-procs)
-          (dict.merge frac-procs)
-          (dict.merge text-procs)
-          (dict.merge array-procs)
-          (dict.merge math-procs)
-          (dict.merge atom-procs)
-          (dict.merge process-procs)
-          (dict.merge io-procs))))
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
deleted file mode 100644
index 3c29410d0..000000000
--- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
+++ /dev/null
@@ -1,1242 +0,0 @@
-(.module:
-  [lux #- char]
-  (lux (control [monad #+ do]
-                ["p" parser]
-                ["ex" exception #+ exception:])
-       (concurrency ["A" atom])
-       (data ["e" error]
-             [maybe]
-             [product]
-             [bool "bool/" Eq<Bool>]
-             [text "text/" Eq<Text>]
-             (text format
-                   ["l" lexer])
-             (coll [list "list/" Fold<List> Functor<List> Monoid<List>]
-                   [array]
-                   [dict #+ Dict]))
-       [macro "macro/" Monad<Meta>]
-       (macro [code]
-              ["s" syntax])
-       (lang [type]
-             (type ["tc" check]))
-       [host])
-  (luxc ["&" lang]
-        (lang ["&." host]
-              ["la" analysis]
-              (analysis ["&." common]
-                        [".A" inference])))
-  ["@" //common]
-  )
-
-(exception: #export Wrong-Syntax)
-(def: (wrong-syntax procedure args)
-  (-> Text (List Code) Text)
-  (format "Procedure: " procedure "\n"
-          "Arguments: " (%code (code.tuple args))))
-
-(exception: #export JVM-Type-Is-Not-Class)
-
-(exception: #export Non-Interface)
-(exception: #export Non-Object)
-(exception: #export Non-Array)
-(exception: #export Non-Throwable)
-(exception: #export Non-JVM-Type)
-
-(exception: #export Unknown-Class)
-(exception: #export Primitives-Cannot-Have-Type-Parameters)
-(exception: #export Primitives-Are-Not-Objects)
-(exception: #export Invalid-Type-For-Array-Element)
-
-(exception: #export Unknown-Field)
-(exception: #export Mistaken-Field-Owner)
-(exception: #export Not-Virtual-Field)
-(exception: #export Not-Static-Field)
-(exception: #export Cannot-Set-Final-Field)
-
-(exception: #export No-Candidates)
-(exception: #export Too-Many-Candidates)
-
-(exception: #export Cannot-Cast)
-(def: (cannot-cast to from)
-  (-> Type Type Text)
-  (format "From: " (%type from) "\n"
-          "  To: " (%type to)))
-
-(exception: #export Cannot-Possibly-Be-Instance)
-
-(exception: #export Cannot-Convert-To-Class)
-(exception: #export Cannot-Convert-To-Parameter)
-(exception: #export Cannot-Convert-To-Lux-Type)
-(exception: #export Unknown-Type-Var)
-(exception: #export Type-Parameter-Mismatch)
-(exception: #export Cannot-Correspond-Type-With-Class)
-
-(def: #export null-class Text "#Null")
-
-(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: conversion-procs
-  @.Bundle
-  (<| (@.prefix "convert")
-      (|> (dict.new text.Hash<Text>)
-          (@.install "double-to-float" (@.unary Double Float))
-          (@.install "double-to-int" (@.unary Double Integer))
-          (@.install "double-to-long" (@.unary Double Long))
-          (@.install "float-to-double" (@.unary Float Double))
-          (@.install "float-to-int" (@.unary Float Integer))
-          (@.install "float-to-long" (@.unary Float Long))
-          (@.install "int-to-byte" (@.unary Integer Byte))
-          (@.install "int-to-char" (@.unary Integer Character))
-          (@.install "int-to-double" (@.unary Integer Double))
-          (@.install "int-to-float" (@.unary Integer Float))
-          (@.install "int-to-long" (@.unary Integer Long))
-          (@.install "int-to-short" (@.unary Integer Short))
-          (@.install "long-to-double" (@.unary Long Double))
-          (@.install "long-to-float" (@.unary Long Float))
-          (@.install "long-to-int" (@.unary Long Integer))
-          (@.install "long-to-short" (@.unary Long Short))
-          (@.install "long-to-byte" (@.unary Long Byte))
-          (@.install "char-to-byte" (@.unary Character Byte))
-          (@.install "char-to-short" (@.unary Character Short))
-          (@.install "char-to-int" (@.unary Character Integer))
-          (@.install "char-to-long" (@.unary Character Long))
-          (@.install "byte-to-long" (@.unary Byte Long))
-          (@.install "short-to-long" (@.unary Short Long))
-          )))
-
-(do-template [<name> <prefix> <type>]
-  [(def: <name>
-     @.Bundle
-     (<| (@.prefix <prefix>)
-         (|> (dict.new text.Hash<Text>)
-             (@.install "+" (@.binary <type> <type> <type>))
-             (@.install "-" (@.binary <type> <type> <type>))
-             (@.install "*" (@.binary <type> <type> <type>))
-             (@.install "/" (@.binary <type> <type> <type>))
-             (@.install "%" (@.binary <type> <type> <type>))
-             (@.install "=" (@.binary <type> <type> Boolean))
-             (@.install "<" (@.binary <type> <type> Boolean))
-             (@.install "and" (@.binary <type> <type> <type>))
-             (@.install "or" (@.binary <type> <type> <type>))
-             (@.install "xor" (@.binary <type> <type> <type>))
-             (@.install "shl" (@.binary <type> Integer <type>))
-             (@.install "shr" (@.binary <type> Integer <type>))
-             (@.install "ushr" (@.binary <type> Integer <type>))
-             )))]
-
-  [int-procs  "int"  Integer]
-  [long-procs "long" Long]
-  )
-
-(do-template [<name> <prefix> <type>]
-  [(def: <name>
-     @.Bundle
-     (<| (@.prefix <prefix>)
-         (|> (dict.new text.Hash<Text>)
-             (@.install "+" (@.binary <type> <type> <type>))
-             (@.install "-" (@.binary <type> <type> <type>))
-             (@.install "*" (@.binary <type> <type> <type>))
-             (@.install "/" (@.binary <type> <type> <type>))
-             (@.install "%" (@.binary <type> <type> <type>))
-             (@.install "=" (@.binary <type> <type> Boolean))
-             (@.install "<" (@.binary <type> <type> Boolean))
-             )))]
-
-  [float-procs  "float"  Float]
-  [double-procs "double" Double]
-  )
-
-(def: char-procs
-  @.Bundle
-  (<| (@.prefix "char")
-      (|> (dict.new text.Hash<Text>)
-          (@.install "=" (@.binary Character Character Boolean))
-          (@.install "<" (@.binary Character Character Boolean))
-          )))
-
-(def: #export boxes
-  (Dict Text Text)
-  (|> (list ["boolean" "java.lang.Boolean"]
-            ["byte" "java.lang.Byte"]
-            ["short" "java.lang.Short"]
-            ["int" "java.lang.Integer"]
-            ["long" "java.lang.Long"]
-            ["float" "java.lang.Float"]
-            ["double" "java.lang.Double"]
-            ["char" "java.lang.Character"])
-      (dict.from-list text.Hash<Text>)))
-
-(def: (array-length proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list arrayC))
-      (do macro.Monad<Meta>
-        [_ (&.infer Nat)
-         [var-id varT] (&.with-type-env tc.var)
-         arrayA (&.with-type (type (Array varT))
-                  (analyse arrayC))]
-        (wrap (la.procedure proc (list arrayA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
-
-(def: (array-new proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list lengthC))
-      (do macro.Monad<Meta>
-        [lengthA (&.with-type Nat
-                   (analyse lengthC))
-         expectedT macro.expected-type
-         [level elem-class] (: (Meta [Nat Text])
-                               (loop [analysisT expectedT
-                                      level +0]
-                                 (case analysisT
-                                   (#.Apply inputT funcT)
-                                   (case (type.apply (list inputT) funcT)
-                                     (#.Some outputT)
-                                     (recur outputT level)
-
-                                     #.None
-                                     (&.throw Non-Array (%type expectedT)))
-
-                                   (^ (#.Primitive "#Array" (list elemT)))
-                                   (recur elemT (n/inc level))
-
-                                   (#.Primitive class _)
-                                   (wrap [level class])
-                                   
-                                   _
-                                   (&.throw Non-Array (%type expectedT)))))
-         _ (if (n/> +0 level)
-             (wrap [])
-             (&.throw Non-Array (%type expectedT)))]
-        (wrap (la.procedure proc (list (code.nat (n/dec level)) (code.text elem-class) lengthA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
-
-(def: (check-jvm objectT)
-  (-> Type (Meta Text))
-  (case objectT
-    (#.Primitive name _)
-    (macro/wrap name)
-
-    (#.Named name unnamed)
-    (check-jvm unnamed)
-
-    (#.Var id)
-    (macro/wrap "java.lang.Object")
-
-    (^template [<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 (%type objectT)))
-
-    _
-    (&.throw Non-Object (%type objectT))))
-
-(def: (check-object objectT)
-  (-> Type (Meta Text))
-  (do macro.Monad<Meta>
-    [name (check-jvm objectT)]
-    (if (dict.contains? name boxes)
-      (&.throw Primitives-Are-Not-Objects name)
-      (macro/wrap name))))
-
-(def: (box-array-element-type elemT)
-  (-> Type (Meta [Type Text]))
-  (case elemT
-    (#.Primitive name #.Nil)
-    (let [boxed-name (|> (dict.get name boxes)
-                         (maybe.default name))]
-      (macro/wrap [(#.Primitive boxed-name #.Nil)
-                   boxed-name]))
-
-    (#.Primitive name _)
-    (if (dict.contains? name boxes)
-      (&.throw Primitives-Cannot-Have-Type-Parameters name)
-      (macro/wrap [elemT name]))
-
-    _
-    (&.throw Invalid-Type-For-Array-Element (%type elemT))))
-
-(def: (array-read proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list arrayC idxC))
-      (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
-         _ (&.infer varT)
-         arrayA (&.with-type (type (Array varT))
-                  (analyse arrayC))
-         ?elemT (&.with-type-env
-                  (tc.read var-id))
-         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
-         idxA (&.with-type Nat
-                (analyse idxC))]
-        (wrap (la.procedure proc (list (code.text elem-class) idxA arrayA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
-
-(def: (array-write proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list arrayC idxC valueC))
-      (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
-         _ (&.infer (type (Array varT)))
-         arrayA (&.with-type (type (Array varT))
-                  (analyse arrayC))
-         ?elemT (&.with-type-env
-                  (tc.read var-id))
-         [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
-         idxA (&.with-type Nat
-                (analyse idxC))
-         valueA (&.with-type valueT
-                  (analyse valueC))]
-        (wrap (la.procedure proc (list (code.text elem-class) idxA valueA arrayA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
-
-(def: array-procs
-  @.Bundle
-  (<| (@.prefix "array")
-      (|> (dict.new text.Hash<Text>)
-          (@.install "length" array-length)
-          (@.install "new" array-new)
-          (@.install "read" array-read)
-          (@.install "write" array-write)
-          )))
-
-(def: (object-null proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list))
-      (do macro.Monad<Meta>
-        [expectedT macro.expected-type
-         _ (check-object expectedT)]
-        (wrap (la.procedure proc (list))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +0 (list.size args))))))
-
-(def: (object-null? proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list objectC))
-      (do macro.Monad<Meta>
-        [_ (&.infer Bool)
-         [objectT objectA] (&common.with-unknown-type
-                             (analyse objectC))
-         _ (check-object objectT)]
-        (wrap (la.procedure proc (list objectA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
-
-(def: (object-synchronized proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list monitorC exprC))
-      (do macro.Monad<Meta>
-        [[monitorT monitorA] (&common.with-unknown-type
-                               (analyse monitorC))
-         _ (check-object monitorT)
-         exprA (analyse exprC)]
-        (wrap (la.procedure proc (list monitorA exprA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
-
-(host.import java/lang/Object
-  (equals [Object] boolean))
-
-(host.import java/lang/ClassLoader)
-
-(host.import #long java/lang/reflect/Type
-  (getTypeName [] String))
-
-(host.import java/lang/reflect/GenericArrayType
-  (getGenericComponentType [] java/lang/reflect/Type))
-
-(host.import java/lang/reflect/ParameterizedType
-  (getRawType [] java/lang/reflect/Type)
-  (getActualTypeArguments [] (Array java/lang/reflect/Type)))
-
-(host.import (java/lang/reflect/TypeVariable d)
-  (getName [] String)
-  (getBounds [] (Array java/lang/reflect/Type)))
-
-(host.import (java/lang/reflect/WildcardType d)
-  (getLowerBounds [] (Array java/lang/reflect/Type))
-  (getUpperBounds [] (Array java/lang/reflect/Type)))
-
-(host.import java/lang/reflect/Modifier
-  (#static isStatic [int] boolean)
-  (#static isFinal [int] boolean)
-  (#static isInterface [int] boolean)
-  (#static isAbstract [int] boolean))
-
-(host.import java/lang/reflect/Field
-  (getDeclaringClass [] (java/lang/Class Object))
-  (getModifiers [] int)
-  (getGenericType [] java/lang/reflect/Type))
-
-(host.import java/lang/reflect/Method
-  (getName [] String)
-  (getModifiers [] int)
-  (getDeclaringClass [] (Class Object))
-  (getTypeParameters [] (Array (TypeVariable Method)))
-  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
-  (getGenericReturnType [] java/lang/reflect/Type)
-  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-
-(host.import (java/lang/reflect/Constructor c)
-  (getModifiers [] int)
-  (getDeclaringClass [] (Class c))
-  (getTypeParameters [] (Array (TypeVariable (Constructor c))))
-  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
-  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
-
-(host.import (java/lang/Class c)
-  (getName [] String)
-  (getModifiers [] int)
-  (#static forName [String boolean ClassLoader] #try (Class Object))
-  (isAssignableFrom [(Class Object)] boolean)
-  (getTypeParameters [] (Array (TypeVariable (Class c))))
-  (getGenericInterfaces [] (Array java/lang/reflect/Type))
-  (getGenericSuperclass [] java/lang/reflect/Type)
-  (getDeclaredField [String] #try Field)
-  (getConstructors [] (Array (Constructor Object)))
-  (getDeclaredMethods [] (Array Method)))
-
-(def: (load-class name)
-  (-> Text (Meta (Class Object)))
-  (do macro.Monad<Meta>
-    [class-loader &host.class-loader]
-    (case (Class::forName [name false class-loader])
-      (#e.Success [class])
-      (wrap class)
-
-      (#e.Error error)
-      (&.throw Unknown-Class name))))
-
-(def: (sub-class? super sub)
-  (-> Text Text (Meta Bool))
-  (do macro.Monad<Meta>
-    [super (load-class super)
-     sub (load-class sub)]
-    (wrap (Class::isAssignableFrom [sub] super))))
-
-(def: (object-throw proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list exceptionC))
-      (do macro.Monad<Meta>
-        [_ (&.infer Bottom)
-         [exceptionT exceptionA] (&common.with-unknown-type
-                                   (analyse exceptionC))
-         exception-class (check-object exceptionT)
-         ? (sub-class? "java.lang.Throwable" exception-class)
-         _ (: (Meta Unit)
-              (if ?
-                (wrap [])
-                (&.throw Non-Throwable exception-class)))]
-        (wrap (la.procedure proc (list exceptionA))))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
-
-(def: (object-class proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC))
-      (case classC
-        [_ (#.Text class)]
-        (do macro.Monad<Meta>
-          [_ (&.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
-           _ (load-class class)]
-          (wrap (la.procedure proc (list (code.text class)))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
-
-(def: (object-instance? proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC objectC))
-      (case classC
-        [_ (#.Text class)]
-        (do macro.Monad<Meta>
-          [_ (&.infer Bool)
-           [objectT objectA] (&common.with-unknown-type
-                               (analyse objectC))
-           object-class (check-object objectT)
-           ? (sub-class? class object-class)]
-          (if ?
-            (wrap (la.procedure proc (list (code.text class))))
-            (&.throw Cannot-Possibly-Be-Instance (format object-class " !<= "  class))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
-
-(def: object-procs
-  @.Bundle
-  (<| (@.prefix "object")
-      (|> (dict.new text.Hash<Text>)
-          (@.install "null" object-null)
-          (@.install "null?" object-null?)
-          (@.install "synchronized" object-synchronized)
-          (@.install "throw" object-throw)
-          (@.install "class" object-class)
-          (@.install "instance?" object-instance?)
-          )))
-
-(def: type-descriptor
-  (-> java/lang/reflect/Type Text)
-  (java/lang/reflect/Type::getTypeName []))
-
-(def: (java-type-to-class type)
-  (-> java/lang/reflect/Type (Meta Text))
-  (cond (host.instance? Class type)
-        (macro/wrap (Class::getName [] (:! Class type)))
-
-        (host.instance? ParameterizedType type)
-        (java-type-to-class (ParameterizedType::getRawType [] (:! ParameterizedType type)))
-
-        ## else
-        (&.throw Cannot-Convert-To-Class (type-descriptor type))))
-
-(type: Mappings
-  (Dict Text Type))
-
-(def: fresh-mappings Mappings (dict.new text.Hash<Text>))
-
-(def: (java-type-to-lux-type mappings java-type)
-  (-> Mappings java/lang/reflect/Type (Meta Type))
-  (cond (host.instance? TypeVariable java-type)
-        (let [var-name (TypeVariable::getName [] (:! TypeVariable java-type))]
-          (case (dict.get var-name mappings)
-            (#.Some var-type)
-            (macro/wrap var-type)
-            
-            #.None
-            (&.throw Unknown-Type-Var var-name)))
-
-        (host.instance? WildcardType java-type)
-        (let [java-type (:! WildcardType java-type)]
-          (case [(array.read +0 (WildcardType::getUpperBounds [] java-type))
-                 (array.read +0 (WildcardType::getLowerBounds [] java-type))]
-            (^or [(#.Some bound) _] [_ (#.Some bound)])
-            (java-type-to-lux-type mappings bound)
-            
-            _
-            (macro/wrap Top)))
-
-        (host.instance? Class java-type)
-        (let [java-type (:! (Class Object) java-type)
-              class-name (Class::getName [] java-type)]
-          (macro/wrap (case (array.size (Class::getTypeParameters [] java-type))
-                        +0
-                        (#.Primitive class-name (list))
-                        
-                        arity
-                        (|> (list.n/range +0 (n/dec arity))
-                            list.reverse
-                            (list/map (|>> (n/* +2) n/inc #.Bound))
-                            (#.Primitive class-name)
-                            (type.univ-q arity)))))
-
-        (host.instance? ParameterizedType java-type)
-        (let [java-type (:! ParameterizedType java-type)
-              raw (ParameterizedType::getRawType [] java-type)]
-          (if (host.instance? Class raw)
-            (do macro.Monad<Meta>
-              [paramsT (|> java-type
-                           (ParameterizedType::getActualTypeArguments [])
-                           array.to-list
-                           (monad.map @ (java-type-to-lux-type mappings)))]
-              (macro/wrap (#.Primitive (Class::getName [] (:! (Class Object) raw))
-                                       paramsT)))
-            (&.throw JVM-Type-Is-Not-Class (type-descriptor raw))))
-
-        (host.instance? GenericArrayType java-type)
-        (do macro.Monad<Meta>
-          [innerT (|> (:! GenericArrayType java-type)
-                      (GenericArrayType::getGenericComponentType [])
-                      (java-type-to-lux-type mappings))]
-          (wrap (#.Primitive "#Array" (list innerT))))
-
-        ## else
-        (&.throw Cannot-Convert-To-Lux-Type (type-descriptor java-type))))
-
-(type: Direction
-  #In
-  #Out)
-
-(def: (choose direction to from)
-  (-> Direction Text Text Text)
-  (case direction
-    #In to
-    #Out from))
-
-(def: (correspond-type-params class type)
-  (-> (Class Object) Type (Meta Mappings))
-  (case type
-    (#.Primitive name params)
-    (let [class-name (Class::getName [] class)
-          class-params (array.to-list (Class::getTypeParameters [] class))
-          num-class-params (list.size class-params)
-          num-type-params (list.size params)]
-      (cond (not (text/= class-name name))
-            (&.throw Cannot-Correspond-Type-With-Class
-                     (format "Class = " class-name "\n"
-                             "Type = " (%type type)))
-
-            (not (n/= num-class-params num-type-params))
-            (&.throw Type-Parameter-Mismatch
-                     (format "Expected: " (%i (nat-to-int num-class-params)) "\n"
-                             "  Actual: " (%i (nat-to-int num-type-params)) "\n"
-                             "   Class: " class-name "\n"
-                             "    Type: " (%type type)))
-
-            ## else
-            (macro/wrap (|> params
-                            (list.zip2 (list/map (TypeVariable::getName []) class-params))
-                            (dict.from-list text.Hash<Text>)))
-            ))
-
-    _
-    (&.throw Non-JVM-Type (%type type))))
-
-(def: (cast direction to from)
-  (-> Direction Type Type (Meta [Text Type]))
-  (do macro.Monad<Meta>
-    [to-name (check-jvm to)
-     from-name (check-jvm from)]
-    (cond (dict.contains? to-name boxes)
-          (let [box (maybe.assume (dict.get to-name boxes))]
-            (if (text/= box from-name)
-              (wrap [(choose direction to-name from-name) (#.Primitive to-name (list))])
-              (&.throw Cannot-Cast (cannot-cast to from))))
-
-          (dict.contains? from-name boxes)
-          (let [box (maybe.assume (dict.get from-name boxes))]
-            (do @
-              [[_ castT] (cast direction to (#.Primitive box (list)))]
-              (wrap [(choose direction to-name from-name) castT])))
-
-          (text/= to-name from-name)
-          (wrap [(choose direction to-name from-name) from])
-
-          (text/= null-class from-name)
-          (wrap [(choose direction to-name from-name) to])
-
-          ## else
-          (do @
-            [to-class (load-class to-name)
-             from-class (load-class from-name)
-             _ (&.assert Cannot-Cast (cannot-cast to from)
-                         (Class::isAssignableFrom [from-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 [java-type (Class::isAssignableFrom [class] to-class)])))
-                                         (list& (Class::getGenericSuperclass [] from-class)
-                                                (array.to-list (Class::getGenericInterfaces [] from-class))))]
-            (case (|> candiate-parents
-                      (list.filter product.right)
-                      (list/map product.left))
-              (#.Cons parent _)
-              (do @
-                [mapping (correspond-type-params from-class from)
-                 parentT (java-type-to-lux-type mapping parent)
-                 [_ castT] (cast direction to parentT)]
-                (wrap [(choose direction to-name from-name) castT]))
-
-              #.Nil
-              (&.throw Cannot-Cast (cannot-cast to from)))))))
-
-(def: (infer-out outputT)
-  (-> Type (Meta [Text Type]))
-  (do macro.Monad<Meta>
-    [expectedT macro.expected-type
-     [unboxed castT] (cast #Out expectedT outputT)
-     _ (&.with-type-env
-         (tc.check expectedT castT))]
-    (wrap [unboxed castT])))
-
-(def: (find-field class-name field-name)
-  (-> Text Text (Meta [(Class Object) Field]))
-  (do macro.Monad<Meta>
-    [class (load-class class-name)]
-    (case (Class::getDeclaredField [field-name] class)
-      (#e.Success field)
-      (let [owner (Field::getDeclaringClass [] field)]
-        (if (is owner class)
-          (wrap [class field])
-          (&.throw Mistaken-Field-Owner
-                   (format "       Field: " field-name "\n"
-                           " Owner Class: " (Class::getName [] owner) "\n"
-                           "Target Class: " class-name "\n"))))
-
-      (#e.Error _)
-      (&.throw Unknown-Field (format class-name "#" field-name)))))
-
-(def: (static-field class-name field-name)
-  (-> Text Text (Meta [Type Bool]))
-  (do macro.Monad<Meta>
-    [[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-Static-Field (format class-name "#" field-name)))))
-
-(def: (virtual-field class-name field-name objectT)
-  (-> Text Text Type (Meta [Type Bool]))
-  (do macro.Monad<Meta>
-    [[class fieldJ] (find-field class-name field-name)
-     #let [modifiers (Field::getModifiers [] fieldJ)]]
-    (if (not (Modifier::isStatic [modifiers]))
-      (do @
-        [#let [fieldJT (Field::getGenericType [] fieldJ)
-               var-names (|> class
-                             (Class::getTypeParameters [])
-                             array.to-list
-                             (list/map (TypeVariable::getName [])))]
-         mappings (: (Meta Mappings)
-                     (case objectT
-                       (#.Primitive _class-name _class-params)
-                       (do @
-                         [#let [num-params (list.size _class-params)
-                                num-vars (list.size var-names)]
-                          _ (&.assert Type-Parameter-Mismatch
-                                      (format "Expected: " (%i (nat-to-int num-params)) "\n"
-                                              "  Actual: " (%i (nat-to-int num-vars)) "\n"
-                                              "   Class: " _class-name "\n"
-                                              "    Type: " (%type objectT))
-                                      (n/= num-params num-vars))]
-                         (wrap (|> (list.zip2 var-names _class-params)
-                                   (dict.from-list text.Hash<Text>))))
-
-                       _
-                       (&.throw Non-Object (%type objectT))))
-         fieldT (java-type-to-lux-type mappings fieldJT)]
-        (wrap [fieldT (Modifier::isFinal [modifiers])]))
-      (&.throw Not-Virtual-Field (format class-name "#" field-name)))))
-
-(def: (analyse-object class analyse sourceC)
-  (-> Text &.Analyser Code (Meta [Type la.Analysis]))
-  (do macro.Monad<Meta>
-    [target-class (load-class class)
-     targetT (java-type-to-lux-type fresh-mappings
-                                    (:! java/lang/reflect/Type
-                                        target-class))
-     [sourceT sourceA] (&common.with-unknown-type
-                         (analyse sourceC))
-     [unboxed castT] (cast #Out targetT sourceT)
-     _ (&.assert Cannot-Cast (cannot-cast targetT sourceT)
-                 (not (dict.contains? unboxed boxes)))]
-    (wrap [castT sourceA])))
-
-(def: (analyse-input analyse targetT sourceC)
-  (-> &.Analyser Type Code (Meta [Type Text la.Analysis]))
-  (do macro.Monad<Meta>
-    [[sourceT sourceA] (&common.with-unknown-type
-                         (analyse sourceC))
-     [unboxed castT] (cast #In targetT sourceT)]
-    (wrap [castT unboxed sourceA])))
-
-(def: (static-get proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC fieldC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do macro.Monad<Meta>
-          [[fieldT final?] (static-field class field)
-           [unboxed castT] (infer-out fieldT)]
-          (wrap (la.procedure proc (list (code.text class) (code.text field)
-                                         (code.text unboxed)))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
-
-(def: (static-put proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC fieldC valueC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do macro.Monad<Meta>
-          [_ (&.infer Unit)
-           [fieldT final?] (static-field class field)
-           _ (&.assert Cannot-Set-Final-Field (format class "#" field)
-                       (not final?))
-           [valueT unboxed valueA] (analyse-input analyse fieldT valueC)
-           _ (&.with-type-env
-               (tc.check fieldT valueT))]
-          (wrap (la.procedure proc (list (code.text class) (code.text field)
-                                         (code.text unboxed) valueA))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
-
-(def: (virtual-get proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC fieldC objectC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do macro.Monad<Meta>
-          [[objectT objectA] (analyse-object class analyse objectC)
-           [fieldT final?] (virtual-field class field objectT)
-           [unboxed castT] (infer-out fieldT)]
-          (wrap (la.procedure proc (list (code.text class) (code.text field)
-                                         (code.text unboxed) objectA))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
-
-(def: (virtual-put proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case args
-      (^ (list classC fieldC valueC objectC))
-      (case [classC fieldC]
-        [[_ (#.Text class)] [_ (#.Text field)]]
-        (do macro.Monad<Meta>
-          [[objectT objectA] (analyse-object class analyse objectC)
-           _ (&.infer objectT)
-           [fieldT final?] (virtual-field class field objectT)
-           _ (&.assert Cannot-Set-Final-Field (format class "#" field)
-                       (not final?))
-           [valueT unboxed valueA] (analyse-input analyse fieldT valueC)]
-          (wrap (la.procedure proc (list (code.text class) (code.text field) (code.text unboxed) valueA objectA))))
-
-        _
-        (&.throw Wrong-Syntax (wrong-syntax proc args)))
-
-      _
-      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +4 (list.size args))))))
-
-(def: (java-type-to-parameter type)
-  (-> java/lang/reflect/Type (Meta Text))
-  (cond (host.instance? Class type)
-        (macro/wrap (Class::getName [] (:! Class type)))
-
-        (host.instance? ParameterizedType type)
-        (java-type-to-parameter (ParameterizedType::getRawType [] (:! ParameterizedType type)))
-
-        (or (host.instance? TypeVariable type)
-            (host.instance? WildcardType type))
-        (macro/wrap "java.lang.Object")
-
-        (host.instance? GenericArrayType type)
-        (do macro.Monad<Meta>
-          [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:! GenericArrayType type)))]
-          (wrap (format componentP "[]")))
-
-        ## else
-        (&.throw Cannot-Convert-To-Parameter (type-descriptor type))))
-
-(type: Method-Type
-  #Static
-  #Abstract
-  #Virtual
-  #Special
-  #Interface)
-
-(def: (check-method class method-name method-type arg-classes method)
-  (-> (Class Object) Text Method-Type (List Text) Method (Meta Bool))
-  (do macro.Monad<Meta>
-    [parameters (|> (Method::getGenericParameterTypes [] method)
-                    array.to-list
-                    (monad.map @ java-type-to-parameter))
-     #let [modifiers (Method::getModifiers [] method)]]
-    (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method))
-               (text/= method-name (Method::getName [] method))
-               (case #Static
-                 #Special
-                 (Modifier::isStatic [modifiers])
-
-                 _
-                 true)
-               (case method-type
-                 #Special
-                 (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
-                          (Modifier::isAbstract [modifiers])))
-
-                 _
-                 true)
-               (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function [[expectedJC actualJC] prev]
-                            (and prev
-                                 (text/= expectedJC actualJC)))
-                          true
-                          (list.zip2 arg-classes parameters))))))
-
-(def: (check-constructor class arg-classes constructor)
-  (-> (Class Object) (List Text) (Constructor Object) (Meta Bool))
-  (do macro.Monad<Meta>
-    [parameters (|> (Constructor::getGenericParameterTypes [] constructor)
-                    array.to-list
-                    (monad.map @ java-type-to-parameter))]
-    (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
-               (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function [[expectedJC actualJC] prev]
-                            (and prev
-                                 (text/= expectedJC actualJC)))
-                          true
-                          (list.zip2 arg-classes parameters))))))
-
-(def: idx-to-bound
-  (-> Nat Type)
-  (|>> (n/* +2) n/inc #.Bound))
-
-(def: (type-vars amount offset)
-  (-> Nat Nat (List Type))
-  (if (n/= +0 amount)
-    (list)
-    (|> (list.n/range offset (|> amount n/dec (n/+ offset)))
-        (list/map idx-to-bound))))
-
-(def: (method-to-type method-type method)
-  (-> Method-Type Method (Meta [Type (List Type)]))
-  (let [owner (Method::getDeclaringClass [] method)
-        owner-name (Class::getName [] owner)
-        owner-tvars (case method-type
-                      #Static
-                      (list)
-
-                      _
-                      (|> (Class::getTypeParameters [] owner)
-                          array.to-list
-                          (list/map (TypeVariable::getName []))))
-        method-tvars (|> (Method::getTypeParameters [] method)
-                         array.to-list
-                         (list/map (TypeVariable::getName [])))
-        num-owner-tvars (list.size owner-tvars)
-        num-method-tvars (list.size method-tvars)
-        all-tvars (list/compose owner-tvars method-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars +0)
-        method-tvarsT (type-vars num-method-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list/compose owner-tvarsT method-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dict.from-list text.Hash<Text>))))]
-    (do macro.Monad<Meta>
-      [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-type
-                                          #Static
-                                          inputsT
-
-                                          _
-                                          (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
-                                                 inputsT)))
-                         outputT)]]
-      (wrap [methodT exceptionsT]))))
-
-(def: (methods class-name method-name method-type arg-classes)
-  (-> Text Text Method-Type (List Text) (Meta [Type (List Type)]))
-  (do macro.Monad<Meta>
-    [class (load-class class-name)
-     candidates (|> class
-                    (Class::getDeclaredMethods [])
-                    array.to-list
-                    (monad.map @ (function [method]
-                                   (do @
-                                     [passes? (check-method class method-name method-type arg-classes method)]
-                                     (wrap [passes? method])))))]
-    (case (list.filter product.left candidates)
-      #.Nil
-      (&.throw No-Candidates (format class-name "#" method-name))
-      
-      (#.Cons candidate #.Nil)
-      (|> candidate product.right (method-to-type method-type))
-
-      _
-      (&.throw Too-Many-Candidates (format class-name "#" method-name)))))
-
-(def: (constructor-to-type constructor)
-  (-> (Constructor Object) (Meta [Type (List Type)]))
-  (let [owner (Constructor::getDeclaringClass [] constructor)
-        owner-name (Class::getName [] owner)
-        owner-tvars (|> (Class::getTypeParameters [] owner)
-                        array.to-list
-                        (list/map (TypeVariable::getName [])))
-        constructor-tvars (|> (Constructor::getTypeParameters [] constructor)
-                              array.to-list
-                              (list/map (TypeVariable::getName [])))
-        num-owner-tvars (list.size owner-tvars)
-        all-tvars (list/compose owner-tvars constructor-tvars)
-        num-all-tvars (list.size all-tvars)
-        owner-tvarsT (type-vars num-owner-tvars +0)
-        constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
-        mappings (: Mappings
-                    (if (list.empty? all-tvars)
-                      fresh-mappings
-                      (|> (list/compose owner-tvarsT constructor-tvarsT)
-                          list.reverse
-                          (list.zip2 all-tvars)
-                          (dict.from-list text.Hash<Text>))))]
-    (do macro.Monad<Meta>
-      [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-methods class-name arg-classes)
-  (-> Text (List Text) (Meta [Type (List Type)]))
-  (do macro.Monad<Meta>
-    [class (load-class class-name)
-     candidates (|> class
-                    (Class::getConstructors [])
-                    array.to-list
-                    (monad.map @ (function [constructor]
-                                   (do @
-                                     [passes? (check-constructor class arg-classes constructor)]
-                                     (wrap [passes? constructor])))))]
-    (case (list.filter product.left candidates)
-      #.Nil
-      (&.throw No-Candidates (format class-name "(" (text.join-with ", " arg-classes) ")"))
-      
-      (#.Cons candidate #.Nil)
-      (|> candidate product.right constructor-to-type)
-
-      _
-      (&.throw Too-Many-Candidates class-name))))
-
-(def: (decorate-inputs typesT inputsA)
-  (-> (List Text) (List la.Analysis) (List la.Analysis))
-  (|> inputsA
-      (list.zip2 (list/map code.text typesT))
-      (list/map (function [[type value]]
-                  (la.product (list type value))))))
-
-(def: (sub-type-analyser analyse)
-  (-> &.Analyser &.Analyser)
-  (function [argC]
-    (do macro.Monad<Meta>
-      [[argT argA] (&common.with-unknown-type
-                     (analyse argC))
-       expectedT macro.expected-type
-       [unboxed castT] (cast #In expectedT argT)]
-      (wrap argA))))
-
-(def: (invoke//static proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case (: (e.Error [Text Text (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class method argsTC])
-      (do macro.Monad<Meta>
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (methods class method #Static argsT)
-         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
-         [unboxed castT] (infer-out outputT)]
-        (wrap (la.procedure proc (list& (code.text class) (code.text method)
-                                        (code.text unboxed) (decorate-inputs argsT argsA)))))
-
-      _
-      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
-
-(def: (invoke//virtual proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case (: (e.Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class method objectC argsTC])
-      (do macro.Monad<Meta>
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (methods class method #Virtual argsT)
-         [outputT allA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
-         #let [[objectA argsA] (case allA
-                                 (#.Cons objectA argsA)
-                                 [objectA argsA]
-
-                                 _
-                                 (undefined))]
-         [unboxed castT] (infer-out outputT)]
-        (wrap (la.procedure proc (list& (code.text class) (code.text method)
-                                        (code.text unboxed) objectA (decorate-inputs argsT argsA)))))
-
-      _
-      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
-
-(def: (invoke//special proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]])
-             (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
-      (#e.Success [_ [class method objectC argsTC _]])
-      (do macro.Monad<Meta>
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (methods class method #Special argsT)
-         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
-         [unboxed castT] (infer-out outputT)]
-        (wrap (la.procedure proc (list& (code.text class) (code.text method)
-                                        (code.text unboxed) (decorate-inputs argsT argsA)))))
-
-      _
-      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
-
-(def: (invoke//interface proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case (: (e.Error [Text Text Code (List [Text Code])])
-             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class-name method objectC argsTC])
-      (do macro.Monad<Meta>
-        [#let [argsT (list/map product.left argsTC)]
-         class (load-class class-name)
-         _ (&.assert Non-Interface class-name
-                     (Modifier::isInterface [(Class::getModifiers [] class)]))
-         [methodT exceptionsT] (methods class-name method #Interface argsT)
-         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
-         [unboxed castT] (infer-out outputT)]
-        (wrap (la.procedure proc
-                            (list& (code.text class-name) (code.text method) (code.text unboxed)
-                                   (decorate-inputs argsT argsA)))))
-
-      _
-      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
-
-(def: (invoke//constructor proc)
-  (-> Text @.Proc)
-  (function [analyse eval args]
-    (case (: (e.Error [Text (List [Text Code])])
-             (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
-      (#e.Success [class argsTC])
-      (do macro.Monad<Meta>
-        [#let [argsT (list/map product.left argsTC)]
-         [methodT exceptionsT] (constructor-methods class argsT)
-         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
-         [unboxed castT] (infer-out outputT)]
-        (wrap (la.procedure proc (list& (code.text class) (decorate-inputs argsT argsA)))))
-
-      _
-      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
-
-(def: member-procs
-  @.Bundle
-  (<| (@.prefix "member")
-      (|> (dict.new text.Hash<Text>)
-          (dict.merge (<| (@.prefix "static")
-                          (|> (dict.new text.Hash<Text>)
-                              (@.install "get" static-get)
-                              (@.install "put" static-put))))
-          (dict.merge (<| (@.prefix "virtual")
-                          (|> (dict.new text.Hash<Text>)
-                              (@.install "get" virtual-get)
-                              (@.install "put" virtual-put))))
-          (dict.merge (<| (@.prefix "invoke")
-                          (|> (dict.new text.Hash<Text>)
-                              (@.install "static" invoke//static)
-                              (@.install "virtual" invoke//virtual)
-                              (@.install "special" invoke//special)
-                              (@.install "interface" invoke//interface)
-                              (@.install "constructor" invoke//constructor)
-                              )))
-          )))
-
-(def: #export procedures
-  @.Bundle
-  (<| (@.prefix "jvm")
-      (|> (dict.new text.Hash<Text>)
-          (dict.merge conversion-procs)
-          (dict.merge int-procs)
-          (dict.merge long-procs)
-          (dict.merge float-procs)
-          (dict.merge double-procs)
-          (dict.merge char-procs)
-          (dict.merge array-procs)
-          (dict.merge object-procs)
-          (dict.merge member-procs)
-          )))
diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux
index d38d564fb..248bfbb71 100644
--- a/new-luxc/source/luxc/lang/extension.lux
+++ b/new-luxc/source/luxc/lang/extension.lux
@@ -18,16 +18,24 @@
 (exception: #export Cannot-Define-Translation-More-Than-Once)
 (exception: #export Cannot-Define-Statement-More-Than-Once)
 
-(type: #export Expression
+(type: #export Analysis
+  (-> (-> Code (Meta Code))
+      (-> Type Code (Meta Top))
+      (List Code) (Meta Code)))
+
+(type: #export Synthesis
+  (-> (List Code) (Meta Code)))
+
+(type: #export Translation
   (-> (List Code) (Meta Code)))
 
 (type: #export Statement
   (-> (List Code) (Meta Unit)))
 
 (type: #export Extensions
-  {#analysis (Dict Text Expression)
-   #synthesis (Dict Text Expression)
-   #translation (Dict Text Expression)
+  {#analysis (Dict Text Analysis)
+   #synthesis (Dict Text Synthesis)
+   #translation (Dict Text Translation)
    #statement (Dict Text Statement)})
 
 (def: #export fresh
@@ -61,10 +69,10 @@
          #.None
          (//.throw <exception> name))))]
 
-  [find-analysis    Expression #analysis    Unknown-Analysis]
-  [find-synthesis   Expression #synthesis   Unknown-Synthesis]
-  [find-translation Expression #translation Unknown-Translation]
-  [find-statement   Statement  #statement   Unknown-Statement]
+  [find-analysis    Analysis    #analysis    Unknown-Analysis]
+  [find-synthesis   Synthesis   #synthesis   Unknown-Synthesis]
+  [find-translation Translation #translation Unknown-Translation]
+  [find-statement   Statement   #statement   Unknown-Statement]
   )
 
 (do-template [<name> <type> <category> <exception>]
@@ -77,8 +85,8 @@
         _ (..set (update@ <category> (dict.put name extension) extensions))]
        (wrap [])))]
 
-  [install-analysis    Expression #analysis    Cannot-Define-Analysis-More-Than-Once]
-  [install-synthesis   Expression #synthesis   Cannot-Define-Synthesis-More-Than-Once]
-  [install-translation Expression #translation Cannot-Define-Translation-More-Than-Once]
-  [install-statement   Statement  #statement   Cannot-Define-Statement-More-Than-Once]
+  [install-analysis    Analysis    #analysis    Cannot-Define-Analysis-More-Than-Once]
+  [install-synthesis   Synthesis   #synthesis   Cannot-Define-Synthesis-More-Than-Once]
+  [install-translation Translation #translation Cannot-Define-Translation-More-Than-Once]
+  [install-statement   Statement   #statement   Cannot-Define-Statement-More-Than-Once]
   )
diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux
index d034f2919..30f43acef 100644
--- a/new-luxc/source/luxc/lang/extension/analysis.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis.lux
@@ -1,9 +1,19 @@
 (.module:
   lux
   (lux (data [text]
-             (coll [dict #+ Dict])))
-  [//])
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict])))
+  [//]
+  [/common]
+  [/host])
+
+(def: realize
+  (-> /common.Bundle (Dict Text //.Analysis))
+  (|>> dict.entries
+       (list/map (function [[name proc]] [name (proc name)]))
+       (dict.from-list text.Hash<Text>)))
 
 (def: #export defaults
-  (Dict Text //.Expression)
-  (dict.new text.Hash<Text>))
+  (Dict Text //.Analysis)
+  (realize (dict.merge /common.procedures
+                       /host.procedures)))
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
new file mode 100644
index 000000000..079001b26
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -0,0 +1,419 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (concurrency [atom #+ Atom])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [array]
+                   [dict #+ Dict]))
+       [macro]
+       (macro [code])
+       (lang (type ["tc" check]))
+       [io])
+  (luxc ["&" lang]
+        (lang ["la" analysis]
+              (analysis ["&." common]
+                        [".A" function]
+                        [".A" case]
+                        [".A" type])))
+  [///])
+
+(exception: #export Incorrect-Procedure-Arity)
+(exception: #export Invalid-Syntax)
+
+## [Utils]
+(type: #export Bundle
+  (Dict Text (-> Text ///.Analysis)))
+
+(def: #export (install name unnamed)
+  (-> Text (-> Text ///.Analysis)
+      (-> Bundle Bundle))
+  (dict.put name unnamed))
+
+(def: #export (prefix prefix bundle)
+  (-> Text Bundle Bundle)
+  (|> bundle
+      dict.entries
+      (list/map (function [[key val]] [(format prefix " " key) val]))
+      (dict.from-list text.Hash<Text>)))
+
+(def: #export (wrong-arity proc expected actual)
+  (-> Text Nat Nat Text)
+  (format "      Procedure: " (%t proc) "\n"
+          " Expected Arity: " (|> expected nat-to-int %i) "\n"
+          "   Actual Arity: " (|> actual nat-to-int %i)))
+
+(def: (simple proc inputsT+ outputT)
+  (-> Text (List Type) Type ///.Analysis)
+  (let [num-expected (list.size inputsT+)]
+    (function [analyse eval args]
+      (let [num-actual (list.size args)]
+        (if (n/= num-expected num-actual)
+          (do macro.Monad<Meta>
+            [_ (&.infer outputT)
+             argsA (monad.map @
+                              (function [[argT argC]]
+                                (&.with-type argT
+                                  (analyse argC)))
+                              (list.zip2 inputsT+ args))]
+            (wrap (la.procedure proc argsA)))
+          (&.throw Incorrect-Procedure-Arity (wrong-arity proc num-expected num-actual)))))))
+
+(def: #export (nullary valueT proc)
+  (-> Type Text ///.Analysis)
+  (simple proc (list) valueT))
+
+(def: #export (unary inputT outputT proc)
+  (-> Type Type Text ///.Analysis)
+  (simple proc (list inputT) outputT))
+
+(def: #export (binary subjectT paramT outputT proc)
+  (-> Type Type Type Text ///.Analysis)
+  (simple proc (list subjectT paramT) outputT))
+
+(def: #export (trinary subjectT param0T param1T outputT proc)
+  (-> Type Type Type Type Text ///.Analysis)
+  (simple proc (list subjectT param0T param1T) outputT))
+
+## [Analysers]
+## "lux is" represents reference/pointer equality.
+(def: (lux//is proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((binary varT varT Bool proc)
+       analyse eval args))))
+
+## "lux try" provides a simple way to interact with the host platform's
+## error-handling facilities.
+(def: (lux//try proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list opC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (&.with-type-env tc.var)
+         _ (&.infer (type (Either Text varT)))
+         opA (&.with-type (type (io.IO varT))
+               (analyse opC))]
+        (wrap (la.procedure proc (list opA))))
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
+
+(def: (lux//function proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list [_ (#.Symbol ["" func-name])]
+               [_ (#.Symbol ["" arg-name])]
+               body))
+      (functionA.analyse-function analyse func-name arg-name body)
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +3 (list.size args))))))
+
+(def: (lux//case proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list input [_ (#.Record branches)]))
+      (caseA.analyse-case analyse input branches)
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))
+
+(def: (lux//in-module proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval argsC+]
+    (case argsC+
+      (^ (list [_ (#.Text module-name)] exprC))
+      (&.with-current-module module-name
+        (analyse exprC))
+      
+      _
+      (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
+                                      "   Inputs:" (|> argsC+
+                                                       list.enumerate
+                                                       (list/map (function [[idx argC]]
+                                                                   (format "\n  " (%n idx) " " (%code argC))))
+                                                       (text.join-with "")) "\n")))))
+
+(do-template [<name> <analyser>]
+  [(def: (<name> proc)
+     (-> Text ///.Analysis)
+     (function [analyse eval args]
+       (case args
+         (^ (list typeC valueC))
+         (<analyser> analyse eval typeC valueC)
+         
+         _
+         (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args))))))]
+
+  [lux//check typeA.analyse-check]
+  [lux//coerce typeA.analyse-coerce])
+
+(def: (lux//check//type proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list valueC))
+      (do macro.Monad<Meta>
+        [_ (&.infer (type Type))
+         valueA (&.with-type Type
+                  (analyse valueC))]
+        (wrap valueA))
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
+
+(def: lux-procs
+  Bundle
+  (|> (dict.new text.Hash<Text>)
+      (install "is" lux//is)
+      (install "try" lux//try)
+      (install "function" lux//function)
+      (install "case" lux//case)
+      (install "check" lux//check)
+      (install "coerce" lux//coerce)
+      (install "check type" lux//check//type)
+      (install "in-module" lux//in-module)))
+
+(def: io-procs
+  Bundle
+  (<| (prefix "io")
+      (|> (dict.new text.Hash<Text>)
+          (install "log" (unary Text Unit))
+          (install "error" (unary Text Bottom))
+          (install "exit" (unary Int Bottom))
+          (install "current-time" (nullary Int)))))
+
+(def: bit-procs
+  Bundle
+  (<| (prefix "bit")
+      (|> (dict.new text.Hash<Text>)
+          (install "count" (unary Nat Nat))
+          (install "and" (binary Nat Nat Nat))
+          (install "or" (binary Nat Nat Nat))
+          (install "xor" (binary Nat Nat Nat))
+          (install "shift-left" (binary Nat Nat Nat))
+          (install "unsigned-shift-right" (binary Nat Nat Nat))
+          (install "shift-right" (binary Int Nat Int))
+          )))
+
+(def: nat-procs
+  Bundle
+  (<| (prefix "nat")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary Nat Nat Nat))
+          (install "-" (binary Nat Nat Nat))
+          (install "*" (binary Nat Nat Nat))
+          (install "/" (binary Nat Nat Nat))
+          (install "%" (binary Nat Nat Nat))
+          (install "=" (binary Nat Nat Bool))
+          (install "<" (binary Nat Nat Bool))
+          (install "min" (nullary Nat))
+          (install "max" (nullary Nat))
+          (install "to-int" (unary Nat Int))
+          (install "char" (unary Nat Text)))))
+
+(def: int-procs
+  Bundle
+  (<| (prefix "int")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary Int Int Int))
+          (install "-" (binary Int Int Int))
+          (install "*" (binary Int Int Int))
+          (install "/" (binary Int Int Int))
+          (install "%" (binary Int Int Int))
+          (install "=" (binary Int Int Bool))
+          (install "<" (binary Int Int Bool))
+          (install "min" (nullary Int))
+          (install "max" (nullary Int))
+          (install "to-nat" (unary Int Nat))
+          (install "to-frac" (unary Int Frac)))))
+
+(def: deg-procs
+  Bundle
+  (<| (prefix "deg")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary Deg Deg Deg))
+          (install "-" (binary Deg Deg Deg))
+          (install "*" (binary Deg Deg Deg))
+          (install "/" (binary Deg Deg Deg))
+          (install "%" (binary Deg Deg Deg))
+          (install "=" (binary Deg Deg Bool))
+          (install "<" (binary Deg Deg Bool))
+          (install "scale" (binary Deg Nat Deg))
+          (install "reciprocal" (binary Deg Nat Deg))
+          (install "min" (nullary Deg))
+          (install "max" (nullary Deg))
+          (install "to-frac" (unary Deg Frac)))))
+
+(def: frac-procs
+  Bundle
+  (<| (prefix "frac")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary Frac Frac Frac))
+          (install "-" (binary Frac Frac Frac))
+          (install "*" (binary Frac Frac Frac))
+          (install "/" (binary Frac Frac Frac))
+          (install "%" (binary Frac Frac Frac))
+          (install "=" (binary Frac Frac Bool))
+          (install "<" (binary Frac Frac Bool))
+          (install "smallest" (nullary Frac))
+          (install "min" (nullary Frac))
+          (install "max" (nullary Frac))
+          (install "not-a-number" (nullary Frac))
+          (install "positive-infinity" (nullary Frac))
+          (install "negative-infinity" (nullary Frac))
+          (install "to-deg" (unary Frac Deg))
+          (install "to-int" (unary Frac Int))
+          (install "encode" (unary Frac Text))
+          (install "decode" (unary Text (type (Maybe Frac)))))))
+
+(def: text-procs
+  Bundle
+  (<| (prefix "text")
+      (|> (dict.new text.Hash<Text>)
+          (install "=" (binary Text Text Bool))
+          (install "<" (binary Text Text Bool))
+          (install "concat" (binary Text Text Text))
+          (install "index" (trinary Text Text Nat (type (Maybe Nat))))
+          (install "size" (unary Text Nat))
+          (install "hash" (unary Text Nat))
+          (install "replace-once" (trinary Text Text Text Text))
+          (install "replace-all" (trinary Text Text Text Text))
+          (install "char" (binary Text Nat (type (Maybe Nat))))
+          (install "clip" (trinary Text Nat Nat (type (Maybe Text))))
+          (install "upper" (unary Text Text))
+          (install "lower" (unary Text Text))
+          )))
+
+(def: (array//get proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((binary (type (Array varT)) Nat (type (Maybe varT)) proc)
+       analyse eval args))))
+
+(def: (array//put proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc)
+       analyse eval args))))
+
+(def: (array//remove proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((binary (type (Array varT)) Nat (type (Array varT)) proc)
+       analyse eval args))))
+
+(def: array-procs
+  Bundle
+  (<| (prefix "array")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" (unary Nat Array))
+          (install "get" array//get)
+          (install "put" array//put)
+          (install "remove" array//remove)
+          (install "size" (unary (type (Ex [a] (Array a))) Nat))
+          )))
+
+(def: math-procs
+  Bundle
+  (<| (prefix "math")
+      (|> (dict.new text.Hash<Text>)
+          (install "cos" (unary Frac Frac))
+          (install "sin" (unary Frac Frac))
+          (install "tan" (unary Frac Frac))
+          (install "acos" (unary Frac Frac))
+          (install "asin" (unary Frac Frac))
+          (install "atan" (unary Frac Frac))
+          (install "cosh" (unary Frac Frac))
+          (install "sinh" (unary Frac Frac))
+          (install "tanh" (unary Frac Frac))
+          (install "exp" (unary Frac Frac))
+          (install "log" (unary Frac Frac))
+          (install "root2" (unary Frac Frac))
+          (install "root3" (unary Frac Frac))
+          (install "ceil" (unary Frac Frac))
+          (install "floor" (unary Frac Frac))
+          (install "round" (unary Frac Frac))
+          (install "atan2" (binary Frac Frac Frac))
+          (install "pow" (binary Frac Frac Frac))
+          )))
+
+(def: (atom-new proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list initC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (&.with-type-env tc.var)
+         _ (&.infer (type (Atom varT)))
+         initA (&.with-type varT
+                 (analyse initC))]
+        (wrap (la.procedure proc (list initA))))
+      
+      _
+      (&.throw Incorrect-Procedure-Arity (wrong-arity proc +1 (list.size args))))))
+
+(def: (atom-read proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((unary (type (Atom varT)) varT proc)
+       analyse eval args))))
+
+(def: (atom//compare-and-swap proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (do macro.Monad<Meta>
+      [[var-id varT] (&.with-type-env tc.var)]
+      ((trinary (type (Atom varT)) varT varT Bool proc)
+       analyse eval args))))
+
+(def: atom-procs
+  Bundle
+  (<| (prefix "atom")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" atom-new)
+          (install "read" atom-read)
+          (install "compare-and-swap" atom//compare-and-swap)
+          )))
+
+(def: process-procs
+  Bundle
+  (<| (prefix "process")
+      (|> (dict.new text.Hash<Text>)
+          (install "concurrency-level" (nullary Nat))
+          (install "future" (unary (type (io.IO Top)) Unit))
+          (install "schedule" (binary Nat (type (io.IO Top)) Unit))
+          )))
+
+(def: #export procedures
+  Bundle
+  (<| (prefix "lux")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge lux-procs)
+          (dict.merge bit-procs)
+          (dict.merge nat-procs)
+          (dict.merge int-procs)
+          (dict.merge deg-procs)
+          (dict.merge frac-procs)
+          (dict.merge text-procs)
+          (dict.merge array-procs)
+          (dict.merge math-procs)
+          (dict.merge atom-procs)
+          (dict.merge process-procs)
+          (dict.merge io-procs))))
diff --git a/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
new file mode 100644
index 000000000..dba0e3e66
--- /dev/null
+++ b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
@@ -0,0 +1,1243 @@
+(.module:
+  [lux #- char]
+  (lux (control [monad #+ do]
+                ["p" parser]
+                ["ex" exception #+ exception:])
+       (concurrency ["A" atom])
+       (data ["e" error]
+             [maybe]
+             [product]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
+             (text format
+                   ["l" lexer])
+             (coll [list "list/" Fold<List> Functor<List> Monoid<List>]
+                   [array]
+                   [dict #+ Dict]))
+       [macro "macro/" Monad<Meta>]
+       (macro [code]
+              ["s" syntax])
+       (lang [type]
+             (type ["tc" check]))
+       [host])
+  (luxc ["&" lang]
+        (lang ["&." host]
+              ["la" analysis]
+              (analysis ["&." common]
+                        [".A" inference])))
+  ["@" //common]
+  [///]
+  )
+
+(exception: #export Wrong-Syntax)
+(def: (wrong-syntax procedure args)
+  (-> Text (List Code) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code.tuple args))))
+
+(exception: #export JVM-Type-Is-Not-Class)
+
+(exception: #export Non-Interface)
+(exception: #export Non-Object)
+(exception: #export Non-Array)
+(exception: #export Non-Throwable)
+(exception: #export Non-JVM-Type)
+
+(exception: #export Unknown-Class)
+(exception: #export Primitives-Cannot-Have-Type-Parameters)
+(exception: #export Primitives-Are-Not-Objects)
+(exception: #export Invalid-Type-For-Array-Element)
+
+(exception: #export Unknown-Field)
+(exception: #export Mistaken-Field-Owner)
+(exception: #export Not-Virtual-Field)
+(exception: #export Not-Static-Field)
+(exception: #export Cannot-Set-Final-Field)
+
+(exception: #export No-Candidates)
+(exception: #export Too-Many-Candidates)
+
+(exception: #export Cannot-Cast)
+(def: (cannot-cast to from)
+  (-> Type Type Text)
+  (format "From: " (%type from) "\n"
+          "  To: " (%type to)))
+
+(exception: #export Cannot-Possibly-Be-Instance)
+
+(exception: #export Cannot-Convert-To-Class)
+(exception: #export Cannot-Convert-To-Parameter)
+(exception: #export Cannot-Convert-To-Lux-Type)
+(exception: #export Unknown-Type-Var)
+(exception: #export Type-Parameter-Mismatch)
+(exception: #export Cannot-Correspond-Type-With-Class)
+
+(def: #export null-class Text "#Null")
+
+(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: conversion-procs
+  @.Bundle
+  (<| (@.prefix "convert")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "double-to-float" (@.unary Double Float))
+          (@.install "double-to-int" (@.unary Double Integer))
+          (@.install "double-to-long" (@.unary Double Long))
+          (@.install "float-to-double" (@.unary Float Double))
+          (@.install "float-to-int" (@.unary Float Integer))
+          (@.install "float-to-long" (@.unary Float Long))
+          (@.install "int-to-byte" (@.unary Integer Byte))
+          (@.install "int-to-char" (@.unary Integer Character))
+          (@.install "int-to-double" (@.unary Integer Double))
+          (@.install "int-to-float" (@.unary Integer Float))
+          (@.install "int-to-long" (@.unary Integer Long))
+          (@.install "int-to-short" (@.unary Integer Short))
+          (@.install "long-to-double" (@.unary Long Double))
+          (@.install "long-to-float" (@.unary Long Float))
+          (@.install "long-to-int" (@.unary Long Integer))
+          (@.install "long-to-short" (@.unary Long Short))
+          (@.install "long-to-byte" (@.unary Long Byte))
+          (@.install "char-to-byte" (@.unary Character Byte))
+          (@.install "char-to-short" (@.unary Character Short))
+          (@.install "char-to-int" (@.unary Character Integer))
+          (@.install "char-to-long" (@.unary Character Long))
+          (@.install "byte-to-long" (@.unary Byte Long))
+          (@.install "short-to-long" (@.unary Short Long))
+          )))
+
+(do-template [<name> <prefix> <type>]
+  [(def: <name>
+     @.Bundle
+     (<| (@.prefix <prefix>)
+         (|> (dict.new text.Hash<Text>)
+             (@.install "+" (@.binary <type> <type> <type>))
+             (@.install "-" (@.binary <type> <type> <type>))
+             (@.install "*" (@.binary <type> <type> <type>))
+             (@.install "/" (@.binary <type> <type> <type>))
+             (@.install "%" (@.binary <type> <type> <type>))
+             (@.install "=" (@.binary <type> <type> Boolean))
+             (@.install "<" (@.binary <type> <type> Boolean))
+             (@.install "and" (@.binary <type> <type> <type>))
+             (@.install "or" (@.binary <type> <type> <type>))
+             (@.install "xor" (@.binary <type> <type> <type>))
+             (@.install "shl" (@.binary <type> Integer <type>))
+             (@.install "shr" (@.binary <type> Integer <type>))
+             (@.install "ushr" (@.binary <type> Integer <type>))
+             )))]
+
+  [int-procs  "int"  Integer]
+  [long-procs "long" Long]
+  )
+
+(do-template [<name> <prefix> <type>]
+  [(def: <name>
+     @.Bundle
+     (<| (@.prefix <prefix>)
+         (|> (dict.new text.Hash<Text>)
+             (@.install "+" (@.binary <type> <type> <type>))
+             (@.install "-" (@.binary <type> <type> <type>))
+             (@.install "*" (@.binary <type> <type> <type>))
+             (@.install "/" (@.binary <type> <type> <type>))
+             (@.install "%" (@.binary <type> <type> <type>))
+             (@.install "=" (@.binary <type> <type> Boolean))
+             (@.install "<" (@.binary <type> <type> Boolean))
+             )))]
+
+  [float-procs  "float"  Float]
+  [double-procs "double" Double]
+  )
+
+(def: char-procs
+  @.Bundle
+  (<| (@.prefix "char")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "=" (@.binary Character Character Boolean))
+          (@.install "<" (@.binary Character Character Boolean))
+          )))
+
+(def: #export boxes
+  (Dict Text Text)
+  (|> (list ["boolean" "java.lang.Boolean"]
+            ["byte" "java.lang.Byte"]
+            ["short" "java.lang.Short"]
+            ["int" "java.lang.Integer"]
+            ["long" "java.lang.Long"]
+            ["float" "java.lang.Float"]
+            ["double" "java.lang.Double"]
+            ["char" "java.lang.Character"])
+      (dict.from-list text.Hash<Text>)))
+
+(def: (array-length proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list arrayC))
+      (do macro.Monad<Meta>
+        [_ (&.infer Nat)
+         [var-id varT] (&.with-type-env tc.var)
+         arrayA (&.with-type (type (Array varT))
+                  (analyse arrayC))]
+        (wrap (la.procedure proc (list arrayA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
+
+(def: (array-new proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list lengthC))
+      (do macro.Monad<Meta>
+        [lengthA (&.with-type Nat
+                   (analyse lengthC))
+         expectedT macro.expected-type
+         [level elem-class] (: (Meta [Nat Text])
+                               (loop [analysisT expectedT
+                                      level +0]
+                                 (case analysisT
+                                   (#.Apply inputT funcT)
+                                   (case (type.apply (list inputT) funcT)
+                                     (#.Some outputT)
+                                     (recur outputT level)
+
+                                     #.None
+                                     (&.throw Non-Array (%type expectedT)))
+
+                                   (^ (#.Primitive "#Array" (list elemT)))
+                                   (recur elemT (n/inc level))
+
+                                   (#.Primitive class _)
+                                   (wrap [level class])
+                                   
+                                   _
+                                   (&.throw Non-Array (%type expectedT)))))
+         _ (if (n/> +0 level)
+             (wrap [])
+             (&.throw Non-Array (%type expectedT)))]
+        (wrap (la.procedure proc (list (code.nat (n/dec level)) (code.text elem-class) lengthA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
+
+(def: (check-jvm objectT)
+  (-> Type (Meta Text))
+  (case objectT
+    (#.Primitive name _)
+    (macro/wrap name)
+
+    (#.Named name unnamed)
+    (check-jvm unnamed)
+
+    (#.Var id)
+    (macro/wrap "java.lang.Object")
+
+    (^template [<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 (%type objectT)))
+
+    _
+    (&.throw Non-Object (%type objectT))))
+
+(def: (check-object objectT)
+  (-> Type (Meta Text))
+  (do macro.Monad<Meta>
+    [name (check-jvm objectT)]
+    (if (dict.contains? name boxes)
+      (&.throw Primitives-Are-Not-Objects name)
+      (macro/wrap name))))
+
+(def: (box-array-element-type elemT)
+  (-> Type (Meta [Type Text]))
+  (case elemT
+    (#.Primitive name #.Nil)
+    (let [boxed-name (|> (dict.get name boxes)
+                         (maybe.default name))]
+      (macro/wrap [(#.Primitive boxed-name #.Nil)
+                   boxed-name]))
+
+    (#.Primitive name _)
+    (if (dict.contains? name boxes)
+      (&.throw Primitives-Cannot-Have-Type-Parameters name)
+      (macro/wrap [elemT name]))
+
+    _
+    (&.throw Invalid-Type-For-Array-Element (%type elemT))))
+
+(def: (array-read proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list arrayC idxC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (&.with-type-env tc.var)
+         _ (&.infer varT)
+         arrayA (&.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (&.with-type-env
+                  (tc.read var-id))
+         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (&.with-type Nat
+                (analyse idxC))]
+        (wrap (la.procedure proc (list (code.text elem-class) idxA arrayA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
+
+(def: (array-write proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list arrayC idxC valueC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (&.with-type-env tc.var)
+         _ (&.infer (type (Array varT)))
+         arrayA (&.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (&.with-type-env
+                  (tc.read var-id))
+         [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (&.with-type Nat
+                (analyse idxC))
+         valueA (&.with-type valueT
+                  (analyse valueC))]
+        (wrap (la.procedure proc (list (code.text elem-class) idxA valueA arrayA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
+
+(def: array-procs
+  @.Bundle
+  (<| (@.prefix "array")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "length" array-length)
+          (@.install "new" array-new)
+          (@.install "read" array-read)
+          (@.install "write" array-write)
+          )))
+
+(def: (object-null proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list))
+      (do macro.Monad<Meta>
+        [expectedT macro.expected-type
+         _ (check-object expectedT)]
+        (wrap (la.procedure proc (list))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +0 (list.size args))))))
+
+(def: (object-null? proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list objectC))
+      (do macro.Monad<Meta>
+        [_ (&.infer Bool)
+         [objectT objectA] (&common.with-unknown-type
+                             (analyse objectC))
+         _ (check-object objectT)]
+        (wrap (la.procedure proc (list objectA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
+
+(def: (object-synchronized proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list monitorC exprC))
+      (do macro.Monad<Meta>
+        [[monitorT monitorA] (&common.with-unknown-type
+                               (analyse monitorC))
+         _ (check-object monitorT)
+         exprA (analyse exprC)]
+        (wrap (la.procedure proc (list monitorA exprA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
+
+(host.import java/lang/Object
+  (equals [Object] boolean))
+
+(host.import java/lang/ClassLoader)
+
+(host.import #long java/lang/reflect/Type
+  (getTypeName [] String))
+
+(host.import java/lang/reflect/GenericArrayType
+  (getGenericComponentType [] java/lang/reflect/Type))
+
+(host.import java/lang/reflect/ParameterizedType
+  (getRawType [] java/lang/reflect/Type)
+  (getActualTypeArguments [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/TypeVariable d)
+  (getName [] String)
+  (getBounds [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/WildcardType d)
+  (getLowerBounds [] (Array java/lang/reflect/Type))
+  (getUpperBounds [] (Array java/lang/reflect/Type)))
+
+(host.import java/lang/reflect/Modifier
+  (#static isStatic [int] boolean)
+  (#static isFinal [int] boolean)
+  (#static isInterface [int] boolean)
+  (#static isAbstract [int] boolean))
+
+(host.import java/lang/reflect/Field
+  (getDeclaringClass [] (java/lang/Class Object))
+  (getModifiers [] int)
+  (getGenericType [] java/lang/reflect/Type))
+
+(host.import java/lang/reflect/Method
+  (getName [] String)
+  (getModifiers [] int)
+  (getDeclaringClass [] (Class Object))
+  (getTypeParameters [] (Array (TypeVariable Method)))
+  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+  (getGenericReturnType [] java/lang/reflect/Type)
+  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/Constructor c)
+  (getModifiers [] int)
+  (getDeclaringClass [] (Class c))
+  (getTypeParameters [] (Array (TypeVariable (Constructor c))))
+  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/Class c)
+  (getName [] String)
+  (getModifiers [] int)
+  (#static forName [String boolean ClassLoader] #try (Class Object))
+  (isAssignableFrom [(Class Object)] boolean)
+  (getTypeParameters [] (Array (TypeVariable (Class c))))
+  (getGenericInterfaces [] (Array java/lang/reflect/Type))
+  (getGenericSuperclass [] java/lang/reflect/Type)
+  (getDeclaredField [String] #try Field)
+  (getConstructors [] (Array (Constructor Object)))
+  (getDeclaredMethods [] (Array Method)))
+
+(def: (load-class name)
+  (-> Text (Meta (Class Object)))
+  (do macro.Monad<Meta>
+    [class-loader &host.class-loader]
+    (case (Class::forName [name false class-loader])
+      (#e.Success [class])
+      (wrap class)
+
+      (#e.Error error)
+      (&.throw Unknown-Class name))))
+
+(def: (sub-class? super sub)
+  (-> Text Text (Meta Bool))
+  (do macro.Monad<Meta>
+    [super (load-class super)
+     sub (load-class sub)]
+    (wrap (Class::isAssignableFrom [sub] super))))
+
+(def: (object-throw proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list exceptionC))
+      (do macro.Monad<Meta>
+        [_ (&.infer Bottom)
+         [exceptionT exceptionA] (&common.with-unknown-type
+                                   (analyse exceptionC))
+         exception-class (check-object exceptionT)
+         ? (sub-class? "java.lang.Throwable" exception-class)
+         _ (: (Meta Unit)
+              (if ?
+                (wrap [])
+                (&.throw Non-Throwable exception-class)))]
+        (wrap (la.procedure proc (list exceptionA))))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
+
+(def: (object-class proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC))
+      (case classC
+        [_ (#.Text class)]
+        (do macro.Monad<Meta>
+          [_ (&.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
+           _ (load-class class)]
+          (wrap (la.procedure proc (list (code.text class)))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +1 (list.size args))))))
+
+(def: (object-instance? proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC objectC))
+      (case classC
+        [_ (#.Text class)]
+        (do macro.Monad<Meta>
+          [_ (&.infer Bool)
+           [objectT objectA] (&common.with-unknown-type
+                               (analyse objectC))
+           object-class (check-object objectT)
+           ? (sub-class? class object-class)]
+          (if ?
+            (wrap (la.procedure proc (list (code.text class))))
+            (&.throw Cannot-Possibly-Be-Instance (format object-class " !<= "  class))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
+
+(def: object-procs
+  @.Bundle
+  (<| (@.prefix "object")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "null" object-null)
+          (@.install "null?" object-null?)
+          (@.install "synchronized" object-synchronized)
+          (@.install "throw" object-throw)
+          (@.install "class" object-class)
+          (@.install "instance?" object-instance?)
+          )))
+
+(def: type-descriptor
+  (-> java/lang/reflect/Type Text)
+  (java/lang/reflect/Type::getTypeName []))
+
+(def: (java-type-to-class type)
+  (-> java/lang/reflect/Type (Meta Text))
+  (cond (host.instance? Class type)
+        (macro/wrap (Class::getName [] (:! Class type)))
+
+        (host.instance? ParameterizedType type)
+        (java-type-to-class (ParameterizedType::getRawType [] (:! ParameterizedType type)))
+
+        ## else
+        (&.throw Cannot-Convert-To-Class (type-descriptor type))))
+
+(type: Mappings
+  (Dict Text Type))
+
+(def: fresh-mappings Mappings (dict.new text.Hash<Text>))
+
+(def: (java-type-to-lux-type mappings java-type)
+  (-> Mappings java/lang/reflect/Type (Meta Type))
+  (cond (host.instance? TypeVariable java-type)
+        (let [var-name (TypeVariable::getName [] (:! TypeVariable java-type))]
+          (case (dict.get var-name mappings)
+            (#.Some var-type)
+            (macro/wrap var-type)
+            
+            #.None
+            (&.throw Unknown-Type-Var var-name)))
+
+        (host.instance? WildcardType java-type)
+        (let [java-type (:! WildcardType java-type)]
+          (case [(array.read +0 (WildcardType::getUpperBounds [] java-type))
+                 (array.read +0 (WildcardType::getLowerBounds [] java-type))]
+            (^or [(#.Some bound) _] [_ (#.Some bound)])
+            (java-type-to-lux-type mappings bound)
+            
+            _
+            (macro/wrap Top)))
+
+        (host.instance? Class java-type)
+        (let [java-type (:! (Class Object) java-type)
+              class-name (Class::getName [] java-type)]
+          (macro/wrap (case (array.size (Class::getTypeParameters [] java-type))
+                        +0
+                        (#.Primitive class-name (list))
+                        
+                        arity
+                        (|> (list.n/range +0 (n/dec arity))
+                            list.reverse
+                            (list/map (|>> (n/* +2) n/inc #.Bound))
+                            (#.Primitive class-name)
+                            (type.univ-q arity)))))
+
+        (host.instance? ParameterizedType java-type)
+        (let [java-type (:! ParameterizedType java-type)
+              raw (ParameterizedType::getRawType [] java-type)]
+          (if (host.instance? Class raw)
+            (do macro.Monad<Meta>
+              [paramsT (|> java-type
+                           (ParameterizedType::getActualTypeArguments [])
+                           array.to-list
+                           (monad.map @ (java-type-to-lux-type mappings)))]
+              (macro/wrap (#.Primitive (Class::getName [] (:! (Class Object) raw))
+                                       paramsT)))
+            (&.throw JVM-Type-Is-Not-Class (type-descriptor raw))))
+
+        (host.instance? GenericArrayType java-type)
+        (do macro.Monad<Meta>
+          [innerT (|> (:! GenericArrayType java-type)
+                      (GenericArrayType::getGenericComponentType [])
+                      (java-type-to-lux-type mappings))]
+          (wrap (#.Primitive "#Array" (list innerT))))
+
+        ## else
+        (&.throw Cannot-Convert-To-Lux-Type (type-descriptor java-type))))
+
+(type: Direction
+  #In
+  #Out)
+
+(def: (choose direction to from)
+  (-> Direction Text Text Text)
+  (case direction
+    #In to
+    #Out from))
+
+(def: (correspond-type-params class type)
+  (-> (Class Object) Type (Meta Mappings))
+  (case type
+    (#.Primitive name params)
+    (let [class-name (Class::getName [] class)
+          class-params (array.to-list (Class::getTypeParameters [] class))
+          num-class-params (list.size class-params)
+          num-type-params (list.size params)]
+      (cond (not (text/= class-name name))
+            (&.throw Cannot-Correspond-Type-With-Class
+                     (format "Class = " class-name "\n"
+                             "Type = " (%type type)))
+
+            (not (n/= num-class-params num-type-params))
+            (&.throw Type-Parameter-Mismatch
+                     (format "Expected: " (%i (nat-to-int num-class-params)) "\n"
+                             "  Actual: " (%i (nat-to-int num-type-params)) "\n"
+                             "   Class: " class-name "\n"
+                             "    Type: " (%type type)))
+
+            ## else
+            (macro/wrap (|> params
+                            (list.zip2 (list/map (TypeVariable::getName []) class-params))
+                            (dict.from-list text.Hash<Text>)))
+            ))
+
+    _
+    (&.throw Non-JVM-Type (%type type))))
+
+(def: (cast direction to from)
+  (-> Direction Type Type (Meta [Text Type]))
+  (do macro.Monad<Meta>
+    [to-name (check-jvm to)
+     from-name (check-jvm from)]
+    (cond (dict.contains? to-name boxes)
+          (let [box (maybe.assume (dict.get to-name boxes))]
+            (if (text/= box from-name)
+              (wrap [(choose direction to-name from-name) (#.Primitive to-name (list))])
+              (&.throw Cannot-Cast (cannot-cast to from))))
+
+          (dict.contains? from-name boxes)
+          (let [box (maybe.assume (dict.get from-name boxes))]
+            (do @
+              [[_ castT] (cast direction to (#.Primitive box (list)))]
+              (wrap [(choose direction to-name from-name) castT])))
+
+          (text/= to-name from-name)
+          (wrap [(choose direction to-name from-name) from])
+
+          (text/= null-class from-name)
+          (wrap [(choose direction to-name from-name) to])
+
+          ## else
+          (do @
+            [to-class (load-class to-name)
+             from-class (load-class from-name)
+             _ (&.assert Cannot-Cast (cannot-cast to from)
+                         (Class::isAssignableFrom [from-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 [java-type (Class::isAssignableFrom [class] to-class)])))
+                                         (list& (Class::getGenericSuperclass [] from-class)
+                                                (array.to-list (Class::getGenericInterfaces [] from-class))))]
+            (case (|> candiate-parents
+                      (list.filter product.right)
+                      (list/map product.left))
+              (#.Cons parent _)
+              (do @
+                [mapping (correspond-type-params from-class from)
+                 parentT (java-type-to-lux-type mapping parent)
+                 [_ castT] (cast direction to parentT)]
+                (wrap [(choose direction to-name from-name) castT]))
+
+              #.Nil
+              (&.throw Cannot-Cast (cannot-cast to from)))))))
+
+(def: (infer-out outputT)
+  (-> Type (Meta [Text Type]))
+  (do macro.Monad<Meta>
+    [expectedT macro.expected-type
+     [unboxed castT] (cast #Out expectedT outputT)
+     _ (&.with-type-env
+         (tc.check expectedT castT))]
+    (wrap [unboxed castT])))
+
+(def: (find-field class-name field-name)
+  (-> Text Text (Meta [(Class Object) Field]))
+  (do macro.Monad<Meta>
+    [class (load-class class-name)]
+    (case (Class::getDeclaredField [field-name] class)
+      (#e.Success field)
+      (let [owner (Field::getDeclaringClass [] field)]
+        (if (is owner class)
+          (wrap [class field])
+          (&.throw Mistaken-Field-Owner
+                   (format "       Field: " field-name "\n"
+                           " Owner Class: " (Class::getName [] owner) "\n"
+                           "Target Class: " class-name "\n"))))
+
+      (#e.Error _)
+      (&.throw Unknown-Field (format class-name "#" field-name)))))
+
+(def: (static-field class-name field-name)
+  (-> Text Text (Meta [Type Bool]))
+  (do macro.Monad<Meta>
+    [[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-Static-Field (format class-name "#" field-name)))))
+
+(def: (virtual-field class-name field-name objectT)
+  (-> Text Text Type (Meta [Type Bool]))
+  (do macro.Monad<Meta>
+    [[class fieldJ] (find-field class-name field-name)
+     #let [modifiers (Field::getModifiers [] fieldJ)]]
+    (if (not (Modifier::isStatic [modifiers]))
+      (do @
+        [#let [fieldJT (Field::getGenericType [] fieldJ)
+               var-names (|> class
+                             (Class::getTypeParameters [])
+                             array.to-list
+                             (list/map (TypeVariable::getName [])))]
+         mappings (: (Meta Mappings)
+                     (case objectT
+                       (#.Primitive _class-name _class-params)
+                       (do @
+                         [#let [num-params (list.size _class-params)
+                                num-vars (list.size var-names)]
+                          _ (&.assert Type-Parameter-Mismatch
+                                      (format "Expected: " (%i (nat-to-int num-params)) "\n"
+                                              "  Actual: " (%i (nat-to-int num-vars)) "\n"
+                                              "   Class: " _class-name "\n"
+                                              "    Type: " (%type objectT))
+                                      (n/= num-params num-vars))]
+                         (wrap (|> (list.zip2 var-names _class-params)
+                                   (dict.from-list text.Hash<Text>))))
+
+                       _
+                       (&.throw Non-Object (%type objectT))))
+         fieldT (java-type-to-lux-type mappings fieldJT)]
+        (wrap [fieldT (Modifier::isFinal [modifiers])]))
+      (&.throw Not-Virtual-Field (format class-name "#" field-name)))))
+
+(def: (analyse-object class analyse sourceC)
+  (-> Text &.Analyser Code (Meta [Type la.Analysis]))
+  (do macro.Monad<Meta>
+    [target-class (load-class class)
+     targetT (java-type-to-lux-type fresh-mappings
+                                    (:! java/lang/reflect/Type
+                                        target-class))
+     [sourceT sourceA] (&common.with-unknown-type
+                         (analyse sourceC))
+     [unboxed castT] (cast #Out targetT sourceT)
+     _ (&.assert Cannot-Cast (cannot-cast targetT sourceT)
+                 (not (dict.contains? unboxed boxes)))]
+    (wrap [castT sourceA])))
+
+(def: (analyse-input analyse targetT sourceC)
+  (-> &.Analyser Type Code (Meta [Type Text la.Analysis]))
+  (do macro.Monad<Meta>
+    [[sourceT sourceA] (&common.with-unknown-type
+                         (analyse sourceC))
+     [unboxed castT] (cast #In targetT sourceT)]
+    (wrap [castT unboxed sourceA])))
+
+(def: (static-get proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC fieldC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad<Meta>
+          [[fieldT final?] (static-field class field)
+           [unboxed castT] (infer-out fieldT)]
+          (wrap (la.procedure proc (list (code.text class) (code.text field)
+                                         (code.text unboxed)))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +2 (list.size args))))))
+
+(def: (static-put proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC fieldC valueC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad<Meta>
+          [_ (&.infer Unit)
+           [fieldT final?] (static-field class field)
+           _ (&.assert Cannot-Set-Final-Field (format class "#" field)
+                       (not final?))
+           [valueT unboxed valueA] (analyse-input analyse fieldT valueC)
+           _ (&.with-type-env
+               (tc.check fieldT valueT))]
+          (wrap (la.procedure proc (list (code.text class) (code.text field)
+                                         (code.text unboxed) valueA))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
+
+(def: (virtual-get proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC fieldC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad<Meta>
+          [[objectT objectA] (analyse-object class analyse objectC)
+           [fieldT final?] (virtual-field class field objectT)
+           [unboxed castT] (infer-out fieldT)]
+          (wrap (la.procedure proc (list (code.text class) (code.text field)
+                                         (code.text unboxed) objectA))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +3 (list.size args))))))
+
+(def: (virtual-put proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case args
+      (^ (list classC fieldC valueC objectC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad<Meta>
+          [[objectT objectA] (analyse-object class analyse objectC)
+           _ (&.infer objectT)
+           [fieldT final?] (virtual-field class field objectT)
+           _ (&.assert Cannot-Set-Final-Field (format class "#" field)
+                       (not final?))
+           [valueT unboxed valueA] (analyse-input analyse fieldT valueC)]
+          (wrap (la.procedure proc (list (code.text class) (code.text field) (code.text unboxed) valueA objectA))))
+
+        _
+        (&.throw Wrong-Syntax (wrong-syntax proc args)))
+
+      _
+      (&.throw @.Incorrect-Procedure-Arity (@.wrong-arity proc +4 (list.size args))))))
+
+(def: (java-type-to-parameter type)
+  (-> java/lang/reflect/Type (Meta Text))
+  (cond (host.instance? Class type)
+        (macro/wrap (Class::getName [] (:! Class type)))
+
+        (host.instance? ParameterizedType type)
+        (java-type-to-parameter (ParameterizedType::getRawType [] (:! ParameterizedType type)))
+
+        (or (host.instance? TypeVariable type)
+            (host.instance? WildcardType type))
+        (macro/wrap "java.lang.Object")
+
+        (host.instance? GenericArrayType type)
+        (do macro.Monad<Meta>
+          [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:! GenericArrayType type)))]
+          (wrap (format componentP "[]")))
+
+        ## else
+        (&.throw Cannot-Convert-To-Parameter (type-descriptor type))))
+
+(type: Method-Type
+  #Static
+  #Abstract
+  #Virtual
+  #Special
+  #Interface)
+
+(def: (check-method class method-name method-type arg-classes method)
+  (-> (Class Object) Text Method-Type (List Text) Method (Meta Bool))
+  (do macro.Monad<Meta>
+    [parameters (|> (Method::getGenericParameterTypes [] method)
+                    array.to-list
+                    (monad.map @ java-type-to-parameter))
+     #let [modifiers (Method::getModifiers [] method)]]
+    (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method))
+               (text/= method-name (Method::getName [] method))
+               (case #Static
+                 #Special
+                 (Modifier::isStatic [modifiers])
+
+                 _
+                 true)
+               (case method-type
+                 #Special
+                 (not (or (Modifier::isInterface [(Class::getModifiers [] class)])
+                          (Modifier::isAbstract [modifiers])))
+
+                 _
+                 true)
+               (n/= (list.size arg-classes) (list.size parameters))
+               (list/fold (function [[expectedJC actualJC] prev]
+                            (and prev
+                                 (text/= expectedJC actualJC)))
+                          true
+                          (list.zip2 arg-classes parameters))))))
+
+(def: (check-constructor class arg-classes constructor)
+  (-> (Class Object) (List Text) (Constructor Object) (Meta Bool))
+  (do macro.Monad<Meta>
+    [parameters (|> (Constructor::getGenericParameterTypes [] constructor)
+                    array.to-list
+                    (monad.map @ java-type-to-parameter))]
+    (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
+               (n/= (list.size arg-classes) (list.size parameters))
+               (list/fold (function [[expectedJC actualJC] prev]
+                            (and prev
+                                 (text/= expectedJC actualJC)))
+                          true
+                          (list.zip2 arg-classes parameters))))))
+
+(def: idx-to-bound
+  (-> Nat Type)
+  (|>> (n/* +2) n/inc #.Bound))
+
+(def: (type-vars amount offset)
+  (-> Nat Nat (List Type))
+  (if (n/= +0 amount)
+    (list)
+    (|> (list.n/range offset (|> amount n/dec (n/+ offset)))
+        (list/map idx-to-bound))))
+
+(def: (method-to-type method-type method)
+  (-> Method-Type Method (Meta [Type (List Type)]))
+  (let [owner (Method::getDeclaringClass [] method)
+        owner-name (Class::getName [] owner)
+        owner-tvars (case method-type
+                      #Static
+                      (list)
+
+                      _
+                      (|> (Class::getTypeParameters [] owner)
+                          array.to-list
+                          (list/map (TypeVariable::getName []))))
+        method-tvars (|> (Method::getTypeParameters [] method)
+                         array.to-list
+                         (list/map (TypeVariable::getName [])))
+        num-owner-tvars (list.size owner-tvars)
+        num-method-tvars (list.size method-tvars)
+        all-tvars (list/compose owner-tvars method-tvars)
+        num-all-tvars (list.size all-tvars)
+        owner-tvarsT (type-vars num-owner-tvars +0)
+        method-tvarsT (type-vars num-method-tvars num-owner-tvars)
+        mappings (: Mappings
+                    (if (list.empty? all-tvars)
+                      fresh-mappings
+                      (|> (list/compose owner-tvarsT method-tvarsT)
+                          list.reverse
+                          (list.zip2 all-tvars)
+                          (dict.from-list text.Hash<Text>))))]
+    (do macro.Monad<Meta>
+      [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-type
+                                          #Static
+                                          inputsT
+
+                                          _
+                                          (list& (#.Primitive owner-name (list.reverse owner-tvarsT))
+                                                 inputsT)))
+                         outputT)]]
+      (wrap [methodT exceptionsT]))))
+
+(def: (methods class-name method-name method-type arg-classes)
+  (-> Text Text Method-Type (List Text) (Meta [Type (List Type)]))
+  (do macro.Monad<Meta>
+    [class (load-class class-name)
+     candidates (|> class
+                    (Class::getDeclaredMethods [])
+                    array.to-list
+                    (monad.map @ (function [method]
+                                   (do @
+                                     [passes? (check-method class method-name method-type arg-classes method)]
+                                     (wrap [passes? method])))))]
+    (case (list.filter product.left candidates)
+      #.Nil
+      (&.throw No-Candidates (format class-name "#" method-name))
+      
+      (#.Cons candidate #.Nil)
+      (|> candidate product.right (method-to-type method-type))
+
+      _
+      (&.throw Too-Many-Candidates (format class-name "#" method-name)))))
+
+(def: (constructor-to-type constructor)
+  (-> (Constructor Object) (Meta [Type (List Type)]))
+  (let [owner (Constructor::getDeclaringClass [] constructor)
+        owner-name (Class::getName [] owner)
+        owner-tvars (|> (Class::getTypeParameters [] owner)
+                        array.to-list
+                        (list/map (TypeVariable::getName [])))
+        constructor-tvars (|> (Constructor::getTypeParameters [] constructor)
+                              array.to-list
+                              (list/map (TypeVariable::getName [])))
+        num-owner-tvars (list.size owner-tvars)
+        all-tvars (list/compose owner-tvars constructor-tvars)
+        num-all-tvars (list.size all-tvars)
+        owner-tvarsT (type-vars num-owner-tvars +0)
+        constructor-tvarsT (type-vars num-all-tvars num-owner-tvars)
+        mappings (: Mappings
+                    (if (list.empty? all-tvars)
+                      fresh-mappings
+                      (|> (list/compose owner-tvarsT constructor-tvarsT)
+                          list.reverse
+                          (list.zip2 all-tvars)
+                          (dict.from-list text.Hash<Text>))))]
+    (do macro.Monad<Meta>
+      [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-methods class-name arg-classes)
+  (-> Text (List Text) (Meta [Type (List Type)]))
+  (do macro.Monad<Meta>
+    [class (load-class class-name)
+     candidates (|> class
+                    (Class::getConstructors [])
+                    array.to-list
+                    (monad.map @ (function [constructor]
+                                   (do @
+                                     [passes? (check-constructor class arg-classes constructor)]
+                                     (wrap [passes? constructor])))))]
+    (case (list.filter product.left candidates)
+      #.Nil
+      (&.throw No-Candidates (format class-name "(" (text.join-with ", " arg-classes) ")"))
+      
+      (#.Cons candidate #.Nil)
+      (|> candidate product.right constructor-to-type)
+
+      _
+      (&.throw Too-Many-Candidates class-name))))
+
+(def: (decorate-inputs typesT inputsA)
+  (-> (List Text) (List la.Analysis) (List la.Analysis))
+  (|> inputsA
+      (list.zip2 (list/map code.text typesT))
+      (list/map (function [[type value]]
+                  (la.product (list type value))))))
+
+(def: (sub-type-analyser analyse)
+  (-> &.Analyser &.Analyser)
+  (function [argC]
+    (do macro.Monad<Meta>
+      [[argT argA] (&common.with-unknown-type
+                     (analyse argC))
+       expectedT macro.expected-type
+       [unboxed castT] (cast #In expectedT argT)]
+      (wrap argA))))
+
+(def: (invoke//static proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case (: (e.Error [Text Text (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class method argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Static argsT)
+         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
+         [unboxed castT] (infer-out outputT)]
+        (wrap (la.procedure proc (list& (code.text class) (code.text method)
+                                        (code.text unboxed) (decorate-inputs argsT argsA)))))
+
+      _
+      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
+
+(def: (invoke//virtual proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case (: (e.Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class method objectC argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Virtual argsT)
+         [outputT allA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
+         #let [[objectA argsA] (case allA
+                                 (#.Cons objectA argsA)
+                                 [objectA argsA]
+
+                                 _
+                                 (undefined))]
+         [unboxed castT] (infer-out outputT)]
+        (wrap (la.procedure proc (list& (code.text class) (code.text method)
+                                        (code.text unboxed) objectA (decorate-inputs argsT argsA)))))
+
+      _
+      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
+
+(def: (invoke//special proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]])
+             (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
+      (#e.Success [_ [class method objectC argsTC _]])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Special argsT)
+         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
+         [unboxed castT] (infer-out outputT)]
+        (wrap (la.procedure proc (list& (code.text class) (code.text method)
+                                        (code.text unboxed) (decorate-inputs argsT argsA)))))
+
+      _
+      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
+
+(def: (invoke//interface proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case (: (e.Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class-name method objectC argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         class (load-class class-name)
+         _ (&.assert Non-Interface class-name
+                     (Modifier::isInterface [(Class::getModifiers [] class)]))
+         [methodT exceptionsT] (methods class-name method #Interface argsT)
+         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list& objectC (list/map product.right argsTC)))
+         [unboxed castT] (infer-out outputT)]
+        (wrap (la.procedure proc
+                            (list& (code.text class-name) (code.text method) (code.text unboxed)
+                                   (decorate-inputs argsT argsA)))))
+
+      _
+      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
+
+(def: (invoke//constructor proc)
+  (-> Text ///.Analysis)
+  (function [analyse eval args]
+    (case (: (e.Error [Text (List [Text Code])])
+             (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (constructor-methods class argsT)
+         [outputT argsA] (inferenceA.general (sub-type-analyser analyse) methodT (list/map product.right argsTC))
+         [unboxed castT] (infer-out outputT)]
+        (wrap (la.procedure proc (list& (code.text class) (decorate-inputs argsT argsA)))))
+
+      _
+      (&.throw Wrong-Syntax (wrong-syntax proc args)))))
+
+(def: member-procs
+  @.Bundle
+  (<| (@.prefix "member")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge (<| (@.prefix "static")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "get" static-get)
+                              (@.install "put" static-put))))
+          (dict.merge (<| (@.prefix "virtual")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "get" virtual-get)
+                              (@.install "put" virtual-put))))
+          (dict.merge (<| (@.prefix "invoke")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "static" invoke//static)
+                              (@.install "virtual" invoke//virtual)
+                              (@.install "special" invoke//special)
+                              (@.install "interface" invoke//interface)
+                              (@.install "constructor" invoke//constructor)
+                              )))
+          )))
+
+(def: #export procedures
+  @.Bundle
+  (<| (@.prefix "jvm")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge conversion-procs)
+          (dict.merge int-procs)
+          (dict.merge long-procs)
+          (dict.merge float-procs)
+          (dict.merge double-procs)
+          (dict.merge char-procs)
+          (dict.merge array-procs)
+          (dict.merge object-procs)
+          (dict.merge member-procs)
+          )))
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
index 6e9530f38..7cb404b13 100644
--- a/new-luxc/source/luxc/lang/extension/statement.lux
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -126,10 +126,10 @@
          _
          (throw-invalid-statement procedure inputsC+))))]
 
-  [lux//analysis    //.Expression //.install-analysis]
-  [lux//synthesis   //.Expression //.install-synthesis]
-  [lux//translation //.Expression //.install-translation]
-  [lux//statement   //.Statement  //.install-statement])
+  [lux//analysis    //.Analysis    //.install-analysis]
+  [lux//synthesis   //.Synthesis   //.install-synthesis]
+  [lux//translation //.Translation //.install-translation]
+  [lux//statement   //.Statement   //.install-statement])
 
 (def: #export defaults
   (Dict Text //.Statement)
diff --git a/new-luxc/source/luxc/lang/extension/synthesis.lux b/new-luxc/source/luxc/lang/extension/synthesis.lux
index d034f2919..32d726796 100644
--- a/new-luxc/source/luxc/lang/extension/synthesis.lux
+++ b/new-luxc/source/luxc/lang/extension/synthesis.lux
@@ -5,5 +5,5 @@
   [//])
 
 (def: #export defaults
-  (Dict Text //.Expression)
+  (Dict Text //.Synthesis)
   (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/extension/translation.lux b/new-luxc/source/luxc/lang/extension/translation.lux
index d034f2919..663babdb6 100644
--- a/new-luxc/source/luxc/lang/extension/translation.lux
+++ b/new-luxc/source/luxc/lang/extension/translation.lux
@@ -5,5 +5,5 @@
   [//])
 
 (def: #export defaults
-  (Dict Text //.Expression)
+  (Dict Text //.Translation)
   (dict.new text.Hash<Text>))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
index f2f88904d..f737e81fc 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -21,7 +21,7 @@
                          ["$d" def]
                          ["$i" inst]))
               ["la" analysis]
-              (analysis (procedure ["&." host]))
+              (extension (analysis ["&." host]))
               ["ls" synthesis]))
   ["@" //common])
 
-- 
cgit v1.2.3