- Migrated special-form analysis to stdlib.

10 files changed, 2700 insertions, 21 deletions

diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux
index 0b48f803d..324f12b3e 100644
--- a/stdlib/source/lux/lang/analysis.lux
+++ b/stdlib/source/lux/lang/analysis.lux
@@ -1,5 +1,5 @@
 (.module:
-  lux
+  [lux #- nat int deg]
   (lux [function]
        (data (coll [list "list/" Fold<List>]))))
 
@@ -46,7 +46,20 @@
   (#Apply Analysis Analysis)
   (#Variable Variable)
   (#Constant Ident)
-  (#Special (Special Text)))
+  (#Special (Special Analysis)))
+
+(do-template [<name> <type> <tag>]
+  [(def: #export <name>
+     (-> <type> Analysis)
+     (|>> <tag> #Primitive))]
+
+  [bool Bool #Bool]
+  [nat  Nat  #Nat]
+  [int  Int  #Int]
+  [deg  Deg  #Deg]
+  [frac Frac #Frac]
+  [text Text #Text]
+  )
 
 (type: #export (Variant a)
   {#lefts Nat
diff --git a/stdlib/source/lux/lang/analysis/expression.lux b/stdlib/source/lux/lang/analysis/expression.lux
index da1b27a10..325394e73 100644
--- a/stdlib/source/lux/lang/analysis/expression.lux
+++ b/stdlib/source/lux/lang/analysis/expression.lux
@@ -15,8 +15,7 @@
                        [".A" structure]
                        [".A" reference])
              ## [".L" macro]
-             ## [".L" extension]
-             )))
+             [".L" extension])))
 
 (exception: #export (macro-expansion-failed {message Text})
   message)
@@ -80,10 +79,10 @@
                (#.Symbol reference)
                (referenceA.reference reference)
 
-               ## (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
-               ## (do macro.Monad<Meta>
-               ##   [procedure (extensionL.find-analysis proc-name)]
-               ##   (procedure analyse eval proc-args))
+               (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
+               (do macro.Monad<Meta>
+                 [procedure (extensionL.find-analysis proc-name)]
+                 (procedure analyse eval proc-args))
 
                ## (^ (#.Form (list& func args)))
                ## (do macro.Monad<Meta>
diff --git a/stdlib/source/lux/lang/extension.lux b/stdlib/source/lux/lang/extension.lux
new file mode 100644
index 000000000..03fd81d71
--- /dev/null
+++ b/stdlib/source/lux/lang/extension.lux
@@ -0,0 +1,113 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [text]
+             (coll (dictionary ["dict" unordered #+ Dict])))
+       [macro])
+  [// #+ Eval]
+  (// [".L" analysis #+ Analyser]
+      [".L" synthesis]))
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [unknown-analysis]
+  [unknown-synthesis]
+  [unknown-translation]
+  [unknown-statement]
+
+  [cannot-define-analysis-more-than-once]
+  [cannot-define-synthesis-more-than-once]
+  [cannot-define-translation-more-than-once]
+  [cannot-define-statement-more-than-once]
+  )
+
+(type: #export Analysis
+  (-> Analyser Eval (List Code) (Meta analysisL.Analysis)))
+
+(type: #export Synthesis
+  (-> (-> analysisL.Analysis synthesisL.Synthesis) (List Code) Code))
+
+(type: #export Translation
+  (-> (List Code) (Meta Code)))
+
+(type: #export Statement
+  (-> (List Code) (Meta Any)))
+
+(type: #export (Extension e)
+  (Dict Text e))
+
+(type: #export Extensions
+  {#analysis (Extension Analysis)
+   #synthesis (Extension Synthesis)
+   #translation (Extension Translation)
+   #statement (Extension Statement)})
+
+(def: #export fresh
+  Extensions
+  {#analysis (dict.new text.Hash<Text>)
+   #synthesis (dict.new text.Hash<Text>)
+   #translation (dict.new text.Hash<Text>)
+   #statement (dict.new text.Hash<Text>)})
+
+(def: get
+  (Meta Extensions)
+  (function (_ compiler)
+    (#e.Success [compiler
+                 (|> compiler (get@ #.extensions) (:! Extensions))])))
+
+(def: (set extensions)
+  (-> Extensions (Meta Any))
+  (function (_ compiler)
+    (#e.Success [(set@ #.extensions (:! Nothing extensions) compiler)
+                 []])))
+
+(do-template [<name> <type> <category> <exception>]
+  [(def: #export (<name> name)
+     (-> Text (Meta <type>))
+     (do macro.Monad<Meta>
+       [extensions ..get]
+       (case (dict.get name (get@ <category> extensions))
+         (#.Some extension)
+         (wrap extension)
+
+         #.None
+         (//.throw <exception> name))))]
+
+  [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 [<no> <all> <type> <category> <empty>]
+  [(def: #export <no>
+     <type>
+     <empty>)
+
+   (def: #export <all>
+     (Meta <type>)
+     (|> ..get
+         (:: macro.Monad<Meta> map (get@ <category>))))]
+
+  [no-syntheses all-syntheses (Extension Synthesis) #synthesis (dict.new text.Hash<Text>)]
+  )
+
+(do-template [<name> <type> <category> <exception>]
+  [(def: #export (<name> name extension)
+     (-> Text <type> (Meta Any))
+     (do macro.Monad<Meta>
+       [extensions ..get
+        _ (//.assert <exception> name
+                     (not (dict.contains? name (get@ <category> extensions))))
+        _ (..set (update@ <category> (dict.put name extension) extensions))]
+       (wrap [])))]
+
+  [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/stdlib/source/lux/lang/extension/analysis.lux b/stdlib/source/lux/lang/extension/analysis.lux
new file mode 100644
index 000000000..40fd84679
--- /dev/null
+++ b/stdlib/source/lux/lang/extension/analysis.lux
@@ -0,0 +1,16 @@
+(.module:
+  lux
+  (lux (data [text]
+             (coll [list "list/" Functor<List>]
+                   (dictionary ["dict" unordered #+ Dict]))))
+  [//]
+  [/common]
+  [/host])
+
+(def: #export defaults
+  (//.Extension //.Analysis)
+  (|> /common.specials
+      (dict.merge /host.specials)
+      dict.entries
+      (list/map (function (_ [name proc]) [name (proc name)]))
+      (dict.from-list text.Hash<Text>)))
diff --git a/stdlib/source/lux/lang/extension/analysis/common.lux b/stdlib/source/lux/lang/extension/analysis/common.lux
new file mode 100644
index 000000000..8c0116721
--- /dev/null
+++ b/stdlib/source/lux/lang/extension/analysis/common.lux
@@ -0,0 +1,444 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                [thread])
+       (concurrency [atom #+ Atom])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [array]
+                   (dictionary ["dict" unordered #+ Dict])))
+       [macro]
+       (macro [code])
+       [lang]
+       (lang (type ["tc" check])
+             [".L" analysis]
+             (analysis [".A" type]
+                       [".A" case]
+                       [".A" function]))
+       [io])
+  [///])
+
+(exception: #export (incorrect-special-arity {name Text} {arity Nat} {args Nat})
+  (ex.report ["Special" (%t name)]
+             ["Expected arity" (|> arity .int %i)]
+             ["Actual arity" (|> args .int %i)]))
+
+(exception: #export (invalid-syntax {name Text} {arguments (List Code)})
+  (ex.report ["Special" name]
+             ["Inputs" (|> arguments
+                           list.enumerate
+                           (list/map (function (_ [idx argC])
+                                       (format "\n  " (%n idx) " " (%code argC))))
+                           (text.join-with ""))]))
+
+## [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: (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>
+            [_ (typeA.infer outputT)
+             argsA (monad.map @
+                              (function (_ [argT argC])
+                                (typeA.with-type argT
+                                  (analyse argC)))
+                              (list.zip2 inputsT+ args))]
+            (wrap (#analysisL.Special proc argsA)))
+          (lang.throw incorrect-special-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] (typeA.with-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] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Either Text varT)))
+         opA (typeA.with-type (type (io.IO varT))
+               (analyse opC))]
+        (wrap (#analysisL.Special proc (list opA))))
+      
+      _
+      (lang.throw incorrect-special-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.function analyse func-name arg-name body)
+      
+      _
+      (lang.throw incorrect-special-arity [proc +3 (list.size args)]))))
+
+(def: (lux//case proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list input [_ (#.Record branches)]))
+      (caseA.case analyse input branches)
+      
+      _
+      (lang.throw incorrect-special-arity [proc +2 (list.size args)]))))
+
+(def: (lux//in-module proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval argsC+)
+    (case argsC+
+      (^ (list [_ (#.Text module-name)] exprC))
+      (lang.with-current-module module-name
+        (analyse exprC))
+      
+      _
+      (lang.throw invalid-syntax [proc argsC+]))))
+
+(do-template [<name> <type>]
+  [(def: (<name> proc)
+     (-> Text ///.Analysis)
+     (function (_ analyse eval args)
+       (case args
+         (^ (list typeC valueC))
+         (do macro.Monad<Meta>
+           [actualT (eval Type typeC)
+            _ (typeA.infer (:! Type actualT))]
+           (typeA.with-type <type>
+             (analyse valueC)))
+         
+         _
+         (lang.throw incorrect-special-arity [proc +2 (list.size args)]))))]
+
+  [lux//check  (:! Type actualT)]
+  [lux//coerce Any]
+  )
+
+(def: (lux//check//type proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list valueC))
+      (do macro.Monad<Meta>
+        [_ (typeA.infer Type)
+         valueA (typeA.with-type Type
+                  (analyse valueC))]
+        (wrap valueA))
+      
+      _
+      (lang.throw incorrect-special-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 Any))
+          (install "error" (unary Text Nothing))
+          (install "exit" (unary Int Nothing))
+          (install "current-time" (nullary Int)))))
+
+(def: bit-procs
+  Bundle
+  (<| (prefix "bit")
+      (|> (dict.new text.Hash<Text>)
+          (install "and" (binary Nat Nat Nat))
+          (install "or" (binary Nat Nat Nat))
+          (install "xor" (binary Nat Nat Nat))
+          (install "left-shift" (binary Nat Nat Nat))
+          (install "logical-right-shift" (binary Nat Nat Nat))
+          (install "arithmetic-right-shift" (binary Int Nat Int))
+          )))
+
+(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))
+          (install "char" (unary Int Text)))))
+
+(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))))
+          )))
+
+(def: (array//get proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (do macro.Monad<Meta>
+      [[var-id varT] (typeA.with-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] (typeA.with-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] (typeA.with-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 "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] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Atom varT)))
+         initA (typeA.with-type varT
+                 (analyse initC))]
+        (wrap (#analysisL.Special proc (list initA))))
+      
+      _
+      (lang.throw incorrect-special-arity [proc +1 (list.size args)]))))
+
+(def: (atom-read proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (do macro.Monad<Meta>
+      [[var-id varT] (typeA.with-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] (typeA.with-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: (box//new proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list initC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer (type (All [!] (thread.Box ! varT))))
+         initA (typeA.with-type varT
+                 (analyse initC))]
+        (wrap (#analysisL.Special proc (list initA))))
+      
+      _
+      (lang.throw incorrect-special-arity [proc +1 (list.size args)]))))
+
+(def: (box//read proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (do macro.Monad<Meta>
+      [[thread-id threadT] (typeA.with-env tc.var)
+       [var-id varT] (typeA.with-env tc.var)]
+      ((unary (type (thread.Box threadT varT)) varT proc)
+       analyse eval args))))
+
+(def: (box//write proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (do macro.Monad<Meta>
+      [[thread-id threadT] (typeA.with-env tc.var)
+       [var-id varT] (typeA.with-env tc.var)]
+      ((binary varT (type (thread.Box threadT varT)) Any proc)
+       analyse eval args))))
+
+(def: box-procs
+  Bundle
+  (<| (prefix "box")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" box//new)
+          (install "read" box//read)
+          (install "write" box//write)
+          )))
+
+(def: process-procs
+  Bundle
+  (<| (prefix "process")
+      (|> (dict.new text.Hash<Text>)
+          (install "parallelism-level" (nullary Nat))
+          (install "schedule" (binary Nat (type (io.IO Any)) Any))
+          )))
+
+(def: #export specials
+  Bundle
+  (<| (prefix "lux")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge lux-procs)
+          (dict.merge bit-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 box-procs)
+          (dict.merge process-procs)
+          (dict.merge io-procs))))
diff --git a/stdlib/source/lux/lang/extension/analysis/host.jvm.lux b/stdlib/source/lux/lang/extension/analysis/host.jvm.lux
new file mode 100644
index 000000000..31b811fac
--- /dev/null
+++ b/stdlib/source/lux/lang/extension/analysis/host.jvm.lux
@@ -0,0 +1,1224 @@
+(.module:
+  [lux #- char int]
+  (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]
+                   (dictionary ["dict" unordered #+ Dict])))
+       [macro "macro/" Monad<Meta>]
+       (macro [code]
+              ["s" syntax])
+       [lang]
+       (lang [type]
+             (type ["tc" check])
+             [".L" analysis #+ Analysis]
+             (analysis [".A" type]
+                       [".A" inference]))
+       [host])
+  ["/" //common]
+  [///]
+  )
+
+(host.import #long java/lang/reflect/Type
+  (getTypeName [] String))
+
+(def: jvm-type-name
+  (-> java/lang/reflect/Type Text)
+  (java/lang/reflect/Type::getTypeName []))
+
+(exception: #export (jvm-type-is-not-a-class {jvm-type java/lang/reflect/Type})
+  (jvm-type-name jvm-type))
+
+(do-template [<name>]
+  [(exception: #export (<name> {type Type})
+     (%type type))]
+
+  [non-object]
+  [non-array]
+  [non-jvm-type]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {name Text})
+     name)]
+
+  [non-interface]
+  [non-throwable]
+  )
+
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Unknown-Class]
+  [Primitives-Cannot-Have-Type-Parameters]
+  [Primitives-Are-Not-Objects]
+  [Invalid-Type-For-Array-Element]
+
+  [Unknown-Field]
+  [Mistaken-Field-Owner]
+  [Not-Virtual-Field]
+  [Not-Static-Field]
+  [Cannot-Set-Final-Field]
+
+  [No-Candidates]
+  [Too-Many-Candidates]
+
+  [Cannot-Cast]
+
+  [Cannot-Possibly-Be-Instance]
+
+  [Cannot-Convert-To-Class]
+  [Cannot-Convert-To-Parameter]
+  [Cannot-Convert-To-Lux-Type]
+  [Unknown-Type-Var]
+  [Type-Parameter-Mismatch]
+  [Cannot-Correspond-Type-With-Class]
+  )
+
+(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>
+        [_ (typeA.infer Nat)
+         [var-id varT] (typeA.with-env tc.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))]
+        (wrap (#analysisL.Special proc (list arrayA))))
+
+      _
+      (lang.throw /.incorrect-special-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 (typeA.with-type Nat
+                   (analyse lengthC))
+         expectedT macro.expected-type
+         [level elem-class] (: (Meta [Nat Text])
+                               (loop [analysisT expectedT
+                                      level +0]
+                                 (case analysisT
+                                   (#.Apply inputT funcT)
+                                   (case (type.apply (list inputT) funcT)
+                                     (#.Some outputT)
+                                     (recur outputT level)
+
+                                     #.None
+                                     (lang.throw non-array expectedT))
+
+                                   (^ (#.Primitive "#Array" (list elemT)))
+                                   (recur elemT (inc level))
+
+                                   (#.Primitive class _)
+                                   (wrap [level class])
+                                   
+                                   _
+                                   (lang.throw non-array expectedT))))
+         _ (if (n/> +0 level)
+             (wrap [])
+             (lang.throw non-array expectedT))]
+        (wrap (#analysisL.Special proc (list (analysisL.nat (dec level))
+                                             (analysisL.text elem-class)
+                                             lengthA))))
+
+      _
+      (lang.throw /.incorrect-special-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
+      (lang.throw non-object objectT))
+
+    _
+    (lang.throw non-object objectT)))
+
+(def: (check-object objectT)
+  (-> Type (Meta Text))
+  (do macro.Monad<Meta>
+    [name (check-jvm objectT)]
+    (if (dict.contains? name boxes)
+      (lang.throw Primitives-Are-Not-Objects name)
+      (macro/wrap name))))
+
+(def: (box-array-element-type elemT)
+  (-> Type (Meta [Type Text]))
+  (case elemT
+    (#.Primitive name #.Nil)
+    (let [boxed-name (|> (dict.get name boxes)
+                         (maybe.default name))]
+      (macro/wrap [(#.Primitive boxed-name #.Nil)
+                   boxed-name]))
+
+    (#.Primitive name _)
+    (if (dict.contains? name boxes)
+      (lang.throw Primitives-Cannot-Have-Type-Parameters name)
+      (macro/wrap [elemT name]))
+
+    _
+    (lang.throw Invalid-Type-For-Array-Element (%type elemT))))
+
+(def: (array//read proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list arrayC idxC))
+      (do macro.Monad<Meta>
+        [[var-id varT] (typeA.with-env tc.var)
+         _ (typeA.infer varT)
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (tc.read var-id))
+         [elemT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (typeA.with-type Nat
+                (analyse idxC))]
+        (wrap (#analysisL.Special proc (list (analysisL.text elem-class) idxA arrayA))))
+
+      _
+      (lang.throw /.incorrect-special-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] (typeA.with-env tc.var)
+         _ (typeA.infer (type (Array varT)))
+         arrayA (typeA.with-type (type (Array varT))
+                  (analyse arrayC))
+         ?elemT (typeA.with-env
+                  (tc.read var-id))
+         [valueT elem-class] (box-array-element-type (maybe.default varT ?elemT))
+         idxA (typeA.with-type Nat
+                (analyse idxC))
+         valueA (typeA.with-type valueT
+                  (analyse valueC))]
+        (wrap (#analysisL.Special proc (list (analysisL.text elem-class) idxA valueA arrayA))))
+
+      _
+      (lang.throw /.incorrect-special-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 (#analysisL.Special proc (list))))
+
+      _
+      (lang.throw /.incorrect-special-arity [proc +0 (list.size args)]))))
+
+(def: (object//null? proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list objectC))
+      (do macro.Monad<Meta>
+        [_ (typeA.infer Bool)
+         [objectT objectA] (typeA.with-inference
+                             (analyse objectC))
+         _ (check-object objectT)]
+        (wrap (#analysisL.Special proc (list objectA))))
+
+      _
+      (lang.throw /.incorrect-special-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] (typeA.with-inference
+                               (analyse monitorC))
+         _ (check-object monitorT)
+         exprA (analyse exprC)]
+        (wrap (#analysisL.Special proc (list monitorA exprA))))
+
+      _
+      (lang.throw /.incorrect-special-arity [proc +2 (list.size args)]))))
+
+(host.import java/lang/Object
+  (equals [Object] boolean))
+
+(host.import java/lang/ClassLoader)
+
+(host.import java/lang/reflect/GenericArrayType
+  (getGenericComponentType [] java/lang/reflect/Type))
+
+(host.import java/lang/reflect/ParameterizedType
+  (getRawType [] java/lang/reflect/Type)
+  (getActualTypeArguments [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/TypeVariable d)
+  (getName [] String)
+  (getBounds [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/WildcardType d)
+  (getLowerBounds [] (Array java/lang/reflect/Type))
+  (getUpperBounds [] (Array java/lang/reflect/Type)))
+
+(host.import java/lang/reflect/Modifier
+  (#static isStatic [int] boolean)
+  (#static isFinal [int] boolean)
+  (#static isInterface [int] boolean)
+  (#static isAbstract [int] boolean))
+
+(host.import java/lang/reflect/Field
+  (getDeclaringClass [] (java/lang/Class Object))
+  (getModifiers [] int)
+  (getGenericType [] java/lang/reflect/Type))
+
+(host.import java/lang/reflect/Method
+  (getName [] String)
+  (getModifiers [] int)
+  (getDeclaringClass [] (Class Object))
+  (getTypeParameters [] (Array (TypeVariable Method)))
+  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+  (getGenericReturnType [] java/lang/reflect/Type)
+  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/reflect/Constructor c)
+  (getModifiers [] int)
+  (getDeclaringClass [] (Class c))
+  (getTypeParameters [] (Array (TypeVariable (Constructor c))))
+  (getGenericParameterTypes [] (Array java/lang/reflect/Type))
+  (getGenericExceptionTypes [] (Array java/lang/reflect/Type)))
+
+(host.import (java/lang/Class c)
+  (getName [] String)
+  (getModifiers [] int)
+  (#static forName [String] #try (Class Object))
+  (isAssignableFrom [(Class Object)] boolean)
+  (getTypeParameters [] (Array (TypeVariable (Class c))))
+  (getGenericInterfaces [] (Array java/lang/reflect/Type))
+  (getGenericSuperclass [] java/lang/reflect/Type)
+  (getDeclaredField [String] #try Field)
+  (getConstructors [] (Array (Constructor Object)))
+  (getDeclaredMethods [] (Array Method)))
+
+(def: (load-class name)
+  (-> Text (Meta (Class Object)))
+  (do macro.Monad<Meta>
+    []
+    (case (Class::forName [name])
+      (#e.Success [class])
+      (wrap class)
+
+      (#e.Error error)
+      (lang.throw Unknown-Class name))))
+
+(def: (sub-class? super sub)
+  (-> Text Text (Meta Bool))
+  (do macro.Monad<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>
+        [_ (typeA.infer Nothing)
+         [exceptionT exceptionA] (typeA.with-inference
+                                   (analyse exceptionC))
+         exception-class (check-object exceptionT)
+         ? (sub-class? "java.lang.Throwable" exception-class)
+         _ (: (Meta Any)
+              (if ?
+                (wrap [])
+                (lang.throw non-throwable exception-class)))]
+        (wrap (#analysisL.Special proc (list exceptionA))))
+
+      _
+      (lang.throw /.incorrect-special-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>
+          [_ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list)))))
+           _ (load-class class)]
+          (wrap (#analysisL.Special proc (list (analysisL.text class)))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-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>
+          [_ (typeA.infer Bool)
+           [objectT objectA] (typeA.with-inference
+                               (analyse objectC))
+           object-class (check-object objectT)
+           ? (sub-class? class object-class)]
+          (if ?
+            (wrap (#analysisL.Special proc (list (analysisL.text class))))
+            (lang.throw Cannot-Possibly-Be-Instance (format object-class " !<= "  class))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-arity [proc +2 (list.size args)]))))
+
+(def: (java-type-to-class type)
+  (-> java/lang/reflect/Type (Meta Text))
+  (cond (host.instance? Class type)
+        (macro/wrap (Class::getName [] (:! Class type)))
+
+        (host.instance? ParameterizedType type)
+        (java-type-to-class (ParameterizedType::getRawType [] (:! ParameterizedType type)))
+
+        ## else
+        (lang.throw Cannot-Convert-To-Class (jvm-type-name 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
+            (lang.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 Any)))
+
+        (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 (dec arity))
+                            list.reverse
+                            (list/map (|>> (n/* +2) 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)))
+            (lang.throw jvm-type-is-not-a-class 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
+        (lang.throw Cannot-Convert-To-Lux-Type (jvm-type-name java-type))))
+
+(def: (correspond-type-params class type)
+  (-> (Class Object) Type (Meta Mappings))
+  (case type
+    (#.Primitive name params)
+    (let [class-name (Class::getName [] class)
+          class-params (array.to-list (Class::getTypeParameters [] class))
+          num-class-params (list.size class-params)
+          num-type-params (list.size params)]
+      (cond (not (text/= class-name name))
+            (lang.throw Cannot-Correspond-Type-With-Class
+                        (format "Class = " class-name "\n"
+                                "Type = " (%type type)))
+
+            (not (n/= num-class-params num-type-params))
+            (lang.throw Type-Parameter-Mismatch
+                        (format "Expected: " (%i (.int num-class-params)) "\n"
+                                "  Actual: " (%i (.int num-type-params)) "\n"
+                                "   Class: " class-name "\n"
+                                "    Type: " (%type type)))
+
+            ## else
+            (macro/wrap (|> params
+                            (list.zip2 (list/map (TypeVariable::getName []) class-params))
+                            (dict.from-list text.Hash<Text>)))
+            ))
+
+    _
+    (lang.throw non-jvm-type type)))
+
+(def: (object//cast proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list valueC))
+      (do macro.Monad<Meta>
+        [toT macro.expected-type
+         to-name (check-jvm toT)
+         [valueT valueA] (typeA.with-inference
+                           (analyse valueC))
+         from-name (check-jvm valueT)
+         can-cast? (: (Meta Bool)
+                      (case [from-name to-name]
+                        (^template [<primitive> <object>]
+                          (^or [<primitive> <object>]
+                               [<object> <primitive>])
+                          (do @
+                            [_ (typeA.infer (#.Primitive to-name (list)))]
+                            (wrap true)))
+                        (["boolean" "java.lang.Boolean"]
+                         ["byte"    "java.lang.Byte"]
+                         ["short"   "java.lang.Short"]
+                         ["int"     "java.lang.Integer"]
+                         ["long"    "java.lang.Long"]
+                         ["float"   "java.lang.Float"]
+                         ["double"  "java.lang.Double"]
+                         ["char"    "java.lang.Character"])
+
+                        _
+                        (do @
+                          [_ (lang.assert Primitives-Are-Not-Objects from-name
+                                          (not (dict.contains? from-name boxes)))
+                           _ (lang.assert Primitives-Are-Not-Objects to-name
+                                          (not (dict.contains? to-name boxes)))
+                           to-class (load-class to-name)]
+                          (loop [[current-name currentT] [from-name valueT]]
+                            (if (text/= to-name current-name)
+                              (do @
+                                [_ (typeA.infer toT)]
+                                (wrap true))
+                              (do @
+                                [current-class (load-class current-name)
+                                 _ (lang.assert Cannot-Cast (format "From class/primitive: " current-name "\n"
+                                                                    "  To class/primitive: " to-name "\n"
+                                                                    "           For value: " (%code valueC) "\n")
+                                                (Class::isAssignableFrom [current-class] to-class))
+                                 candiate-parents (monad.map @
+                                                             (function (_ java-type)
+                                                               (do @
+                                                                 [class-name (java-type-to-class java-type)
+                                                                  class (load-class class-name)]
+                                                                 (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)])))
+                                                             (list& (Class::getGenericSuperclass [] current-class)
+                                                                    (array.to-list (Class::getGenericInterfaces [] current-class))))]
+                                (case (|> candiate-parents
+                                          (list.filter product.right)
+                                          (list/map product.left))
+                                  (#.Cons [next-name nextJT] _)
+                                  (do @
+                                    [mapping (correspond-type-params current-class currentT)
+                                     nextT (java-type-to-lux-type mapping nextJT)]
+                                    (recur [next-name nextT]))
+
+                                  #.Nil
+                                  (lang.throw Cannot-Cast (format "From class/primitive: " from-name "\n"
+                                                                  "  To class/primitive: " to-name "\n"
+                                                                  "           For value: " (%code valueC) "\n")))
+                                ))))))]
+        (if can-cast?
+          (wrap (#analysisL.Special proc (list (analysisL.text from-name)
+                                               (analysisL.text to-name)
+                                               valueA)))
+          (lang.throw Cannot-Cast (format "From class/primitive: " from-name "\n"
+                                          "  To class/primitive: " to-name "\n"
+                                          "           For value: " (%code valueC) "\n"))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: object-procs
+  /.Bundle
+  (<| (/.prefix "object")
+      (|> (dict.new text.Hash<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?)
+          (/.install "cast" object//cast)
+          )))
+
+(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])
+          (lang.throw Mistaken-Field-Owner
+                      (format "       Field: " field-name "\n"
+                              " Owner Class: " (Class::getName [] owner) "\n"
+                              "Target Class: " class-name "\n"))))
+
+      (#e.Error _)
+      (lang.throw Unknown-Field (format class-name "#" field-name)))))
+
+(def: (static-field class-name field-name)
+  (-> Text Text (Meta [Type Bool]))
+  (do macro.Monad<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])])))
+      (lang.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)]
+                          _ (lang.assert Type-Parameter-Mismatch
+                                         (format "Expected: " (%i (.int num-params)) "\n"
+                                                 "  Actual: " (%i (.int num-vars)) "\n"
+                                                 "   Class: " _class-name "\n"
+                                                 "    Type: " (%type objectT))
+                                         (n/= num-params num-vars))]
+                         (wrap (|> (list.zip2 var-names _class-params)
+                                   (dict.from-list text.Hash<Text>))))
+
+                       _
+                       (lang.throw non-object objectT)))
+         fieldT (java-type-to-lux-type mappings fieldJT)]
+        (wrap [fieldT (Modifier::isFinal [modifiers])]))
+      (lang.throw Not-Virtual-Field (format class-name "#" field-name)))))
+
+(def: (static//get proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case args
+      (^ (list classC fieldC))
+      (case [classC fieldC]
+        [[_ (#.Text class)] [_ (#.Text field)]]
+        (do macro.Monad<Meta>
+          [[fieldT final?] (static-field class field)]
+          (wrap (#analysisL.Special proc (list (analysisL.text class) (analysisL.text field)))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-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>
+          [_ (typeA.infer Any)
+           [fieldT final?] (static-field class field)
+           _ (lang.assert Cannot-Set-Final-Field (format class "#" field)
+                          (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysisL.Special proc (list (analysisL.text class) (analysisL.text field) valueA))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-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] (typeA.with-inference
+                               (analyse objectC))
+           [fieldT final?] (virtual-field class field objectT)]
+          (wrap (#analysisL.Special proc (list (analysisL.text class) (analysisL.text field) objectA))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-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] (typeA.with-inference
+                               (analyse objectC))
+           _ (typeA.infer objectT)
+           [fieldT final?] (virtual-field class field objectT)
+           _ (lang.assert Cannot-Set-Final-Field (format class "#" field)
+                          (not final?))
+           valueA (typeA.with-type fieldT
+                    (analyse valueC))]
+          (wrap (#analysisL.Special proc (list (analysisL.text class) (analysisL.text field) valueA objectA))))
+
+        _
+        (lang.throw /.invalid-syntax [proc args]))
+
+      _
+      (lang.throw /.incorrect-special-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
+        (lang.throw Cannot-Convert-To-Parameter (jvm-type-name 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) inc #.Bound))
+
+(def: (type-vars amount offset)
+  (-> Nat Nat (List Type))
+  (if (n/= +0 amount)
+    (list)
+    (|> (list.n/range offset (|> amount dec (n/+ offset)))
+        (list/map idx-to-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
+      (lang.throw No-Candidates (format class-name "#" method-name))
+      
+      (#.Cons candidate #.Nil)
+      (|> candidate product.right (method-to-type method-type))
+
+      _
+      (lang.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
+      (lang.throw No-Candidates (format class-name "(" (text.join-with ", " arg-classes) ")"))
+      
+      (#.Cons candidate #.Nil)
+      (|> candidate product.right constructor-to-type)
+
+      _
+      (lang.throw Too-Many-Candidates class-name))))
+
+(def: (decorate-inputs typesT inputsA)
+  (-> (List Text) (List Analysis) (List Analysis))
+  (|> inputsA
+      (list.zip2 (list/map analysisL.text typesT))
+      (list/map (function (_ [type value])
+                  (analysisL.product-analysis (list type value))))))
+
+(def: (invoke//static proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case (: (e.Error [Text Text (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class method argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Static argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysisL.Special proc (list& (analysisL.text class) (analysisL.text method)
+                                              (analysisL.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//virtual proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case (: (e.Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class method objectC argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Virtual argsT)
+         [outputT allA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         #let [[objectA argsA] (case allA
+                                 (#.Cons objectA argsA)
+                                 [objectA argsA]
+
+                                 _
+                                 (undefined))]
+         outputJC (check-jvm outputT)]
+        (wrap (#analysisL.Special proc (list& (analysisL.text class) (analysisL.text method)
+                                              (analysisL.text outputJC) objectA (decorate-inputs argsT argsA)))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//special proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Any]])
+             (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
+      (#e.Success [_ [class method objectC argsTC _]])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (methods class method #Special argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysisL.Special proc (list& (analysisL.text class) (analysisL.text method)
+                                              (analysisL.text outputJC) (decorate-inputs argsT argsA)))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//interface proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case (: (e.Error [Text Text Code (List [Text Code])])
+             (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class-name method objectC argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         class (load-class class-name)
+         _ (lang.assert non-interface class-name
+                        (Modifier::isInterface [(Class::getModifiers [] class)]))
+         [methodT exceptionsT] (methods class-name method #Interface argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC)))
+         outputJC (check-jvm outputT)]
+        (wrap (#analysisL.Special proc
+                                  (list& (analysisL.text class-name) (analysisL.text method) (analysisL.text outputJC)
+                                         (decorate-inputs argsT argsA)))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: (invoke//constructor proc)
+  (-> Text ///.Analysis)
+  (function (_ analyse eval args)
+    (case (: (e.Error [Text (List [Text Code])])
+             (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
+      (#e.Success [class argsTC])
+      (do macro.Monad<Meta>
+        [#let [argsT (list/map product.left argsTC)]
+         [methodT exceptionsT] (constructor-methods class argsT)
+         [outputT argsA] (inferenceA.general analyse methodT (list/map product.right argsTC))]
+        (wrap (#analysisL.Special proc (list& (analysisL.text class) (decorate-inputs argsT argsA)))))
+
+      _
+      (lang.throw /.invalid-syntax [proc args]))))
+
+(def: member-procs
+  /.Bundle
+  (<| (/.prefix "member")
+      (|> (dict.new text.Hash<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 specials
+  /.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/stdlib/source/lux/lang/init.lux b/stdlib/source/lux/lang/init.lux
index 80e6d4740..8d4fdf981 100644
--- a/stdlib/source/lux/lang/init.lux
+++ b/stdlib/source/lux/lang/init.lux
@@ -1,11 +1,11 @@
 (.module:
   lux
-  ## (// [".L" extension]
-  ##     (extension [".E" analysis]
-  ##                [".E" synthesis]
-  ##                [".E" translation]
-  ##                [".E" statement]))
-  )
+  (// [".L" extension]
+      (extension [".E" analysis]
+                 ## [".E" synthesis]
+                 ## [".E" translation]
+                 ## [".E" statement]
+                 )))
 
 (def: #export (cursor file)
   (-> Text Cursor)
@@ -30,7 +30,13 @@
 (def: #export info
   Info
   {#.target  (for {"JVM" "JVM"
-                   "JS" "JS"})
+                   "JS" "JS"
+                   "Lua" "Lua"
+                   "Python" "Python"
+                   "Ruby" "Ruby"
+                   "PHP" "PHP"
+                   "Scheme" "Scheme"
+                   "Common Lisp" "Common Lisp"})
    #.version ..version
    #.mode    #.Build})
 
@@ -47,10 +53,9 @@
    #.seed            +0
    #.scope-type-vars (list)
    #.extensions      (:! Nothing
-                         []
-                         ## {#extensionL.analysis analysisE.defaults
-                         ##  #extensionL.synthesis synthesisE.defaults
-                         ##  #extensionL.translation translationE.defaults
-                         ##  #extensionL.statement statementE.defaults}
-                         )
+                         {#extensionL.analysis analysisE.defaults
+                          #extensionL.synthesis (:!! []) ## synthesisE.defaults
+                          #extensionL.translation (:!! []) ## translationE.defaults
+                          #extensionL.statement (:!! []) ## statementE.defaults
+                          })
    #.host            (:! Nothing host)})
diff --git a/stdlib/source/lux/lang/synthesis.lux b/stdlib/source/lux/lang/synthesis.lux
new file mode 100644
index 000000000..33c8aa063
--- /dev/null
+++ b/stdlib/source/lux/lang/synthesis.lux
@@ -0,0 +1,8 @@
+(.module:
+  lux)
+
+(def: #export Arity Nat)
+
+(type: #export Synthesis Code)
+
+(type: #export Path Code)
diff --git a/stdlib/test/test/lux/lang/analysis/procedure/common.lux b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
new file mode 100644
index 000000000..898376045
--- /dev/null
+++ b/stdlib/test/test/lux/lang/analysis/procedure/common.lux
@@ -0,0 +1,316 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data text/format
+             ["e" error]
+             [product]
+             (coll [array]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Meta>]
+       (macro [code])
+       [lang]
+       (lang [type "type/" Eq<Type>]
+             [".L" scope]
+             [".L" init]
+             (analysis [".A" type]))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (lang.with-scope
+           (typeA.with-type output-type
+             (_primitive.analyse (` ((~ (code.text procedure)) (~+ params))))))
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [check-success+ true false]
+  [check-failure+ false true]
+  )
+
+(context: "Lux procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         [antiT antiC] (|> _primitive.primitive
+                           (r.filter (|>> product.left (type/= primT) not)))]
+        ($_ seq
+            (test "Can test for reference equality."
+                  (check-success+ "lux is" (list primC primC) Bool))
+            (test "Reference equality must be done with elements of the same type."
+                  (check-failure+ "lux is" (list primC antiC) Bool))
+            (test "Can 'try' risky IO computations."
+                  (check-success+ "lux try"
+                                  (list (` ("lux function" (~' _) (~' _) (~ primC))))
+                                  (type (Either Text primT))))
+            ))))
+
+(context: "Bit procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.nat (:: @ map code.nat))
+         signedC (|> r.int (:: @ map code.int))
+         paramC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can perform bit 'and'."
+                  (check-success+ "lux bit and" (list subjectC paramC) Nat))
+            (test "Can perform bit 'or'."
+                  (check-success+ "lux bit or" (list subjectC paramC) Nat))
+            (test "Can perform bit 'xor'."
+                  (check-success+ "lux bit xor" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the left."
+                  (check-success+ "lux bit left-shift" (list subjectC paramC) Nat))
+            (test "Can shift bit pattern to the right."
+                  (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat))
+            (test "Can shift signed bit pattern to the right."
+                  (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
+            ))))
+
+(context: "Int procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.int (:: @ map code.int))
+         paramC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can add integers."
+                  (check-success+ "lux int +" (list subjectC paramC) Int))
+            (test "Can subtract integers."
+                  (check-success+ "lux int -" (list subjectC paramC) Int))
+            (test "Can multiply integers."
+                  (check-success+ "lux int *" (list subjectC paramC) Int))
+            (test "Can divide integers."
+                  (check-success+ "lux int /" (list subjectC paramC) Int))
+            (test "Can calculate remainder of integers."
+                  (check-success+ "lux int %" (list subjectC paramC) Int))
+            (test "Can test equality of integers."
+                  (check-success+ "lux int =" (list subjectC paramC) Bool))
+            (test "Can compare integers."
+                  (check-success+ "lux int <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum integer."
+                  (check-success+ "lux int min" (list) Int))
+            (test "Can obtain maximum integer."
+                  (check-success+ "lux int max" (list) Int))
+            (test "Can convert integer to natural number."
+                  (check-success+ "lux int to-nat" (list subjectC) Nat))
+            (test "Can convert integer to frac number."
+                  (check-success+ "lux int to-frac" (list subjectC) Frac))
+            (test "Can convert integer to text."
+                  (check-success+ "lux int char" (list subjectC) Text))
+            ))))
+
+(context: "Frac procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))
+         encodedC (|> (r.unicode +5) (:: @ map code.text))]
+        ($_ seq
+            (test "Can add frac numbers."
+                  (check-success+ "lux frac +" (list subjectC paramC) Frac))
+            (test "Can subtract frac numbers."
+                  (check-success+ "lux frac -" (list subjectC paramC) Frac))
+            (test "Can multiply frac numbers."
+                  (check-success+ "lux frac *" (list subjectC paramC) Frac))
+            (test "Can divide frac numbers."
+                  (check-success+ "lux frac /" (list subjectC paramC) Frac))
+            (test "Can calculate remainder of frac numbers."
+                  (check-success+ "lux frac %" (list subjectC paramC) Frac))
+            (test "Can test equality of frac numbers."
+                  (check-success+ "lux frac =" (list subjectC paramC) Bool))
+            (test "Can compare frac numbers."
+                  (check-success+ "lux frac <" (list subjectC paramC) Bool))
+            (test "Can obtain minimum frac number."
+                  (check-success+ "lux frac min" (list) Frac))
+            (test "Can obtain maximum frac number."
+                  (check-success+ "lux frac max" (list) Frac))
+            (test "Can obtain smallest frac number."
+                  (check-success+ "lux frac smallest" (list) Frac))
+            (test "Can obtain not-a-number."
+                  (check-success+ "lux frac not-a-number" (list) Frac))
+            (test "Can obtain positive infinity."
+                  (check-success+ "lux frac positive-infinity" (list) Frac))
+            (test "Can obtain negative infinity."
+                  (check-success+ "lux frac negative-infinity" (list) Frac))
+            (test "Can convert frac number to integer."
+                  (check-success+ "lux frac to-int" (list subjectC) Int))
+            (test "Can convert frac number to text."
+                  (check-success+ "lux frac encode" (list subjectC) Text))
+            (test "Can convert text to frac number."
+                  (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac))))
+            ))))
+
+(context: "Text procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> (r.unicode +5) (:: @ map code.text))
+         paramC (|> (r.unicode +5) (:: @ map code.text))
+         replacementC (|> (r.unicode +5) (:: @ map code.text))
+         fromC (|> r.nat (:: @ map code.nat))
+         toC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can test text equality."
+                  (check-success+ "lux text =" (list subjectC paramC) Bool))
+            (test "Compare texts in lexicographical order."
+                  (check-success+ "lux text <" (list subjectC paramC) Bool))
+            (test "Can concatenate one text to another."
+                  (check-success+ "lux text concat" (list subjectC paramC) Text))
+            (test "Can find the index of a piece of text inside a larger one that (may) contain it."
+                  (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
+            (test "Can query the size/length of a text."
+                  (check-success+ "lux text size" (list subjectC) Nat))
+            (test "Can calculate a hash code for text."
+                  (check-success+ "lux text hash" (list subjectC) Nat))
+            (test "Can replace a text inside of a larger one (once)."
+                  (check-success+ "lux text replace-once" (list subjectC paramC replacementC) Text))
+            (test "Can replace a text inside of a larger one (all times)."
+                  (check-success+ "lux text replace-all" (list subjectC paramC replacementC) Text))
+            (test "Can obtain the character code of a text at a given index."
+                  (check-success+ "lux text char" (list subjectC fromC) (type (Maybe Nat))))
+            (test "Can clip a piece of text between 2 indices."
+                  (check-success+ "lux text clip" (list subjectC fromC toC) (type (Maybe Text))))
+            ))))
+
+(context: "Array procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [arrayT (type (Array elemT))
+               g!array (code.local-symbol var-name)
+               array-operation (function (_ output-type code)
+                                 (|> (scopeL.with-scope ""
+                                       (scopeL.with-local [var-name arrayT]
+                                         (typeA.with-type output-type
+                                           (_primitive.analyse code))))
+                                     (macro.run (initL.compiler []))
+                                     (case> (#e.Success _)
+                                            true
+
+                                            (#e.Error error)
+                                            false)))]]
+        ($_ seq
+            (test "Can create arrays."
+                  (check-success+ "lux array new" (list sizeC) arrayT))
+            (test "Can get a value inside an array."
+                  (array-operation (type (Maybe elemT))
+                                   (` ("lux array get" (~ g!array) (~ idxC)))))
+            (test "Can put a value inside an array."
+                  (array-operation arrayT
+                                   (` ("lux array put" (~ g!array) (~ idxC) (~ elemC)))))
+            (test "Can remove a value from an array."
+                  (array-operation arrayT
+                                   (` ("lux array remove" (~ g!array) (~ idxC)))))
+            (test "Can query the size of an array."
+                  (array-operation Nat
+                                   (` ("lux array size" (~ g!array)))))
+            ))))
+
+(context: "Math procedures"
+  (<| (times +100)
+      (do @
+        [subjectC (|> r.frac (:: @ map code.frac))
+         paramC (|> r.frac (:: @ map code.frac))]
+        (`` ($_ seq
+                (~~ (do-template [<proc> <desc>]
+                      [(test (format "Can calculate " <desc> ".")
+                             (check-success+ <proc> (list subjectC) Frac))]
+
+                      ["lux math cos" "cosine"]
+                      ["lux math sin" "sine"]
+                      ["lux math tan" "tangent"]
+                      ["lux math acos" "inverse/arc cosine"]
+                      ["lux math asin" "inverse/arc sine"]
+                      ["lux math atan" "inverse/arc tangent"]
+                      ["lux math cosh" "hyperbolic cosine"]
+                      ["lux math sinh" "hyperbolic sine"]
+                      ["lux math tanh" "hyperbolic tangent"]
+                      ["lux math exp" "exponentiation"]
+                      ["lux math log" "logarithm"]
+                      ["lux math ceil" "ceiling"]
+                      ["lux math floor" "floor"]
+                      ["lux math round" "rounding"]))
+                (~~ (do-template [<proc> <desc>]
+                      [(test (format "Can calculate " <desc> ".")
+                             (check-success+ <proc> (list subjectC paramC) Frac))]
+
+                      ["lux math atan2" "inverse/arc tangent (with 2 arguments)"]
+                      ["lux math pow" "power"])))))))
+
+(context: "Atom procedures"
+  (<| (times +100)
+      (do @
+        [[elemT elemC] _primitive.primitive
+         sizeC (|> r.nat (:: @ map code.nat))
+         idxC (|> r.nat (:: @ map code.nat))
+         var-name (r.unicode +5)
+         #let [atomT (type (atom.Atom elemT))]]
+        ($_ seq
+            (test "Can create atomic reference."
+                  (check-success+ "lux atom new" (list elemC) atomT))
+            (test "Can read the value of an atomic reference."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type elemT
+                            (_primitive.analyse (` ("lux atom read" (~ (code.symbol ["" var-name]))))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            (test "Can swap the value of an atomic reference."
+                  (|> (scopeL.with-scope ""
+                        (scopeL.with-local [var-name atomT]
+                          (typeA.with-type Bool
+                            (_primitive.analyse (` ("lux atom compare-and-swap"
+                                                    (~ (code.symbol ["" var-name]))
+                                                    (~ elemC)
+                                                    (~ elemC)))))))
+                      (macro.run (initL.compiler []))
+                      (case> (#e.Success _)
+                             true
+
+                             (#e.Error _)
+                             false)))
+            ))))
+
+(context: "Process procedures"
+  (<| (times +100)
+      (do @
+        [[primT primC] _primitive.primitive
+         timeC (|> r.nat (:: @ map code.nat))]
+        ($_ seq
+            (test "Can query the level of concurrency."
+                  (check-success+ "lux process parallelism-level" (list) Nat))
+            (test "Can schedule an IO computation to run concurrently at some future time."
+                  (check-success+ "lux process schedule"
+                                  (list timeC
+                                        (` ("lux function" (~' _) (~' _) (~ primC))))
+                                  Any))
+            ))))
+
+(context: "IO procedures"
+  (<| (times +100)
+      (do @
+        [logC (|> (r.unicode +5) (:: @ map code.text))
+         exitC (|> r.int (:: @ map code.int))]
+        ($_ seq
+            (test "Can log messages to standard output."
+                  (check-success+ "lux io log" (list logC) Any))
+            (test "Can throw a run-time error."
+                  (check-success+ "lux io error" (list logC) Nothing))
+            (test "Can exit the program."
+                  (check-success+ "lux io exit" (list exitC) Nothing))
+            (test "Can query the current time (as milliseconds since epoch)."
+                  (check-success+ "lux io current-time" (list) Int))
+            ))))
diff --git a/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
new file mode 100644
index 000000000..0a60149d5
--- /dev/null
+++ b/stdlib/test/test/lux/lang/analysis/procedure/host.jvm.lux
@@ -0,0 +1,541 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (concurrency [atom])
+       (data ["e" error]
+             [product]
+             [maybe]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]
+                   [list "list/" Fold<List>]
+                   (dictionary ["dict" unordered])))
+       ["r" math/random "r/" Monad<Random>]
+       [macro #+ Monad<Meta>]
+       (macro [code])
+       [lang]
+       (lang [type]
+             [".L" init]
+             (analysis [".A" type])
+             (extension (analysis [".AE" host])))
+       test)
+  (/// ["_." primitive]))
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> procedure params output-type)
+     (-> Text (List Code) Type Bool)
+     (|> (do Monad<Meta>
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse (` ((~ (code.text procedure)) (~+ params)))))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [success true false]
+  [failure false true]
+  )
+
+(do-template [<name> <success> <failure>]
+  [(def: (<name> syntax output-type)
+     (-> Code Type Bool)
+     (|> (do Monad<Meta>
+           [## runtime-bytecode @runtime.translate
+            ]
+           (lang.with-scope
+             (typeA.with-type output-type
+               (_primitive.analyse syntax))))
+         (lang.with-current-module "")
+         (macro.run (initL.compiler []))
+         (case> (#e.Success _)
+                <success>
+
+                (#e.Error error)
+                <failure>)))]
+
+  [success' true false]
+  [failure' false true]
+  )
+
+(context: "Conversions [double + float]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert double-to-float" "java.lang.Double" hostAE.Float]
+                                    ["jvm convert double-to-int" "java.lang.Double" hostAE.Integer]
+                                    ["jvm convert double-to-long" "java.lang.Double" hostAE.Long]
+                                    ["jvm convert float-to-double" "java.lang.Float" hostAE.Double]
+                                    ["jvm convert float-to-int" "java.lang.Float" hostAE.Integer]
+                                    ["jvm convert float-to-long" "java.lang.Float" hostAE.Long]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [int]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert int-to-byte" "java.lang.Integer" hostAE.Byte]
+                                    ["jvm convert int-to-char" "java.lang.Integer" hostAE.Character]
+                                    ["jvm convert int-to-double" "java.lang.Integer" hostAE.Double]
+                                    ["jvm convert int-to-float" "java.lang.Integer" hostAE.Float]
+                                    ["jvm convert int-to-long" "java.lang.Integer" hostAE.Long]
+                                    ["jvm convert int-to-short" "java.lang.Integer" hostAE.Short]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [long]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert long-to-double" "java.lang.Long" hostAE.Double]
+                                    ["jvm convert long-to-float" "java.lang.Long" hostAE.Float]
+                                    ["jvm convert long-to-int" "java.lang.Long" hostAE.Integer]
+                                    ["jvm convert long-to-short" "java.lang.Long" hostAE.Short]
+                                    ["jvm convert long-to-byte" "java.lang.Long" hostAE.Byte]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(context: "Conversions [char + byte + short]."
+  (with-expansions [<conversions> (do-template [<procedure> <from> <to>]
+                                    [(test (format <procedure> " SUCCESS")
+                                           (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>))
+                                     (test (format <procedure> " FAILURE")
+                                           (failure <procedure> (list (' [])) <to>))]
+
+                                    ["jvm convert char-to-byte" "java.lang.Character" hostAE.Byte]
+                                    ["jvm convert char-to-short" "java.lang.Character" hostAE.Short]
+                                    ["jvm convert char-to-int" "java.lang.Character" hostAE.Integer]
+                                    ["jvm convert char-to-long" "java.lang.Character" hostAE.Long]
+                                    ["jvm convert byte-to-long" "java.lang.Byte" hostAE.Long]
+                                    ["jvm convert short-to-long" "java.lang.Short" hostAE.Long]
+                                    )]
+    ($_ seq
+        <conversions>
+        )))
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Arithmetic " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Bitwise " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " and") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " or") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " xor") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " shl") <boxed> "java.lang.Integer" <type>]
+                                        [(format "jvm " <domain> " shr") <boxed> "java.lang.Integer" <type>]
+                                        [(format "jvm " <domain> " ushr") <boxed> "java.lang.Integer" <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["int" "java.lang.Integer" hostAE.Integer]
+  ["long" "java.lang.Long" hostAE.Long]
+  )
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Arithmetic " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " +") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " -") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " *") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " /") <boxed> <boxed> <type>]
+                                        [(format "jvm " <domain> " %") <boxed> <boxed> <type>]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))
+
+   (context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["float" "java.lang.Float" hostAE.Float]
+  ["double" "java.lang.Double" hostAE.Double]
+  )
+
+(do-template [<domain> <boxed> <type>]
+  [(context: (format "Order " "[" <domain> "].")
+     (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>]
+                                        [(test <procedure>
+                                               (success <procedure>
+                                                        (list (' ("lux coerce" (+0 <subject> (+0)) []))
+                                                              (' ("lux coerce" (+0 <param> (+0)) [])))
+                                                        <output>))]
+
+                                        [(format "jvm " <domain> " =") <boxed> <boxed> hostAE.Boolean]
+                                        [(format "jvm " <domain> " <") <boxed> <boxed> hostAE.Boolean]
+                                        )]
+       ($_ seq
+           <instructions>
+           )))]
+
+
+  ["char" "java.lang.Character" hostAE.Character]
+  )
+
+(def: array-type
+  (r.Random [Text Text])
+  (let [entries (dict.entries hostAE.boxes)
+        num-entries (list.size entries)]
+    (do r.Monad<Random>
+      [choice (|> r.nat (:: @ map (n/% (inc num-entries))))
+       #let [[unboxed boxed] (: [Text Text]
+                                (|> entries
+                                    (list.nth choice)
+                                    (maybe.default ["java.lang.Object" "java.lang.Object"])))]]
+      (wrap [unboxed boxed]))))
+
+(context: "Array."
+  (<| (times +100)
+      (do @
+        [#let [cap (|>> (n/% +10) (n/max +1))]
+         [unboxed boxed] array-type
+         size (|> r.nat (:: @ map cap))
+         idx (|> r.nat (:: @ map (n/% size)))
+         level (|> r.nat (:: @ map cap))
+         #let [unboxedT (#.Primitive unboxed (list))
+               arrayT (#.Primitive "#Array" (list unboxedT))
+               arrayC (`' ("lux check" (+0 "#Array" (+1 (+0 (~ (code.text unboxed)) (+0)) (+0)))
+                           ("jvm array new" (~ (code.nat size)))))
+               boxedT (#.Primitive boxed (list))
+               boxedTC (` (+0 (~ (code.text boxed)) (+0)))
+               multi-arrayT (list/fold (function (_ _ innerT)
+                                         (|> innerT (list) (#.Primitive "#Array")))
+                                       boxedT
+                                       (list.n/range +1 level))]]
+        ($_ seq
+            (test "jvm array new"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           arrayT))
+            (test "jvm array new (no nesting)"
+                  (failure "jvm array new"
+                           (list (code.nat size))
+                           unboxedT))
+            (test "jvm array new (nested/multi-level)"
+                  (success "jvm array new"
+                           (list (code.nat size))
+                           multi-arrayT))
+            (test "jvm array length"
+                  (success "jvm array length"
+                           (list arrayC)
+                           Nat))
+            (test "jvm array read"
+                  (success' (` ("jvm object cast"
+                                ("jvm array read" (~ arrayC) (~ (code.nat idx)))))
+                            boxedT))
+            (test "jvm array write"
+                  (success "jvm array write"
+                           (list arrayC (code.nat idx) (`' ("lux coerce" (~ boxedTC) [])))
+                           arrayT))
+            ))))
+
+(def: throwables
+  (List Text)
+  (list "java.lang.Throwable"
+        "java.lang.Error"
+        "java.io.IOError"
+        "java.lang.VirtualMachineError"
+        "java.lang.Exception"
+        "java.io.IOException"
+        "java.lang.RuntimeException"))
+
+(context: "Object."
+  (<| (times +100)
+      (do @
+        [[unboxed boxed] array-type
+         [!unboxed !boxed] (|> array-type
+                               (r.filter (function (_ [!unboxed !boxed])
+                                           (not (text/= boxed !boxed)))))
+         #let [boxedT (#.Primitive boxed (list))
+               boxedC (`' ("lux check" (+0 (~ (code.text boxed)) (+0))
+                           ("jvm object null")))
+               !boxedC (`' ("lux check" (+0 (~ (code.text !boxed)) (+0))
+                            ("jvm object null")))
+               unboxedC (`' ("lux check" (+0 (~ (code.text unboxed)) (+0))
+                             ("jvm object null")))]
+         throwable (|> r.nat
+                       (:: @ map (n/% (inc (list.size throwables))))
+                       (:: @ map (function (_ idx)
+                                   (|> throwables
+                                       (list.nth idx)
+                                       (maybe.default "java.lang.Object")))))
+         #let [throwableC (`' ("lux check" (+0 (~ (code.text throwable)) (+0))
+                               ("jvm object null")))]]
+        ($_ seq
+            (test "jvm object null"
+                  (success "jvm object null"
+                           (list)
+                           (#.Primitive boxed (list))))
+            (test "jvm object null (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object null"
+                               (list)
+                               (#.Primitive unboxed (list)))))
+            (test "jvm object null?"
+                  (success "jvm object null?"
+                           (list boxedC)
+                           Bool))
+            (test "jvm object synchronized"
+                  (success "jvm object synchronized"
+                           (list boxedC boxedC)
+                           boxedT))
+            (test "jvm object synchronized (no primitives)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object synchronized"
+                               (list unboxedC boxedC)
+                               boxedT)))
+            (test "jvm object throw"
+                  (or (text/= "java.lang.Object" throwable)
+                      (success "jvm object throw"
+                               (list throwableC)
+                               Nothing)))
+            (test "jvm object class"
+                  (success "jvm object class"
+                           (list (code.text boxed))
+                           (#.Primitive "java.lang.Class" (list boxedT))))
+            (test "jvm object instance?"
+                  (success "jvm object instance?"
+                           (list (code.text boxed)
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (lineage)"
+                  (success "jvm object instance?"
+                           (list (' "java.lang.Object")
+                                 boxedC)
+                           Bool))
+            (test "jvm object instance? (no lineage)"
+                  (or (text/= "java.lang.Object" boxed)
+                      (failure "jvm object instance?"
+                               (list (code.text boxed)
+                                     !boxedC)
+                               Bool)))
+            ))))
+
+(context: "Member [Static Field]."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.io.PrintStream" (list))))
+      (test "jvm member static get (inheritance out)"
+            (success "jvm member static get"
+                     (list (code.text "java.lang.System")
+                           (code.text "out"))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member static put"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("lux check" (+0 "java.awt.datatransfer.DataFlavor" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (final)"
+            (failure "jvm member static put"
+                     (list (code.text "java.lang.System")
+                           (code.text "out")
+                           (`' ("lux check" (+0 "java.io.PrintStream" (+0))
+                                ("jvm object null"))))
+                     Any))
+      (test "jvm member static put (inheritance in)"
+            (success "jvm member static put"
+                     (list (code.text "java.awt.datatransfer.DataFlavor")
+                           (code.text "allHtmlFlavor")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.activation.ActivationDataFlavor" (+0))
+                                 ("jvm object null")))))
+                     Any))
+      ))
+
+(context: "Member [Virtual Field]."
+  ($_ seq
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.String" (list))))
+      (test "jvm member virtual get (inheritance out)"
+            (success "jvm member virtual get"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Object" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "org.omg.CORBA.ValueMember")
+                           (code.text "id")
+                           (`' ("lux check" (+0 "java.lang.String" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "org.omg.CORBA.ValueMember" (+0))
+                                ("jvm object null"))))
+                     (primitive "org.omg.CORBA.ValueMember")))
+      (test "jvm member virtual put (final)"
+            (failure "jvm member virtual put"
+                     (list (code.text "javax.swing.text.html.parser.DTD")
+                           (code.text "applet")
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.Element" (+0))
+                                ("jvm object null")))
+                           (`' ("lux check" (+0 "javax.swing.text.html.parser.DTD" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.swing.text.html.parser.DTD")))
+      (test "jvm member virtual put (inheritance in)"
+            (success "jvm member virtual put"
+                     (list (code.text "java.awt.GridBagConstraints")
+                           (code.text "insets")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "javax.swing.plaf.InsetsUIResource" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "java.awt.GridBagConstraints" (+0))
+                                ("jvm object null"))))
+                     (primitive "java.awt.GridBagConstraints")))
+      ))
+
+(context: "Boxing/Unboxing."
+  ($_ seq
+      (test "jvm member static get"
+            (success "jvm member static get"
+                     (list (code.text "java.util.GregorianCalendar")
+                           (code.text "AD"))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual get"
+            (success "jvm member virtual get"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (#.Primitive "java.lang.Integer" (list))))
+      (test "jvm member virtual put"
+            (success "jvm member virtual put"
+                     (list (code.text "javax.accessibility.AccessibleAttributeSequence")
+                           (code.text "startIndex")
+                           (`' ("jvm object cast"
+                                ("lux check" (+0 "java.lang.Integer" (+0))
+                                 ("jvm object null"))))
+                           (`' ("lux check" (+0 "javax.accessibility.AccessibleAttributeSequence" (+0))
+                                ("jvm object null"))))
+                     (primitive "javax.accessibility.AccessibleAttributeSequence")))
+      ))
+
+(context: "Member [Method]."
+  (let [longC (' ("lux coerce" (+0 "java.lang.Long" (+0))
+                  +123))
+        intC (`' ("jvm convert long-to-int" (~ longC)))
+        stringC (' ("lux coerce" (+0 "java.lang.String" (+0))
+                    "YOLO"))
+        objectC (`' ("lux check" (+0 "java.util.ArrayList" (+1 (+0 "java.lang.Long" (+0)) (+0)))
+                     ("jvm member invoke constructor" "java.util.ArrayList"
+                      ["int" ("jvm object cast" (~ intC))])))]
+    ($_ seq
+        (test "jvm member invoke static"
+              (success' (` ("jvm member invoke static"
+                            "java.lang.Long" "decode"
+                            ["java.lang.String" (~ stringC)]))
+                        (#.Primitive "java.lang.Long" (list))))
+        (test "jvm member invoke virtual"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke virtual"
+                             "java.lang.Object" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke special"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke special"
+                             "java.lang.Long" "equals"
+                             ("jvm object cast" (~ longC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke interface"
+              (success' (` ("jvm object cast"
+                            ("jvm member invoke interface"
+                             "java.util.Collection" "add"
+                             ("jvm object cast" (~ objectC)) ["java.lang.Object" ("jvm object cast" (~ longC))])))
+                        (#.Primitive "java.lang.Boolean" (list))))
+        (test "jvm member invoke constructor"
+              (success' (` ("jvm member invoke constructor"
+                            "java.util.ArrayList"
+                            ["int" ("jvm object cast" (~ intC))]))
+                        (All [a] (#.Primitive "java.util.ArrayList" (list a)))))
+        )))