From 4deb3fc67c9c0cbf04ec8ba7c21b1558b0b415cf Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 30 Dec 2019 03:14:54 -0400
Subject: Re-located generation extensions for JVM.

---
 .../tool/compiler/phase/extension/generation.lux   |   10 -
 .../compiler/phase/extension/generation/jvm.lux    |   19 +
 .../phase/extension/generation/jvm/common.lux      |  450 ++++++++
 .../phase/extension/generation/jvm/host.lux        | 1088 ++++++++++++++++++++
 .../compiler/phase/generation/jvm/extension.lux    |   17 -
 .../phase/generation/jvm/extension/common.lux      |  448 --------
 .../phase/generation/jvm/extension/host.lux        | 1086 -------------------
 7 files changed, 1557 insertions(+), 1561 deletions(-)
 delete mode 100644 stdlib/source/lux/tool/compiler/phase/extension/generation.lux
 create mode 100644 stdlib/source/lux/tool/compiler/phase/extension/generation/jvm.lux
 create mode 100644 stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/common.lux
 create mode 100644 stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/host.lux
 delete mode 100644 stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux
 delete mode 100644 stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
 delete mode 100644 stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/tool/compiler/phase/extension/generation.lux b/stdlib/source/lux/tool/compiler/phase/extension/generation.lux
deleted file mode 100644
index 467adbf35..000000000
--- a/stdlib/source/lux/tool/compiler/phase/extension/generation.lux
+++ /dev/null
@@ -1,10 +0,0 @@
-(.module:
-  [lux #*]
-  [//
-   ["." bundle]
-   [//
-    [generation (#+ Bundle)]]])
-
-(def: #export bundle
-  Bundle
-  bundle.empty)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm.lux
new file mode 100644
index 000000000..93816d128
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm.lux
@@ -0,0 +1,19 @@
+(.module:
+  [lux #*
+   [data
+    [collection
+     ["." dictionary]]]]
+  ["." / #_
+   ["#." common]
+   ["#." host]
+   [////
+    [generation
+     [jvm
+      [runtime (#+ Bundle)]]]]])
+
+(def: #export bundle
+  Bundle
+  ($_ dictionary.merge
+      /common.bundle
+      /host.bundle
+      ))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/common.lux
new file mode 100644
index 000000000..c666c1df5
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/common.lux
@@ -0,0 +1,450 @@
+(.module:
+  [lux (#- Type)
+   [host (#+ import:)]
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try]
+    ["." exception (#+ exception:)]
+    ["<>" parser
+     ["<s>" synthesis (#+ Parser)]]]
+   [data
+    ["." product]
+    [number
+     ["." i32]
+     ["f" frac]]
+    [collection
+     ["." list ("#@." monad)]
+     ["." dictionary]]]
+   [target
+    [jvm
+     ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
+     [encoding
+      ["." signed (#+ S4)]]
+     ["." type (#+ Type)
+      [category (#+ Primitive Class)]]]]]
+  [/////
+   [generation
+    ["///" jvm #_
+     ["#." value]
+     ["#." runtime (#+ Operation Phase Bundle Handler)]
+     ["#." function #_
+      ["#" abstract]]
+     ["//#" ///
+      [generation
+       [extension (#+ Nullary Unary Binary Trinary Variadic
+                      nullary unary binary trinary variadic)]]
+      [extension
+       ["#extension" /]
+       ["#." bundle]]
+      ["/#" //
+       ["#." synthesis (#+ Synthesis %synthesis)]]]]]])
+
+(def: #export (custom [parser handler])
+  (All [s]
+    (-> [(Parser s)
+         (-> Text Phase s (Operation (Bytecode Any)))]
+        Handler))
+  (function (_ extension-name phase input)
+    (case (<s>.run parser input)
+      (#try.Success input')
+      (handler extension-name phase input')
+
+      (#try.Failure error)
+      (/////.throw /////extension.invalid-syntax [extension-name //////synthesis.%synthesis input]))))
+
+(def: $Boolean (type.class "java.lang.Boolean" (list)))
+(def: $Double (type.class "java.lang.Double" (list)))
+(def: $Character (type.class "java.lang.Character" (list)))
+(def: $String (type.class "java.lang.String" (list)))
+(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
+(def: $Object (type.class "java.lang.Object" (list)))
+(def: $PrintStream (type.class "java.io.PrintStream" (list)))
+(def: $System (type.class "java.lang.System" (list)))
+(def: $Error (type.class "java.lang.Error" (list)))
+
+(def: lux-int
+  (Bytecode Any)
+  ($_ _.compose
+      _.i2l
+      (///value.wrap type.long)))
+
+(def: jvm-int
+  (Bytecode Any)
+  ($_ _.compose
+      (///value.unwrap type.long)
+      _.l2i))
+
+(def: ensure-string
+  (Bytecode Any)
+  (_.checkcast $String))
+
+(def: (predicate bytecode)
+  (-> (-> Label (Bytecode Any))
+      (Bytecode Any))
+  (do _.monad
+    [@then _.new-label
+     @end _.new-label]
+    ($_ _.compose
+        (bytecode @then)
+        (_.getstatic $Boolean "FALSE" $Boolean)
+        (_.goto @end)
+        (_.set-label @then)
+        (_.getstatic $Boolean "TRUE" $Boolean)
+        (_.set-label @end)
+        )))
+
+## TODO: Get rid of this ASAP
+(def: lux::syntax-char-case!
+  (..custom [($_ <>.and
+                 <s>.any
+                 <s>.any
+                 (<>.some (<s>.tuple ($_ <>.and
+                                         (<s>.tuple (<>.many <s>.i64))
+                                         <s>.any))))
+             (function (_ extension-name phase [inputS elseS conditionalsS])
+               (do /////.monad
+                 [@end ///runtime.forge-label
+                  inputG (phase inputS)
+                  elseG (phase elseS)
+                  conditionalsG+ (: (Operation (List [(List [S4 Label])
+                                                      (Bytecode Any)]))
+                                    (monad.map @ (function (_ [chars branch])
+                                                   (do @
+                                                     [branchG (phase branch)
+                                                      @branch ///runtime.forge-label]
+                                                     (wrap [(list@map (function (_ char)
+                                                                        [(try.assume (signed.s4 (.int char))) @branch])
+                                                                      chars)
+                                                            ($_ _.compose
+                                                                (_.set-label @branch)
+                                                                branchG
+                                                                (_.goto @end))])))
+                                               conditionalsS))
+                  #let [table (|> conditionalsG+
+                                  (list@map product.left)
+                                  list@join)
+                        conditionalsG (|> conditionalsG+
+                                          (list@map product.right)
+                                          (monad.seq _.monad))]]
+                 (wrap (do _.monad
+                         [@else _.new-label]
+                         ($_ _.compose
+                             inputG (///value.unwrap type.long) _.l2i
+                             (_.lookupswitch @else table)
+                             conditionalsG
+                             (_.set-label @else)
+                             elseG
+                             (_.set-label @end)
+                             )))))]))
+
+(def: (lux::is [referenceG sampleG])
+  (Binary (Bytecode Any))
+  ($_ _.compose
+      referenceG
+      sampleG
+      (..predicate _.if-acmpeq)))
+
+(def: (lux::try riskyG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      riskyG
+      (_.checkcast ///function.class)
+      ///runtime.try))
+
+(def: bundle::lux
+  Bundle
+  (|> (: Bundle /////bundle.empty)
+      (/////bundle.install "syntax char case!" ..lux::syntax-char-case!)
+      (/////bundle.install "is" (binary ..lux::is))
+      (/////bundle.install "try" (unary ..lux::try))))
+
+(template [<name> <op>]
+  [(def: (<name> [maskG inputG])
+     (Binary (Bytecode Any))
+     ($_ _.compose
+         inputG (///value.unwrap type.long)
+         maskG (///value.unwrap type.long)
+         <op> (///value.wrap type.long)))]
+
+  [i64::and _.land]
+  [i64::or  _.lor]
+  [i64::xor _.lxor]
+  )
+
+(template [<name> <op>]
+  [(def: (<name> [shiftG inputG])
+     (Binary (Bytecode Any))
+     ($_ _.compose
+         inputG (///value.unwrap type.long)
+         shiftG ..jvm-int
+         <op> (///value.wrap type.long)))]
+
+  [i64::left-shift             _.lshl]
+  [i64::arithmetic-right-shift _.lshr]
+  [i64::logical-right-shift    _.lushr]
+  )
+
+(import: #long java/lang/Double
+  (#static MIN_VALUE double)
+  (#static MAX_VALUE double))
+
+(template [<name> <const>]
+  [(def: (<name> _)
+     (Nullary (Bytecode Any))
+     ($_ _.compose
+         (_.double <const>)
+         (///value.wrap type.double)))]
+
+  [f64::smallest (java/lang/Double::MIN_VALUE)]
+  [f64::min      (f.* -1.0 (java/lang/Double::MAX_VALUE))]
+  [f64::max      (java/lang/Double::MAX_VALUE)]
+  )
+
+(template [<name> <type> <op>]
+  [(def: (<name> [paramG subjectG])
+     (Binary (Bytecode Any))
+     ($_ _.compose
+         subjectG (///value.unwrap <type>)
+         paramG (///value.unwrap <type>)
+         <op> (///value.wrap <type>)))]
+
+  [i64::+ type.long   _.ladd]
+  [i64::- type.long   _.lsub]
+  [i64::* type.long   _.lmul]
+  [i64::/ type.long   _.ldiv]
+  [i64::% type.long   _.lrem]
+  
+  [f64::+ type.double _.dadd]
+  [f64::- type.double _.dsub]
+  [f64::* type.double _.dmul]
+  [f64::/ type.double _.ddiv]
+  [f64::% type.double _.drem]
+  )
+
+(template [<eq> <lt> <type> <cmp>]
+  [(template [<name> <reference>]
+     [(def: (<name> [paramG subjectG])
+        (Binary (Bytecode Any))
+        ($_ _.compose
+            subjectG (///value.unwrap <type>)
+            paramG (///value.unwrap <type>)
+            <cmp>
+            <reference>
+            (..predicate _.if-icmpeq)))]
+     
+     [<eq> _.iconst-0]
+     [<lt> _.iconst-m1])]
+
+  [i64::= i64::< type.long   _.lcmp]
+  [f64::= f64::< type.double _.dcmpg]
+  )
+
+(def: (to-string class from)
+  (-> (Type Class) (Type Primitive) (Bytecode Any))
+  (_.invokestatic class "toString" (type.method [(list from) ..$String (list)])))
+
+(template [<name> <prepare> <transform>]
+  [(def: (<name> inputG)
+     (Unary (Bytecode Any))
+     ($_ _.compose
+         inputG
+         <prepare>
+         <transform>))]
+
+  [i64::f64
+   (///value.unwrap type.long)
+   ($_ _.compose
+       _.l2d
+       (///value.wrap type.double))]
+
+  [i64::char
+   (///value.unwrap type.long)
+   ($_ _.compose
+       _.l2i
+       _.i2c
+       (..to-string ..$Character type.char))]
+
+  [f64::i64
+   (///value.unwrap type.double)
+   ($_ _.compose
+       _.d2l
+       (///value.wrap type.long))]
+  
+  [f64::encode
+   (///value.unwrap type.double)
+   (..to-string ..$Double type.double)]
+  
+  [f64::decode
+   ..ensure-string
+   ///runtime.decode-frac]
+  )
+
+(def: bundle::i64
+  Bundle
+  (<| (/////bundle.prefix "i64")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "and" (binary ..i64::and))
+          (/////bundle.install "or" (binary ..i64::or))
+          (/////bundle.install "xor" (binary ..i64::xor))
+          (/////bundle.install "left-shift" (binary ..i64::left-shift))
+          (/////bundle.install "logical-right-shift" (binary ..i64::logical-right-shift))
+          (/////bundle.install "arithmetic-right-shift" (binary ..i64::arithmetic-right-shift))
+          (/////bundle.install "=" (binary ..i64::=))
+          (/////bundle.install "<" (binary ..i64::<))
+          (/////bundle.install "+" (binary ..i64::+))
+          (/////bundle.install "-" (binary ..i64::-))
+          (/////bundle.install "*" (binary ..i64::*))
+          (/////bundle.install "/" (binary ..i64::/))
+          (/////bundle.install "%" (binary ..i64::%))
+          (/////bundle.install "f64" (unary ..i64::f64))
+          (/////bundle.install "char" (unary ..i64::char)))))
+
+(def: bundle::f64
+  Bundle
+  (<| (/////bundle.prefix "f64")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary ..f64::+))
+          (/////bundle.install "-" (binary ..f64::-))
+          (/////bundle.install "*" (binary ..f64::*))
+          (/////bundle.install "/" (binary ..f64::/))
+          (/////bundle.install "%" (binary ..f64::%))
+          (/////bundle.install "=" (binary ..f64::=))
+          (/////bundle.install "<" (binary ..f64::<))
+          (/////bundle.install "smallest" (nullary ..f64::smallest))
+          (/////bundle.install "min" (nullary ..f64::min))
+          (/////bundle.install "max" (nullary ..f64::max))
+          (/////bundle.install "i64" (unary ..f64::i64))
+          (/////bundle.install "encode" (unary ..f64::encode))
+          (/////bundle.install "decode" (unary ..f64::decode)))))
+
+(def: (text::size inputG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      inputG
+      ..ensure-string
+      (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)]))
+      ..lux-int))
+
+(def: no-op (Bytecode Any) (_@wrap []))
+
+(template [<name> <pre-subject> <pre-param> <op> <post>]
+  [(def: (<name> [paramG subjectG])
+     (Binary (Bytecode Any))
+     ($_ _.compose
+         subjectG <pre-subject>
+         paramG <pre-param>
+         <op> <post>))]
+
+  [text::= ..no-op ..no-op
+   (_.invokevirtual ..$Object "equals" (type.method [(list ..$Object) type.boolean (list)]))
+   (///value.wrap type.boolean)]
+  [text::< ..ensure-string ..ensure-string
+   (_.invokevirtual ..$String "compareTo" (type.method [(list ..$String) type.int (list)]))
+   (..predicate _.iflt)]
+  [text::char ..ensure-string ..jvm-int
+   (_.invokevirtual ..$String "charAt" (type.method [(list type.int) type.char (list)]))
+   ..lux-int]
+  )
+
+(def: (text::concat [leftG rightG])
+  (Binary (Bytecode Any))
+  ($_ _.compose
+      leftG ..ensure-string
+      rightG ..ensure-string
+      (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)]))))
+
+(def: (text::clip [startG endG subjectG])
+  (Trinary (Bytecode Any))
+  ($_ _.compose
+      subjectG ..ensure-string
+      startG ..jvm-int
+      endG ..jvm-int
+      (_.invokevirtual ..$String "substring" (type.method [(list type.int type.int) ..$String (list)]))))
+
+(def: index-method (type.method [(list ..$String type.int) type.int (list)]))
+(def: (text::index [startG partG textG])
+  (Trinary (Bytecode Any))
+  (do _.monad
+    [@not-found _.new-label
+     @end _.new-label]
+    ($_ _.compose
+        textG ..ensure-string
+        partG ..ensure-string
+        startG ..jvm-int
+        (_.invokevirtual ..$String "indexOf" index-method)
+        _.dup
+        _.iconst-m1
+        (_.if-icmpeq @not-found)
+        ..lux-int
+        ///runtime.some-injection
+        (_.goto @end)
+        (_.set-label @not-found)
+        _.pop
+        ///runtime.none-injection
+        (_.set-label @end))))
+
+(def: bundle::text
+  Bundle
+  (<| (/////bundle.prefix "text")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "=" (binary ..text::=))
+          (/////bundle.install "<" (binary ..text::<))
+          (/////bundle.install "concat" (binary ..text::concat))
+          (/////bundle.install "index" (trinary ..text::index))
+          (/////bundle.install "size" (unary ..text::size))
+          (/////bundle.install "char" (binary ..text::char))
+          (/////bundle.install "clip" (trinary ..text::clip)))))
+
+(def: string-method (type.method [(list ..$String) type.void (list)]))
+(def: (io::log messageG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      (_.getstatic ..$System "out" ..$PrintStream)
+      messageG
+      ..ensure-string
+      (_.invokevirtual ..$PrintStream "println" ..string-method)
+      ///runtime.unit))
+
+(def: (io::error messageG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      (_.new ..$Error)
+      _.dup
+      messageG
+      ..ensure-string
+      (_.invokespecial ..$Error "<init>" ..string-method)
+      _.athrow))
+
+(def: exit-method (type.method [(list type.int) type.void (list)]))
+(def: (io::exit codeG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      codeG ..jvm-int
+      (_.invokestatic ..$System "exit" ..exit-method)
+      _.aconst-null))
+
+(def: time-method (type.method [(list) type.long (list)]))
+(def: (io::current-time _)
+  (Nullary (Bytecode Any))
+  ($_ _.compose
+      (_.invokestatic ..$System "currentTimeMillis" ..time-method)
+      (///value.wrap type.long)))
+
+(def: bundle::io
+  Bundle
+  (<| (/////bundle.prefix "io")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "log" (unary ..io::log))
+          (/////bundle.install "error" (unary ..io::error))
+          (/////bundle.install "exit" (unary ..io::exit))
+          (/////bundle.install "current-time" (nullary ..io::current-time)))))
+
+(def: #export bundle
+  Bundle
+  (<| (/////bundle.prefix "lux")
+      (|> bundle::lux
+          (dictionary.merge ..bundle::i64)
+          (dictionary.merge ..bundle::f64)
+          (dictionary.merge ..bundle::text)
+          (dictionary.merge ..bundle::io))))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/host.lux
new file mode 100644
index 000000000..6c8253c12
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/generation/jvm/host.lux
@@ -0,0 +1,1088 @@
+(.module:
+  [lux (#- Type)
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try]
+    ["." exception (#+ exception:)]
+    ["<>" parser
+     ["<t>" text]
+     ["<s>" synthesis (#+ Parser)]]]
+   [data
+    ["." product]
+    ["." maybe]
+    ["." text ("#@." equivalence)]
+    [number
+     ["." i32]]
+    [collection
+     ["." list ("#@." monad)]
+     ["." dictionary (#+ Dictionary)]
+     ["." set]
+     ["." row]]
+    ["." format #_
+     ["#" binary]]]
+   [target
+    [jvm
+     ["." version]
+     ["." modifier ("#@." monoid)]
+     ["." method (#+ Method)]
+     ["." class (#+ Class)]
+     [constant
+      [pool (#+ Resource)]]
+     [encoding
+      ["." name]]
+     ["_" bytecode (#+ Label Bytecode) ("#@." monad)
+      ["__" instruction (#+ Primitive-Array-Type)]]
+     ["." type (#+ Type Typed Argument)
+      ["." category (#+ Void Value' Value Return' Return Primitive Object Array Var Parameter)]
+      ["." box]
+      ["." reflection]
+      ["." signature]
+      ["." parser]]]]]
+  [//
+   [common (#+ custom)]
+   [////
+    [generation
+     ["///" jvm
+      [runtime (#+ Operation Bundle Handler)]
+      ["#." reference]
+      [function
+       [field
+        [variable
+         ["." foreign]]]]
+      ["//#" ///
+       [generation
+        [extension (#+ Nullary Unary Binary Trinary Variadic
+                       nullary unary binary trinary variadic)]]
+       [extension
+        ["#." bundle]
+        [analysis
+         ["/" jvm]]]
+       ["/#" //
+        ["#." reference (#+ Variable)]
+        [analysis (#+ Environment)]
+        ["#." synthesis (#+ Synthesis Path %synthesis)]
+        ["#." generation]]]]]]])
+
+(template [<name> <0> <1>]
+  [(def: <name>
+     (Bytecode Any)
+     ($_ _.compose
+         <0>
+         <1>))]
+
+  [l2s _.l2i _.i2s]
+  [l2b _.l2i _.i2b]
+  [l2c _.l2i _.i2c]
+  )
+
+(template [<conversion> <name>]
+  [(def: (<name> inputG)
+     (Unary (Bytecode Any))
+     (if (is? _.nop <conversion>)
+       inputG
+       ($_ _.compose
+           inputG
+           <conversion>)))]
+  
+  [_.d2f conversion::double-to-float]
+  [_.d2i conversion::double-to-int]
+  [_.d2l conversion::double-to-long]
+  [_.f2d conversion::float-to-double]
+  [_.f2i conversion::float-to-int]
+  [_.f2l conversion::float-to-long]
+  [_.i2b conversion::int-to-byte]
+  [_.i2c conversion::int-to-char]
+  [_.i2d conversion::int-to-double]
+  [_.i2f conversion::int-to-float]
+  [_.i2l conversion::int-to-long]
+  [_.i2s conversion::int-to-short]
+  [_.l2d conversion::long-to-double]
+  [_.l2f conversion::long-to-float]
+  [_.l2i conversion::long-to-int]
+  [..l2s conversion::long-to-short]
+  [..l2b conversion::long-to-byte]
+  [..l2c conversion::long-to-char]
+  [_.i2b conversion::char-to-byte]
+  [_.i2s conversion::char-to-short]
+  [_.nop conversion::char-to-int]
+  [_.i2l conversion::char-to-long]
+  [_.i2l conversion::byte-to-long]
+  [_.i2l conversion::short-to-long]
+  )
+
+(def: bundle::conversion
+  Bundle
+  (<| (/////bundle.prefix "conversion")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "double-to-float" (unary conversion::double-to-float))
+          (/////bundle.install "double-to-int" (unary conversion::double-to-int))
+          (/////bundle.install "double-to-long" (unary conversion::double-to-long))
+          (/////bundle.install "float-to-double" (unary conversion::float-to-double))
+          (/////bundle.install "float-to-int" (unary conversion::float-to-int))
+          (/////bundle.install "float-to-long" (unary conversion::float-to-long))
+          (/////bundle.install "int-to-byte" (unary conversion::int-to-byte))
+          (/////bundle.install "int-to-char" (unary conversion::int-to-char))
+          (/////bundle.install "int-to-double" (unary conversion::int-to-double))
+          (/////bundle.install "int-to-float" (unary conversion::int-to-float))
+          (/////bundle.install "int-to-long" (unary conversion::int-to-long))
+          (/////bundle.install "int-to-short" (unary conversion::int-to-short))
+          (/////bundle.install "long-to-double" (unary conversion::long-to-double))
+          (/////bundle.install "long-to-float" (unary conversion::long-to-float))
+          (/////bundle.install "long-to-int" (unary conversion::long-to-int))
+          (/////bundle.install "long-to-short" (unary conversion::long-to-short))
+          (/////bundle.install "long-to-byte" (unary conversion::long-to-byte))
+          (/////bundle.install "long-to-char" (unary conversion::long-to-char))
+          (/////bundle.install "char-to-byte" (unary conversion::char-to-byte))
+          (/////bundle.install "char-to-short" (unary conversion::char-to-short))
+          (/////bundle.install "char-to-int" (unary conversion::char-to-int))
+          (/////bundle.install "char-to-long" (unary conversion::char-to-long))
+          (/////bundle.install "byte-to-long" (unary conversion::byte-to-long))
+          (/////bundle.install "short-to-long" (unary conversion::short-to-long))
+          )))
+
+(template [<name> <op>]
+  [(def: (<name> [xG yG])
+     (Binary (Bytecode Any))
+     ($_ _.compose
+         xG
+         yG
+         <op>))]
+
+  [int::+ _.iadd]
+  [int::- _.isub]
+  [int::* _.imul]
+  [int::/ _.idiv]
+  [int::% _.irem]
+  [int::and _.iand]
+  [int::or _.ior]
+  [int::xor _.ixor]
+  [int::shl _.ishl]
+  [int::shr _.ishr]
+  [int::ushr _.iushr]
+  
+  [long::+ _.ladd]
+  [long::- _.lsub]
+  [long::* _.lmul]
+  [long::/ _.ldiv]
+  [long::% _.lrem]
+  [long::and _.land]
+  [long::or _.lor]
+  [long::xor _.lxor]
+  [long::shl _.lshl]
+  [long::shr _.lshr]
+  [long::ushr _.lushr]
+
+  [float::+ _.fadd]
+  [float::- _.fsub]
+  [float::* _.fmul]
+  [float::/ _.fdiv]
+  [float::% _.frem]
+  
+  [double::+ _.dadd]
+  [double::- _.dsub]
+  [double::* _.dmul]
+  [double::/ _.ddiv]
+  [double::% _.drem]
+  )
+
+(def: $Boolean (type.class box.boolean (list)))
+(def: falseG (_.getstatic ..$Boolean "FALSE" ..$Boolean))
+(def: trueG (_.getstatic ..$Boolean "TRUE" ..$Boolean))
+
+(template [<name> <op>]
+  [(def: (<name> [xG yG])
+     (Binary (Bytecode Any))
+     (do _.monad
+       [@then _.new-label
+        @end _.new-label]
+       ($_ _.compose
+           xG
+           yG
+           (<op> @then)
+           falseG
+           (_.goto @end)
+           (_.set-label @then)
+           trueG
+           (_.set-label @end))))]
+
+  [int::= _.if-icmpeq]
+  [int::< _.if-icmplt]
+
+  [char::= _.if-icmpeq]
+  [char::< _.if-icmplt]
+  )
+
+(template [<name> <op> <reference>]
+  [(def: (<name> [xG yG])
+     (Binary (Bytecode Any))
+     (do _.monad
+       [@then _.new-label
+        @end _.new-label]
+       ($_ _.compose
+           xG
+           yG
+           <op>
+           (_.int (i32.i32 (.i64 <reference>)))
+           (_.if-icmpeq @then)
+           falseG
+           (_.goto @end)
+           (_.set-label @then)
+           trueG
+           (_.set-label @end))))]
+
+  [long::= _.lcmp +0]
+  [long::< _.lcmp -1]
+  
+  [float::= _.fcmpg +0]
+  [float::< _.fcmpg -1]
+
+  [double::= _.dcmpg +0]
+  [double::< _.dcmpg -1]
+  )
+
+(def: bundle::int
+  Bundle
+  (<| (/////bundle.prefix (reflection.reflection reflection.int))
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary int::+))
+          (/////bundle.install "-" (binary int::-))
+          (/////bundle.install "*" (binary int::*))
+          (/////bundle.install "/" (binary int::/))
+          (/////bundle.install "%" (binary int::%))
+          (/////bundle.install "=" (binary int::=))
+          (/////bundle.install "<" (binary int::<))
+          (/////bundle.install "and" (binary int::and))
+          (/////bundle.install "or" (binary int::or))
+          (/////bundle.install "xor" (binary int::xor))
+          (/////bundle.install "shl" (binary int::shl))
+          (/////bundle.install "shr" (binary int::shr))
+          (/////bundle.install "ushr" (binary int::ushr))
+          )))
+
+(def: bundle::long
+  Bundle
+  (<| (/////bundle.prefix (reflection.reflection reflection.long))
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary long::+))
+          (/////bundle.install "-" (binary long::-))
+          (/////bundle.install "*" (binary long::*))
+          (/////bundle.install "/" (binary long::/))
+          (/////bundle.install "%" (binary long::%))
+          (/////bundle.install "=" (binary long::=))
+          (/////bundle.install "<" (binary long::<))
+          (/////bundle.install "and" (binary long::and))
+          (/////bundle.install "or" (binary long::or))
+          (/////bundle.install "xor" (binary long::xor))
+          (/////bundle.install "shl" (binary long::shl))
+          (/////bundle.install "shr" (binary long::shr))
+          (/////bundle.install "ushr" (binary long::ushr))
+          )))
+
+(def: bundle::float
+  Bundle
+  (<| (/////bundle.prefix (reflection.reflection reflection.float))
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary float::+))
+          (/////bundle.install "-" (binary float::-))
+          (/////bundle.install "*" (binary float::*))
+          (/////bundle.install "/" (binary float::/))
+          (/////bundle.install "%" (binary float::%))
+          (/////bundle.install "=" (binary float::=))
+          (/////bundle.install "<" (binary float::<))
+          )))
+
+(def: bundle::double
+  Bundle
+  (<| (/////bundle.prefix (reflection.reflection reflection.double))
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "+" (binary double::+))
+          (/////bundle.install "-" (binary double::-))
+          (/////bundle.install "*" (binary double::*))
+          (/////bundle.install "/" (binary double::/))
+          (/////bundle.install "%" (binary double::%))
+          (/////bundle.install "=" (binary double::=))
+          (/////bundle.install "<" (binary double::<))
+          )))
+
+(def: bundle::char
+  Bundle
+  (<| (/////bundle.prefix (reflection.reflection reflection.char))
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "=" (binary char::=))
+          (/////bundle.install "<" (binary char::<))
+          )))
+
+(template [<name> <category> <parser>]
+  [(def: #export <name>
+     (Parser (Type <category>))
+     (<t>.embed <parser> <s>.text))]
+
+  [var Var parser.var]
+  [class category.Class parser.class]
+  [object Object parser.object]
+  [value Value parser.value]
+  [return Return parser.return]
+  )
+
+(exception: #export (not-an-object-array {arrayJT (Type Array)})
+  (exception.report
+   ["JVM Type" (|> arrayJT type.signature signature.signature)]))
+
+(def: #export object-array
+  (Parser (Type Object))
+  (do <>.monad
+    [arrayJT (<t>.embed parser.array <s>.text)]
+    (case (parser.array? arrayJT)
+      (#.Some elementJT)
+      (case (parser.object? elementJT)
+        (#.Some elementJT)
+        (wrap elementJT)
+
+        #.None
+        (<>.fail (exception.construct ..not-an-object-array arrayJT)))
+      
+      #.None
+      (undefined))))
+
+(def: (primitive-array-length-handler jvm-primitive)
+  (-> (Type Primitive) Handler)
+  (..custom
+   [<s>.any
+    (function (_ extension-name generate arrayS)
+      (do /////.monad
+        [arrayG (generate arrayS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array jvm-primitive))
+                  _.arraylength))))]))
+
+(def: array::length::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any)
+    (function (_ extension-name generate [elementJT arrayS])
+      (do /////.monad
+        [arrayG (generate arrayS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array elementJT))
+                  _.arraylength))))]))
+
+(def: (new-primitive-array-handler jvm-primitive)
+  (-> Primitive-Array-Type Handler)
+  (..custom
+   [<s>.any
+    (function (_ extension-name generate [lengthS])
+      (do /////.monad
+        [lengthG (generate lengthS)]
+        (wrap ($_ _.compose
+                  lengthG
+                  (_.newarray jvm-primitive)))))]))
+
+(def: array::new::object
+  Handler
+  (..custom
+   [($_ <>.and ..object <s>.any)
+    (function (_ extension-name generate [objectJT lengthS])
+      (do /////.monad
+        [lengthG (generate lengthS)]
+        (wrap ($_ _.compose
+                  lengthG
+                  (_.anewarray objectJT)))))]))
+
+(def: (read-primitive-array-handler jvm-primitive loadG)
+  (-> (Type Primitive) (Bytecode Any) Handler)
+  (..custom
+   [($_ <>.and <s>.any <s>.any)
+    (function (_ extension-name generate [idxS arrayS])
+      (do /////.monad
+        [arrayG (generate arrayS)
+         idxG (generate idxS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array jvm-primitive))
+                  idxG
+                  loadG))))]))
+
+(def: array::read::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any <s>.any)
+    (function (_ extension-name generate [elementJT idxS arrayS])
+      (do /////.monad
+        [arrayG (generate arrayS)
+         idxG (generate idxS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array elementJT))
+                  idxG
+                  _.aaload))))]))
+
+(def: (write-primitive-array-handler jvm-primitive storeG)
+  (-> (Type Primitive) (Bytecode Any) Handler)
+  (..custom
+   [($_ <>.and <s>.any <s>.any <s>.any)
+    (function (_ extension-name generate [idxS valueS arrayS])
+      (do /////.monad
+        [arrayG (generate arrayS)
+         idxG (generate idxS)
+         valueG (generate valueS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array jvm-primitive))
+                  _.dup
+                  idxG
+                  valueG
+                  storeG))))]))
+
+(def: array::write::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any <s>.any <s>.any)
+    (function (_ extension-name generate [elementJT idxS valueS arrayS])
+      (do /////.monad
+        [arrayG (generate arrayS)
+         idxG (generate idxS)
+         valueG (generate valueS)]
+        (wrap ($_ _.compose
+                  arrayG
+                  (_.checkcast (type.array elementJT))
+                  _.dup
+                  idxG
+                  valueG
+                  _.aastore))))]))
+
+(def: bundle::array
+  Bundle
+  (<| (/////bundle.prefix "array")
+      (|> /////bundle.empty
+          (dictionary.merge (<| (/////bundle.prefix "length")
+                                (|> /////bundle.empty
+                                    (/////bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean))
+                                    (/////bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte))
+                                    (/////bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short))
+                                    (/////bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int))
+                                    (/////bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long))
+                                    (/////bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float))
+                                    (/////bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double))
+                                    (/////bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char))
+                                    (/////bundle.install "object" array::length::object))))
+          (dictionary.merge (<| (/////bundle.prefix "new")
+                                (|> /////bundle.empty
+                                    (/////bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler __.t-boolean))
+                                    (/////bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler __.t-byte))
+                                    (/////bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler __.t-short))
+                                    (/////bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler __.t-int))
+                                    (/////bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler __.t-long))
+                                    (/////bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler __.t-float))
+                                    (/////bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler __.t-double))
+                                    (/////bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler __.t-char))
+                                    (/////bundle.install "object" array::new::object))))
+          (dictionary.merge (<| (/////bundle.prefix "read")
+                                (|> /////bundle.empty
+                                    (/////bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.baload))
+                                    (/////bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.baload))
+                                    (/////bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.saload))
+                                    (/////bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.iaload))
+                                    (/////bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.laload))
+                                    (/////bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.faload))
+                                    (/////bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.daload))
+                                    (/////bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.caload))
+                                    (/////bundle.install "object" array::read::object))))
+          (dictionary.merge (<| (/////bundle.prefix "write")
+                                (|> /////bundle.empty
+                                    (/////bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.bastore))
+                                    (/////bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.bastore))
+                                    (/////bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.sastore))
+                                    (/////bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.iastore))
+                                    (/////bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.lastore))
+                                    (/////bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.fastore))
+                                    (/////bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.dastore))
+                                    (/////bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.castore))
+                                    (/////bundle.install "object" array::write::object))))
+          )))
+
+(def: (object::null _)
+  (Nullary (Bytecode Any))
+  _.aconst-null)
+
+(def: (object::null? objectG)
+  (Unary (Bytecode Any))
+  (do _.monad
+    [@then _.new-label
+     @end _.new-label]
+    ($_ _.compose
+        objectG
+        (_.ifnull @then)
+        ..falseG
+        (_.goto @end)
+        (_.set-label @then)
+        ..trueG
+        (_.set-label @end))))
+
+(def: (object::synchronized [monitorG exprG])
+  (Binary (Bytecode Any))
+  ($_ _.compose
+      monitorG
+      _.dup
+      _.monitorenter
+      exprG
+      _.swap
+      _.monitorexit))
+
+(def: (object::throw exceptionG)
+  (Unary (Bytecode Any))
+  ($_ _.compose
+      exceptionG
+      _.athrow))
+
+(def: $Class (type.class "java.lang.Class" (list)))
+(def: $String (type.class "java.lang.String" (list)))
+
+(def: object::class
+  Handler
+  (..custom
+   [<s>.text
+    (function (_ extension-name generate [class])
+      (do /////.monad
+        []
+        (wrap ($_ _.compose
+                  (_.string class)
+                  (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))]))
+
+(def: object::instance?
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.any)
+    (function (_ extension-name generate [class objectS])
+      (do /////.monad
+        [objectG (generate objectS)]
+        (wrap ($_ _.compose
+                  objectG
+                  (_.instanceof (type.class class (list)))
+                  (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))]))
+
+(def: reflection
+  (All [category]
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> type.reflection reflection.reflection))
+
+(def: object::cast
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.any)
+    (function (_ extension-name generate [from to valueS])
+      (do /////.monad
+        [valueG (generate valueS)]
+        (wrap (`` (cond (~~ (template [<object> <type> <unwrap>]
+                              [(and (text@= (..reflection <type>)
+                                            from)
+                                    (text@= <object>
+                                            to))
+                               (let [$<object> (type.class <object> (list))]
+                                 ($_ _.compose
+                                     valueG
+                                     (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)]))))
+
+                               (and (text@= <object>
+                                            from)
+                                    (text@= (..reflection <type>)
+                                            to))
+                               (let [$<object> (type.class <object> (list))]
+                                 ($_ _.compose
+                                     valueG
+                                     (_.checkcast $<object>)
+                                     (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))]
+                              
+                              [box.boolean type.boolean "booleanValue"]
+                              [box.byte    type.byte    "byteValue"]
+                              [box.short   type.short   "shortValue"]
+                              [box.int     type.int     "intValue"]
+                              [box.long    type.long    "longValue"]
+                              [box.float   type.float   "floatValue"]
+                              [box.double  type.double  "doubleValue"]
+                              [box.char    type.char    "charValue"]))
+                        ## else
+                        valueG)))))]))
+
+(def: bundle::object
+  Bundle
+  (<| (/////bundle.prefix "object")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "null" (nullary object::null))
+          (/////bundle.install "null?" (unary object::null?))
+          (/////bundle.install "synchronized" (binary object::synchronized))
+          (/////bundle.install "throw" (unary object::throw))
+          (/////bundle.install "class" object::class)
+          (/////bundle.install "instance?" object::instance?)
+          (/////bundle.install "cast" object::cast)
+          )))
+
+(def: primitives
+  (Dictionary Text (Type Primitive))
+  (|> (list [(reflection.reflection reflection.boolean) type.boolean]
+            [(reflection.reflection reflection.byte) type.byte]
+            [(reflection.reflection reflection.short) type.short]
+            [(reflection.reflection reflection.int) type.int]
+            [(reflection.reflection reflection.long) type.long]
+            [(reflection.reflection reflection.float) type.float]
+            [(reflection.reflection reflection.double) type.double]
+            [(reflection.reflection reflection.char) type.char])
+      (dictionary.from-list text.hash)))
+
+(def: get::static
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text)
+    (function (_ extension-name generate [class field unboxed])
+      (do /////.monad
+        [#let [$class (type.class class (list))]]
+        (case (dictionary.get unboxed ..primitives)
+          (#.Some primitive)
+          (wrap (_.getstatic $class field primitive))
+          
+          #.None
+          (wrap (_.getstatic $class field (type.class unboxed (list)))))))]))
+
+(def: unitG (_.string //////synthesis.unit))
+
+(def: put::static
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+    (function (_ extension-name generate [class field unboxed valueS])
+      (do /////.monad
+        [valueG (generate valueS)
+         #let [$class (type.class class (list))]]
+        (case (dictionary.get unboxed ..primitives)
+          (#.Some primitive)
+          (wrap ($_ _.compose
+                    valueG
+                    (_.putstatic $class field primitive)
+                    ..unitG))
+          
+          #.None
+          (wrap ($_ _.compose
+                    valueG
+                    (_.checkcast $class)
+                    (_.putstatic $class field $class)
+                    ..unitG)))))]))
+
+(def: get::virtual
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+    (function (_ extension-name generate [class field unboxed objectS])
+      (do /////.monad
+        [objectG (generate objectS)
+         #let [$class (type.class class (list))
+               getG (case (dictionary.get unboxed ..primitives)
+                      (#.Some primitive)
+                      (_.getfield $class field primitive)
+                      
+                      #.None
+                      (_.getfield $class field (type.class unboxed (list))))]]
+        (wrap ($_ _.compose
+                  objectG
+                  (_.checkcast $class)
+                  getG))))]))
+
+(def: put::virtual
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any)
+    (function (_ extension-name generate [class field unboxed valueS objectS])
+      (do /////.monad
+        [valueG (generate valueS)
+         objectG (generate objectS)
+         #let [$class (type.class class (list))
+               putG (case (dictionary.get unboxed ..primitives)
+                      (#.Some primitive)
+                      (_.putfield $class field primitive)
+                      
+                      #.None
+                      (let [$unboxed (type.class unboxed (list))]
+                        ($_ _.compose
+                            (_.checkcast $unboxed)
+                            (_.putfield $class field $unboxed))))]]
+        (wrap ($_ _.compose
+                  objectG
+                  (_.checkcast $class)
+                  _.dup
+                  valueG
+                  putG))))]))
+
+(type: Input (Typed Synthesis))
+
+(def: input
+  (Parser Input)
+  (<s>.tuple (<>.and ..value <s>.any)))
+
+(def: (generate-input generate [valueT valueS])
+  (-> (-> Synthesis (Operation (Bytecode Any))) Input
+      (Operation (Typed (Bytecode Any))))
+  (do /////.monad
+    [valueG (generate valueS)]
+    (case (type.primitive? valueT)
+      (#.Right valueT)
+      (wrap [valueT valueG])
+      
+      (#.Left valueT)
+      (wrap [valueT ($_ _.compose
+                        valueG
+                        (_.checkcast valueT))]))))
+
+(def: (prepare-output outputT)
+  (-> (Type Return) (Bytecode Any))
+  (case (type.void? outputT)
+    (#.Right outputT)
+    ..unitG
+    
+    (#.Left outputT)
+    (:: _.monad wrap [])))
+
+(def: invoke::static
+  Handler
+  (..custom
+   [($_ <>.and ..class <s>.text ..return (<>.some ..input))
+    (function (_ extension-name generate [class method outputT inputsTS])
+      (do /////.monad
+        [inputsTG (monad.map @ (generate-input generate) inputsTS)]
+        (wrap ($_ _.compose
+                  (monad.map _.monad product.right inputsTG)
+                  (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)]))
+                  (prepare-output outputT)))))]))
+
+(template [<name> <invoke>]
+  [(def: <name>
+     Handler
+     (..custom
+      [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input))
+       (function (_ extension-name generate [class method outputT objectS inputsTS])
+         (do /////.monad
+           [objectG (generate objectS)
+            inputsTG (monad.map @ (generate-input generate) inputsTS)]
+           (wrap ($_ _.compose
+                     objectG
+                     (_.checkcast class)
+                     (monad.map _.monad product.right inputsTG)
+                     (<invoke> class method (type.method [(list@map product.left inputsTG) outputT (list)]))
+                     (prepare-output outputT)))))]))]
+
+  [invoke::virtual _.invokevirtual]
+  [invoke::special _.invokespecial]
+  [invoke::interface _.invokeinterface]
+  )
+
+(def: invoke::constructor
+  Handler
+  (..custom
+   [($_ <>.and ..class (<>.some ..input))
+    (function (_ extension-name generate [class inputsTS])
+      (do /////.monad
+        [inputsTG (monad.map @ (generate-input generate) inputsTS)]
+        (wrap ($_ _.compose
+                  (_.new class)
+                  _.dup
+                  (monad.map _.monad product.right inputsTG)
+                  (_.invokespecial class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))))))]))
+
+(def: bundle::member
+  Bundle
+  (<| (/////bundle.prefix "member")
+      (|> (: Bundle /////bundle.empty)
+          (dictionary.merge (<| (/////bundle.prefix "get")
+                                (|> (: Bundle /////bundle.empty)
+                                    (/////bundle.install "static" get::static)
+                                    (/////bundle.install "virtual" get::virtual))))
+          (dictionary.merge (<| (/////bundle.prefix "put")
+                                (|> (: Bundle /////bundle.empty)
+                                    (/////bundle.install "static" put::static)
+                                    (/////bundle.install "virtual" put::virtual))))
+          (dictionary.merge (<| (/////bundle.prefix "invoke")
+                                (|> (: Bundle /////bundle.empty)
+                                    (/////bundle.install "static" invoke::static)
+                                    (/////bundle.install "virtual" invoke::virtual)
+                                    (/////bundle.install "special" invoke::special)
+                                    (/////bundle.install "interface" invoke::interface)
+                                    (/////bundle.install "constructor" invoke::constructor))))
+          )))
+
+(def: annotation-parameter
+  (Parser (/.Annotation-Parameter Synthesis))
+  (<s>.tuple (<>.and <s>.text <s>.any)))
+
+(def: annotation
+  (Parser (/.Annotation Synthesis))
+  (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter))))
+
+(def: argument
+  (Parser Argument)
+  (<s>.tuple (<>.and <s>.text ..value)))
+
+(def: overriden-method-definition
+  (Parser [Environment (/.Overriden-Method Synthesis)])
+  (<s>.tuple (do <>.monad
+               [_ (<s>.text! /.overriden-tag)
+                ownerT ..class
+                name <s>.text
+                strict-fp? <s>.bit
+                annotations (<s>.tuple (<>.some ..annotation))
+                vars (<s>.tuple (<>.some ..var))
+                self-name <s>.text
+                arguments (<s>.tuple (<>.some ..argument))
+                returnT ..return
+                exceptionsT (<s>.tuple (<>.some ..class))
+                [environment body] (<s>.function 1
+                                     (<s>.tuple <s>.any))]
+               (wrap [environment
+                      [ownerT name
+                       strict-fp? annotations vars
+                       self-name arguments returnT exceptionsT
+                       body]]))))
+
+(def: (normalize-path normalize)
+  (-> (-> Synthesis Synthesis)
+      (-> Path Path))
+  (function (recur path)
+    (case path
+      (^ (//////synthesis.path/then bodyS))
+      (//////synthesis.path/then (normalize bodyS))
+
+      (^template [<tag>]
+        (^ (<tag> leftP rightP))
+        (<tag> (recur leftP) (recur rightP)))
+      ([#//////synthesis.Alt]
+       [#//////synthesis.Seq])
+
+      (^template [<tag>]
+        (^ (<tag> value))
+        path)
+      ([#//////synthesis.Pop]
+       [#//////synthesis.Test]
+       [#//////synthesis.Bind]
+       [#//////synthesis.Access]))))
+
+(def: (normalize-method-body mapping)
+  (-> (Dictionary Variable Variable) Synthesis Synthesis)
+  (function (recur body)
+    (case body
+      (^template [<tag>]
+        (^ (<tag> value))
+        body)
+      ([#//////synthesis.Primitive]
+       [//////synthesis.constant])
+
+      (^ (//////synthesis.variant [lefts right? sub]))
+      (//////synthesis.variant [lefts right? (recur sub)])
+
+      (^ (//////synthesis.tuple members))
+      (//////synthesis.tuple (list@map recur members))
+
+      (^ (//////synthesis.variable var))
+      (|> mapping
+          (dictionary.get var)
+          (maybe.default var)
+          //////synthesis.variable)
+
+      (^ (//////synthesis.branch/case [inputS pathS]))
+      (//////synthesis.branch/case [(recur inputS) (normalize-path recur pathS)])
+
+      (^ (//////synthesis.branch/let [inputS register outputS]))
+      (//////synthesis.branch/let [(recur inputS) register (recur outputS)])
+
+      (^ (//////synthesis.branch/if [testS thenS elseS]))
+      (//////synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
+
+      (^ (//////synthesis.loop/scope [offset initsS+ bodyS]))
+      (//////synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
+
+      (^ (//////synthesis.loop/recur updatesS+))
+      (//////synthesis.loop/recur (list@map recur updatesS+))
+
+      (^ (//////synthesis.function/abstraction [environment arity bodyS]))
+      (//////synthesis.function/abstraction [(|> environment (list@map (function (_ local)
+                                                                         (|> mapping
+                                                                             (dictionary.get local)
+                                                                             (maybe.default local)))))
+                                             arity
+                                             bodyS])
+
+      (^ (//////synthesis.function/apply [functionS inputsS+]))
+      (//////synthesis.function/apply [(recur functionS) (list@map recur inputsS+)])
+
+      (#//////synthesis.Extension [name inputsS+])
+      (#//////synthesis.Extension [name (list@map recur inputsS+)]))))
+
+(def: $Object (type.class "java.lang.Object" (list)))
+
+(def: (anonymous-init-method env)
+  (-> Environment (Type category.Method))
+  (type.method [(list.repeat (list.size env) ..$Object)
+                type.void
+                (list)]))
+
+(def: (with-anonymous-init class env super-class inputsTG)
+  (-> (Type category.Class) Environment (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method))
+  (let [store-capturedG (|> env
+                            list.size
+                            list.indices
+                            (monad.map _.monad (.function (_ register)
+                                                 ($_ _.compose
+                                                     (_.aload 0)
+                                                     (_.aload (inc register))
+                                                     (_.putfield class (///reference.foreign-name register) $Object)))))]
+    (method.method method.public "<init>" (anonymous-init-method env)
+                   (list)
+                   (#.Some ($_ _.compose
+                               (_.aload 0)
+                               (monad.map _.monad product.right inputsTG)
+                               (_.invokespecial super-class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))
+                               store-capturedG
+                               _.return)))))
+
+(def: (anonymous-instance class env)
+  (-> (Type category.Class) Environment (Operation (Bytecode Any)))
+  (do /////.monad
+    [captureG+ (monad.map @ ///reference.variable env)]
+    (wrap ($_ _.compose
+              (_.new class)
+              _.dup
+              (monad.seq _.monad captureG+)
+              (_.invokespecial class "<init>" (anonymous-init-method env))))))
+
+(def: (returnG returnT)
+  (-> (Type Return) (Bytecode Any))
+  (case (type.void? returnT)
+    (#.Right returnT)
+    _.return
+
+    (#.Left returnT)
+    (case (type.primitive? returnT)
+      (#.Left returnT)
+      ($_ _.compose
+          (_.checkcast returnT)
+          _.areturn)
+      
+      (#.Right returnT)
+      (cond (or (:: type.equivalence = type.boolean returnT)
+                (:: type.equivalence = type.byte returnT)
+                (:: type.equivalence = type.short returnT)
+                (:: type.equivalence = type.int returnT)
+                (:: type.equivalence = type.char returnT))
+            _.ireturn
+
+            (:: type.equivalence = type.long returnT)
+            _.lreturn
+
+            (:: type.equivalence = type.float returnT)
+            _.freturn
+
+            ## (:: type.equivalence = type.double returnT)
+            _.dreturn))))
+
+(def: class::anonymous
+  Handler
+  (..custom
+   [($_ <>.and
+        <s>.text
+        ..class
+        (<s>.tuple (<>.some ..class))
+        (<s>.tuple (<>.some ..input))
+        (<s>.tuple (<>.some ..overriden-method-definition)))
+    (function (_ extension-name generate [class-name
+                                          super-class super-interfaces
+                                          inputsTS
+                                          overriden-methods])
+      (do /////.monad
+        [#let [class (type.class class-name (list))
+               total-environment (|> overriden-methods
+                                     ## Get all the environments.
+                                     (list@map product.left)
+                                     ## Combine them.
+                                     list@join
+                                     ## Remove duplicates.
+                                     (set.from-list //////reference.hash)
+                                     set.to-list)
+               global-mapping (|> total-environment
+                                  ## Give them names as "foreign" variables.
+                                  list.enumerate
+                                  (list@map (function (_ [id capture])
+                                              [capture (#//////reference.Foreign id)]))
+                                  (dictionary.from-list //////reference.hash))
+               normalized-methods (list@map (function (_ [environment
+                                                          [ownerT name
+                                                           strict-fp? annotations vars
+                                                           self-name arguments returnT exceptionsT
+                                                           body]])
+                                              (let [local-mapping (|> environment
+                                                                      list.enumerate
+                                                                      (list@map (function (_ [foreign-id capture])
+                                                                                  [(#//////reference.Foreign foreign-id)
+                                                                                   (|> global-mapping
+                                                                                       (dictionary.get capture)
+                                                                                       maybe.assume)]))
+                                                                      (dictionary.from-list //////reference.hash))]
+                                                [ownerT name
+                                                 strict-fp? annotations vars
+                                                 self-name arguments returnT exceptionsT
+                                                 (normalize-method-body local-mapping body)]))
+                                            overriden-methods)]
+         inputsTI (monad.map @ (generate-input generate) inputsTS)
+         method-definitions (monad.map @ (function (_ [ownerT name
+                                                       strict-fp? annotations vars
+                                                       self-name arguments returnT exceptionsT
+                                                       bodyS])
+                                           (do @
+                                             [bodyG (//////generation.with-specific-context class-name
+                                                      (generate bodyS))]
+                                             (wrap (method.method ($_ modifier@compose
+                                                                      method.public
+                                                                      method.final
+                                                                      (if strict-fp?
+                                                                        method.strict
+                                                                        modifier@identity))
+                                                                  name
+                                                                  (type.method [(list@map product.right arguments)
+                                                                                returnT
+                                                                                exceptionsT])
+                                                                  (list)
+                                                                  (#.Some ($_ _.compose
+                                                                              bodyG
+                                                                              (returnG returnT)))))))
+                                       normalized-methods)
+         bytecode (<| (:: @ map (format.run class.writer))
+                      /////.lift
+                      (class.class version.v6_0 ($_ modifier@compose class.public class.final)
+                                   (name.internal class-name)
+                                   (name.internal (..reflection super-class))
+                                   (list@map (|>> ..reflection name.internal) super-interfaces)
+                                   (foreign.variables total-environment)
+                                   (list& (..with-anonymous-init class total-environment super-class inputsTI)
+                                          method-definitions)
+                                   (row.row)))
+         _ (//////generation.save! true ["" class-name] [class-name bytecode])]
+        (anonymous-instance class total-environment)))]))
+
+(def: bundle::class
+  Bundle
+  (<| (/////bundle.prefix "class")
+      (|> (: Bundle /////bundle.empty)
+          (/////bundle.install "anonymous" class::anonymous)
+          )))
+
+(def: #export bundle
+  Bundle
+  (<| (/////bundle.prefix "jvm")
+      (|> ..bundle::conversion
+          (dictionary.merge ..bundle::int)
+          (dictionary.merge ..bundle::long)
+          (dictionary.merge ..bundle::float)
+          (dictionary.merge ..bundle::double)
+          (dictionary.merge ..bundle::char)
+          (dictionary.merge ..bundle::array)
+          (dictionary.merge ..bundle::object)
+          (dictionary.merge ..bundle::member)
+          (dictionary.merge ..bundle::class)
+          )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux
deleted file mode 100644
index d436d1974..000000000
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension.lux
+++ /dev/null
@@ -1,17 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [collection
-     ["." dictionary]]]]
-  ["." / #_
-   ["#." common]
-   ["#." host]
-   [//
-    [runtime (#+ Bundle)]]])
-
-(def: #export bundle
-  Bundle
-  ($_ dictionary.merge
-      /common.bundle
-      /host.bundle
-      ))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
deleted file mode 100644
index d57dd6b50..000000000
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux
+++ /dev/null
@@ -1,448 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [host (#+ import:)]
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try]
-    ["." exception (#+ exception:)]
-    ["<>" parser
-     ["<s>" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    [number
-     ["." i32]
-     ["f" frac]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary]]]
-   [target
-    [jvm
-     ["_" bytecode (#+ Label Bytecode) ("#@." monad)]
-     [encoding
-      ["." signed (#+ S4)]]
-     ["." type (#+ Type)
-      [category (#+ Primitive Class)]]]]]
-  ["." ///
-   ["#." value]
-   ["#." runtime (#+ Operation Phase Bundle Handler)]
-   ["#." function #_
-    ["#" abstract]]
-   ["//#" ///
-    [generation
-     [extension (#+ Nullary Unary Binary Trinary Variadic
-                    nullary unary binary trinary variadic)]]
-    [extension
-     ["#extension" /]
-     ["#." bundle]]
-    ["/#" //
-     ["#." synthesis (#+ Synthesis %synthesis)]]]])
-
-(def: #export (custom [parser handler])
-  (All [s]
-    (-> [(Parser s)
-         (-> Text Phase s (Operation (Bytecode Any)))]
-        Handler))
-  (function (_ extension-name phase input)
-    (case (<s>.run parser input)
-      (#try.Success input')
-      (handler extension-name phase input')
-
-      (#try.Failure error)
-      (/////.throw /////extension.invalid-syntax [extension-name //////synthesis.%synthesis input]))))
-
-(def: $Boolean (type.class "java.lang.Boolean" (list)))
-(def: $Double (type.class "java.lang.Double" (list)))
-(def: $Character (type.class "java.lang.Character" (list)))
-(def: $String (type.class "java.lang.String" (list)))
-(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
-(def: $Object (type.class "java.lang.Object" (list)))
-(def: $PrintStream (type.class "java.io.PrintStream" (list)))
-(def: $System (type.class "java.lang.System" (list)))
-(def: $Error (type.class "java.lang.Error" (list)))
-
-(def: lux-int
-  (Bytecode Any)
-  ($_ _.compose
-      _.i2l
-      (///value.wrap type.long)))
-
-(def: jvm-int
-  (Bytecode Any)
-  ($_ _.compose
-      (///value.unwrap type.long)
-      _.l2i))
-
-(def: ensure-string
-  (Bytecode Any)
-  (_.checkcast $String))
-
-(def: (predicate bytecode)
-  (-> (-> Label (Bytecode Any))
-      (Bytecode Any))
-  (do _.monad
-    [@then _.new-label
-     @end _.new-label]
-    ($_ _.compose
-        (bytecode @then)
-        (_.getstatic $Boolean "FALSE" $Boolean)
-        (_.goto @end)
-        (_.set-label @then)
-        (_.getstatic $Boolean "TRUE" $Boolean)
-        (_.set-label @end)
-        )))
-
-## TODO: Get rid of this ASAP
-(def: lux::syntax-char-case!
-  (..custom [($_ <>.and
-                 <s>.any
-                 <s>.any
-                 (<>.some (<s>.tuple ($_ <>.and
-                                         (<s>.tuple (<>.many <s>.i64))
-                                         <s>.any))))
-             (function (_ extension-name phase [inputS elseS conditionalsS])
-               (do /////.monad
-                 [@end ///runtime.forge-label
-                  inputG (phase inputS)
-                  elseG (phase elseS)
-                  conditionalsG+ (: (Operation (List [(List [S4 Label])
-                                                      (Bytecode Any)]))
-                                    (monad.map @ (function (_ [chars branch])
-                                                   (do @
-                                                     [branchG (phase branch)
-                                                      @branch ///runtime.forge-label]
-                                                     (wrap [(list@map (function (_ char)
-                                                                        [(try.assume (signed.s4 (.int char))) @branch])
-                                                                      chars)
-                                                            ($_ _.compose
-                                                                (_.set-label @branch)
-                                                                branchG
-                                                                (_.goto @end))])))
-                                               conditionalsS))
-                  #let [table (|> conditionalsG+
-                                  (list@map product.left)
-                                  list@join)
-                        conditionalsG (|> conditionalsG+
-                                          (list@map product.right)
-                                          (monad.seq _.monad))]]
-                 (wrap (do _.monad
-                         [@else _.new-label]
-                         ($_ _.compose
-                             inputG (///value.unwrap type.long) _.l2i
-                             (_.lookupswitch @else table)
-                             conditionalsG
-                             (_.set-label @else)
-                             elseG
-                             (_.set-label @end)
-                             )))))]))
-
-(def: (lux::is [referenceG sampleG])
-  (Binary (Bytecode Any))
-  ($_ _.compose
-      referenceG
-      sampleG
-      (..predicate _.if-acmpeq)))
-
-(def: (lux::try riskyG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      riskyG
-      (_.checkcast ///function.class)
-      ///runtime.try))
-
-(def: bundle::lux
-  Bundle
-  (|> (: Bundle /////bundle.empty)
-      (/////bundle.install "syntax char case!" ..lux::syntax-char-case!)
-      (/////bundle.install "is" (binary ..lux::is))
-      (/////bundle.install "try" (unary ..lux::try))))
-
-(template [<name> <op>]
-  [(def: (<name> [maskG inputG])
-     (Binary (Bytecode Any))
-     ($_ _.compose
-         inputG (///value.unwrap type.long)
-         maskG (///value.unwrap type.long)
-         <op> (///value.wrap type.long)))]
-
-  [i64::and _.land]
-  [i64::or  _.lor]
-  [i64::xor _.lxor]
-  )
-
-(template [<name> <op>]
-  [(def: (<name> [shiftG inputG])
-     (Binary (Bytecode Any))
-     ($_ _.compose
-         inputG (///value.unwrap type.long)
-         shiftG ..jvm-int
-         <op> (///value.wrap type.long)))]
-
-  [i64::left-shift             _.lshl]
-  [i64::arithmetic-right-shift _.lshr]
-  [i64::logical-right-shift    _.lushr]
-  )
-
-(import: #long java/lang/Double
-  (#static MIN_VALUE double)
-  (#static MAX_VALUE double))
-
-(template [<name> <const>]
-  [(def: (<name> _)
-     (Nullary (Bytecode Any))
-     ($_ _.compose
-         (_.double <const>)
-         (///value.wrap type.double)))]
-
-  [f64::smallest (java/lang/Double::MIN_VALUE)]
-  [f64::min      (f.* -1.0 (java/lang/Double::MAX_VALUE))]
-  [f64::max      (java/lang/Double::MAX_VALUE)]
-  )
-
-(template [<name> <type> <op>]
-  [(def: (<name> [paramG subjectG])
-     (Binary (Bytecode Any))
-     ($_ _.compose
-         subjectG (///value.unwrap <type>)
-         paramG (///value.unwrap <type>)
-         <op> (///value.wrap <type>)))]
-
-  [i64::+ type.long   _.ladd]
-  [i64::- type.long   _.lsub]
-  [i64::* type.long   _.lmul]
-  [i64::/ type.long   _.ldiv]
-  [i64::% type.long   _.lrem]
-  
-  [f64::+ type.double _.dadd]
-  [f64::- type.double _.dsub]
-  [f64::* type.double _.dmul]
-  [f64::/ type.double _.ddiv]
-  [f64::% type.double _.drem]
-  )
-
-(template [<eq> <lt> <type> <cmp>]
-  [(template [<name> <reference>]
-     [(def: (<name> [paramG subjectG])
-        (Binary (Bytecode Any))
-        ($_ _.compose
-            subjectG (///value.unwrap <type>)
-            paramG (///value.unwrap <type>)
-            <cmp>
-            <reference>
-            (..predicate _.if-icmpeq)))]
-     
-     [<eq> _.iconst-0]
-     [<lt> _.iconst-m1])]
-
-  [i64::= i64::< type.long   _.lcmp]
-  [f64::= f64::< type.double _.dcmpg]
-  )
-
-(def: (to-string class from)
-  (-> (Type Class) (Type Primitive) (Bytecode Any))
-  (_.invokestatic class "toString" (type.method [(list from) ..$String (list)])))
-
-(template [<name> <prepare> <transform>]
-  [(def: (<name> inputG)
-     (Unary (Bytecode Any))
-     ($_ _.compose
-         inputG
-         <prepare>
-         <transform>))]
-
-  [i64::f64
-   (///value.unwrap type.long)
-   ($_ _.compose
-       _.l2d
-       (///value.wrap type.double))]
-
-  [i64::char
-   (///value.unwrap type.long)
-   ($_ _.compose
-       _.l2i
-       _.i2c
-       (..to-string ..$Character type.char))]
-
-  [f64::i64
-   (///value.unwrap type.double)
-   ($_ _.compose
-       _.d2l
-       (///value.wrap type.long))]
-  
-  [f64::encode
-   (///value.unwrap type.double)
-   (..to-string ..$Double type.double)]
-  
-  [f64::decode
-   ..ensure-string
-   ///runtime.decode-frac]
-  )
-
-(def: bundle::i64
-  Bundle
-  (<| (/////bundle.prefix "i64")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "and" (binary ..i64::and))
-          (/////bundle.install "or" (binary ..i64::or))
-          (/////bundle.install "xor" (binary ..i64::xor))
-          (/////bundle.install "left-shift" (binary ..i64::left-shift))
-          (/////bundle.install "logical-right-shift" (binary ..i64::logical-right-shift))
-          (/////bundle.install "arithmetic-right-shift" (binary ..i64::arithmetic-right-shift))
-          (/////bundle.install "=" (binary ..i64::=))
-          (/////bundle.install "<" (binary ..i64::<))
-          (/////bundle.install "+" (binary ..i64::+))
-          (/////bundle.install "-" (binary ..i64::-))
-          (/////bundle.install "*" (binary ..i64::*))
-          (/////bundle.install "/" (binary ..i64::/))
-          (/////bundle.install "%" (binary ..i64::%))
-          (/////bundle.install "f64" (unary ..i64::f64))
-          (/////bundle.install "char" (unary ..i64::char)))))
-
-(def: bundle::f64
-  Bundle
-  (<| (/////bundle.prefix "f64")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "+" (binary ..f64::+))
-          (/////bundle.install "-" (binary ..f64::-))
-          (/////bundle.install "*" (binary ..f64::*))
-          (/////bundle.install "/" (binary ..f64::/))
-          (/////bundle.install "%" (binary ..f64::%))
-          (/////bundle.install "=" (binary ..f64::=))
-          (/////bundle.install "<" (binary ..f64::<))
-          (/////bundle.install "smallest" (nullary ..f64::smallest))
-          (/////bundle.install "min" (nullary ..f64::min))
-          (/////bundle.install "max" (nullary ..f64::max))
-          (/////bundle.install "i64" (unary ..f64::i64))
-          (/////bundle.install "encode" (unary ..f64::encode))
-          (/////bundle.install "decode" (unary ..f64::decode)))))
-
-(def: (text::size inputG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      inputG
-      ..ensure-string
-      (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)]))
-      ..lux-int))
-
-(def: no-op (Bytecode Any) (_@wrap []))
-
-(template [<name> <pre-subject> <pre-param> <op> <post>]
-  [(def: (<name> [paramG subjectG])
-     (Binary (Bytecode Any))
-     ($_ _.compose
-         subjectG <pre-subject>
-         paramG <pre-param>
-         <op> <post>))]
-
-  [text::= ..no-op ..no-op
-   (_.invokevirtual ..$Object "equals" (type.method [(list ..$Object) type.boolean (list)]))
-   (///value.wrap type.boolean)]
-  [text::< ..ensure-string ..ensure-string
-   (_.invokevirtual ..$String "compareTo" (type.method [(list ..$String) type.int (list)]))
-   (..predicate _.iflt)]
-  [text::char ..ensure-string ..jvm-int
-   (_.invokevirtual ..$String "charAt" (type.method [(list type.int) type.char (list)]))
-   ..lux-int]
-  )
-
-(def: (text::concat [leftG rightG])
-  (Binary (Bytecode Any))
-  ($_ _.compose
-      leftG ..ensure-string
-      rightG ..ensure-string
-      (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)]))))
-
-(def: (text::clip [startG endG subjectG])
-  (Trinary (Bytecode Any))
-  ($_ _.compose
-      subjectG ..ensure-string
-      startG ..jvm-int
-      endG ..jvm-int
-      (_.invokevirtual ..$String "substring" (type.method [(list type.int type.int) ..$String (list)]))))
-
-(def: index-method (type.method [(list ..$String type.int) type.int (list)]))
-(def: (text::index [startG partG textG])
-  (Trinary (Bytecode Any))
-  (do _.monad
-    [@not-found _.new-label
-     @end _.new-label]
-    ($_ _.compose
-        textG ..ensure-string
-        partG ..ensure-string
-        startG ..jvm-int
-        (_.invokevirtual ..$String "indexOf" index-method)
-        _.dup
-        _.iconst-m1
-        (_.if-icmpeq @not-found)
-        ..lux-int
-        ///runtime.some-injection
-        (_.goto @end)
-        (_.set-label @not-found)
-        _.pop
-        ///runtime.none-injection
-        (_.set-label @end))))
-
-(def: bundle::text
-  Bundle
-  (<| (/////bundle.prefix "text")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "=" (binary ..text::=))
-          (/////bundle.install "<" (binary ..text::<))
-          (/////bundle.install "concat" (binary ..text::concat))
-          (/////bundle.install "index" (trinary ..text::index))
-          (/////bundle.install "size" (unary ..text::size))
-          (/////bundle.install "char" (binary ..text::char))
-          (/////bundle.install "clip" (trinary ..text::clip)))))
-
-(def: string-method (type.method [(list ..$String) type.void (list)]))
-(def: (io::log messageG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      (_.getstatic ..$System "out" ..$PrintStream)
-      messageG
-      ..ensure-string
-      (_.invokevirtual ..$PrintStream "println" ..string-method)
-      ///runtime.unit))
-
-(def: (io::error messageG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      (_.new ..$Error)
-      _.dup
-      messageG
-      ..ensure-string
-      (_.invokespecial ..$Error "<init>" ..string-method)
-      _.athrow))
-
-(def: exit-method (type.method [(list type.int) type.void (list)]))
-(def: (io::exit codeG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      codeG ..jvm-int
-      (_.invokestatic ..$System "exit" ..exit-method)
-      _.aconst-null))
-
-(def: time-method (type.method [(list) type.long (list)]))
-(def: (io::current-time _)
-  (Nullary (Bytecode Any))
-  ($_ _.compose
-      (_.invokestatic ..$System "currentTimeMillis" ..time-method)
-      (///value.wrap type.long)))
-
-(def: bundle::io
-  Bundle
-  (<| (/////bundle.prefix "io")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "log" (unary ..io::log))
-          (/////bundle.install "error" (unary ..io::error))
-          (/////bundle.install "exit" (unary ..io::exit))
-          (/////bundle.install "current-time" (nullary ..io::current-time)))))
-
-(def: #export bundle
-  Bundle
-  (<| (/////bundle.prefix "lux")
-      (|> bundle::lux
-          (dictionary.merge ..bundle::i64)
-          (dictionary.merge ..bundle::f64)
-          (dictionary.merge ..bundle::text)
-          (dictionary.merge ..bundle::io))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux
deleted file mode 100644
index 84af963d2..000000000
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux
+++ /dev/null
@@ -1,1086 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try]
-    ["." exception (#+ exception:)]
-    ["<>" parser
-     ["<t>" text]
-     ["<s>" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." text ("#@." equivalence)]
-    [number
-     ["." i32]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary (#+ Dictionary)]
-     ["." set]
-     ["." row]]
-    ["." format #_
-     ["#" binary]]]
-   [target
-    [jvm
-     ["." version]
-     ["." modifier ("#@." monoid)]
-     ["." method (#+ Method)]
-     ["." class (#+ Class)]
-     [constant
-      [pool (#+ Resource)]]
-     [encoding
-      ["." name]]
-     ["_" bytecode (#+ Label Bytecode) ("#@." monad)
-      ["__" instruction (#+ Primitive-Array-Type)]]
-     ["." type (#+ Type Typed Argument)
-      ["." category (#+ Void Value' Value Return' Return Primitive Object Array Var Parameter)]
-      ["." box]
-      ["." reflection]
-      ["." signature]
-      ["." parser]]]]]
-  ["." // #_
-   [common (#+ custom)]
-   ["/#" //
-    [runtime (#+ Operation Bundle Handler)]
-    ["#." reference]
-    [function
-     [field
-      [variable
-       ["." foreign]]]]
-    ["//#" ///
-     [generation
-      [extension (#+ Nullary Unary Binary Trinary Variadic
-                     nullary unary binary trinary variadic)]]
-     [extension
-      ["#." bundle]
-      [analysis
-       ["/" jvm]]]
-     ["/#" //
-      ["#." reference (#+ Variable)]
-      [analysis (#+ Environment)]
-      ["#." synthesis (#+ Synthesis Path %synthesis)]
-      ["#." generation]]]]])
-
-(template [<name> <0> <1>]
-  [(def: <name>
-     (Bytecode Any)
-     ($_ _.compose
-         <0>
-         <1>))]
-
-  [l2s _.l2i _.i2s]
-  [l2b _.l2i _.i2b]
-  [l2c _.l2i _.i2c]
-  )
-
-(template [<conversion> <name>]
-  [(def: (<name> inputG)
-     (Unary (Bytecode Any))
-     (if (is? _.nop <conversion>)
-       inputG
-       ($_ _.compose
-           inputG
-           <conversion>)))]
-  
-  [_.d2f conversion::double-to-float]
-  [_.d2i conversion::double-to-int]
-  [_.d2l conversion::double-to-long]
-  [_.f2d conversion::float-to-double]
-  [_.f2i conversion::float-to-int]
-  [_.f2l conversion::float-to-long]
-  [_.i2b conversion::int-to-byte]
-  [_.i2c conversion::int-to-char]
-  [_.i2d conversion::int-to-double]
-  [_.i2f conversion::int-to-float]
-  [_.i2l conversion::int-to-long]
-  [_.i2s conversion::int-to-short]
-  [_.l2d conversion::long-to-double]
-  [_.l2f conversion::long-to-float]
-  [_.l2i conversion::long-to-int]
-  [..l2s conversion::long-to-short]
-  [..l2b conversion::long-to-byte]
-  [..l2c conversion::long-to-char]
-  [_.i2b conversion::char-to-byte]
-  [_.i2s conversion::char-to-short]
-  [_.nop conversion::char-to-int]
-  [_.i2l conversion::char-to-long]
-  [_.i2l conversion::byte-to-long]
-  [_.i2l conversion::short-to-long]
-  )
-
-(def: bundle::conversion
-  Bundle
-  (<| (/////bundle.prefix "conversion")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "double-to-float" (unary conversion::double-to-float))
-          (/////bundle.install "double-to-int" (unary conversion::double-to-int))
-          (/////bundle.install "double-to-long" (unary conversion::double-to-long))
-          (/////bundle.install "float-to-double" (unary conversion::float-to-double))
-          (/////bundle.install "float-to-int" (unary conversion::float-to-int))
-          (/////bundle.install "float-to-long" (unary conversion::float-to-long))
-          (/////bundle.install "int-to-byte" (unary conversion::int-to-byte))
-          (/////bundle.install "int-to-char" (unary conversion::int-to-char))
-          (/////bundle.install "int-to-double" (unary conversion::int-to-double))
-          (/////bundle.install "int-to-float" (unary conversion::int-to-float))
-          (/////bundle.install "int-to-long" (unary conversion::int-to-long))
-          (/////bundle.install "int-to-short" (unary conversion::int-to-short))
-          (/////bundle.install "long-to-double" (unary conversion::long-to-double))
-          (/////bundle.install "long-to-float" (unary conversion::long-to-float))
-          (/////bundle.install "long-to-int" (unary conversion::long-to-int))
-          (/////bundle.install "long-to-short" (unary conversion::long-to-short))
-          (/////bundle.install "long-to-byte" (unary conversion::long-to-byte))
-          (/////bundle.install "long-to-char" (unary conversion::long-to-char))
-          (/////bundle.install "char-to-byte" (unary conversion::char-to-byte))
-          (/////bundle.install "char-to-short" (unary conversion::char-to-short))
-          (/////bundle.install "char-to-int" (unary conversion::char-to-int))
-          (/////bundle.install "char-to-long" (unary conversion::char-to-long))
-          (/////bundle.install "byte-to-long" (unary conversion::byte-to-long))
-          (/////bundle.install "short-to-long" (unary conversion::short-to-long))
-          )))
-
-(template [<name> <op>]
-  [(def: (<name> [xG yG])
-     (Binary (Bytecode Any))
-     ($_ _.compose
-         xG
-         yG
-         <op>))]
-
-  [int::+ _.iadd]
-  [int::- _.isub]
-  [int::* _.imul]
-  [int::/ _.idiv]
-  [int::% _.irem]
-  [int::and _.iand]
-  [int::or _.ior]
-  [int::xor _.ixor]
-  [int::shl _.ishl]
-  [int::shr _.ishr]
-  [int::ushr _.iushr]
-  
-  [long::+ _.ladd]
-  [long::- _.lsub]
-  [long::* _.lmul]
-  [long::/ _.ldiv]
-  [long::% _.lrem]
-  [long::and _.land]
-  [long::or _.lor]
-  [long::xor _.lxor]
-  [long::shl _.lshl]
-  [long::shr _.lshr]
-  [long::ushr _.lushr]
-
-  [float::+ _.fadd]
-  [float::- _.fsub]
-  [float::* _.fmul]
-  [float::/ _.fdiv]
-  [float::% _.frem]
-  
-  [double::+ _.dadd]
-  [double::- _.dsub]
-  [double::* _.dmul]
-  [double::/ _.ddiv]
-  [double::% _.drem]
-  )
-
-(def: $Boolean (type.class box.boolean (list)))
-(def: falseG (_.getstatic ..$Boolean "FALSE" ..$Boolean))
-(def: trueG (_.getstatic ..$Boolean "TRUE" ..$Boolean))
-
-(template [<name> <op>]
-  [(def: (<name> [xG yG])
-     (Binary (Bytecode Any))
-     (do _.monad
-       [@then _.new-label
-        @end _.new-label]
-       ($_ _.compose
-           xG
-           yG
-           (<op> @then)
-           falseG
-           (_.goto @end)
-           (_.set-label @then)
-           trueG
-           (_.set-label @end))))]
-
-  [int::= _.if-icmpeq]
-  [int::< _.if-icmplt]
-
-  [char::= _.if-icmpeq]
-  [char::< _.if-icmplt]
-  )
-
-(template [<name> <op> <reference>]
-  [(def: (<name> [xG yG])
-     (Binary (Bytecode Any))
-     (do _.monad
-       [@then _.new-label
-        @end _.new-label]
-       ($_ _.compose
-           xG
-           yG
-           <op>
-           (_.int (i32.i32 (.i64 <reference>)))
-           (_.if-icmpeq @then)
-           falseG
-           (_.goto @end)
-           (_.set-label @then)
-           trueG
-           (_.set-label @end))))]
-
-  [long::= _.lcmp +0]
-  [long::< _.lcmp -1]
-  
-  [float::= _.fcmpg +0]
-  [float::< _.fcmpg -1]
-
-  [double::= _.dcmpg +0]
-  [double::< _.dcmpg -1]
-  )
-
-(def: bundle::int
-  Bundle
-  (<| (/////bundle.prefix (reflection.reflection reflection.int))
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "+" (binary int::+))
-          (/////bundle.install "-" (binary int::-))
-          (/////bundle.install "*" (binary int::*))
-          (/////bundle.install "/" (binary int::/))
-          (/////bundle.install "%" (binary int::%))
-          (/////bundle.install "=" (binary int::=))
-          (/////bundle.install "<" (binary int::<))
-          (/////bundle.install "and" (binary int::and))
-          (/////bundle.install "or" (binary int::or))
-          (/////bundle.install "xor" (binary int::xor))
-          (/////bundle.install "shl" (binary int::shl))
-          (/////bundle.install "shr" (binary int::shr))
-          (/////bundle.install "ushr" (binary int::ushr))
-          )))
-
-(def: bundle::long
-  Bundle
-  (<| (/////bundle.prefix (reflection.reflection reflection.long))
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "+" (binary long::+))
-          (/////bundle.install "-" (binary long::-))
-          (/////bundle.install "*" (binary long::*))
-          (/////bundle.install "/" (binary long::/))
-          (/////bundle.install "%" (binary long::%))
-          (/////bundle.install "=" (binary long::=))
-          (/////bundle.install "<" (binary long::<))
-          (/////bundle.install "and" (binary long::and))
-          (/////bundle.install "or" (binary long::or))
-          (/////bundle.install "xor" (binary long::xor))
-          (/////bundle.install "shl" (binary long::shl))
-          (/////bundle.install "shr" (binary long::shr))
-          (/////bundle.install "ushr" (binary long::ushr))
-          )))
-
-(def: bundle::float
-  Bundle
-  (<| (/////bundle.prefix (reflection.reflection reflection.float))
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "+" (binary float::+))
-          (/////bundle.install "-" (binary float::-))
-          (/////bundle.install "*" (binary float::*))
-          (/////bundle.install "/" (binary float::/))
-          (/////bundle.install "%" (binary float::%))
-          (/////bundle.install "=" (binary float::=))
-          (/////bundle.install "<" (binary float::<))
-          )))
-
-(def: bundle::double
-  Bundle
-  (<| (/////bundle.prefix (reflection.reflection reflection.double))
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "+" (binary double::+))
-          (/////bundle.install "-" (binary double::-))
-          (/////bundle.install "*" (binary double::*))
-          (/////bundle.install "/" (binary double::/))
-          (/////bundle.install "%" (binary double::%))
-          (/////bundle.install "=" (binary double::=))
-          (/////bundle.install "<" (binary double::<))
-          )))
-
-(def: bundle::char
-  Bundle
-  (<| (/////bundle.prefix (reflection.reflection reflection.char))
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "=" (binary char::=))
-          (/////bundle.install "<" (binary char::<))
-          )))
-
-(template [<name> <category> <parser>]
-  [(def: #export <name>
-     (Parser (Type <category>))
-     (<t>.embed <parser> <s>.text))]
-
-  [var Var parser.var]
-  [class category.Class parser.class]
-  [object Object parser.object]
-  [value Value parser.value]
-  [return Return parser.return]
-  )
-
-(exception: #export (not-an-object-array {arrayJT (Type Array)})
-  (exception.report
-   ["JVM Type" (|> arrayJT type.signature signature.signature)]))
-
-(def: #export object-array
-  (Parser (Type Object))
-  (do <>.monad
-    [arrayJT (<t>.embed parser.array <s>.text)]
-    (case (parser.array? arrayJT)
-      (#.Some elementJT)
-      (case (parser.object? elementJT)
-        (#.Some elementJT)
-        (wrap elementJT)
-
-        #.None
-        (<>.fail (exception.construct ..not-an-object-array arrayJT)))
-      
-      #.None
-      (undefined))))
-
-(def: (primitive-array-length-handler jvm-primitive)
-  (-> (Type Primitive) Handler)
-  (..custom
-   [<s>.any
-    (function (_ extension-name generate arrayS)
-      (do /////.monad
-        [arrayG (generate arrayS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array jvm-primitive))
-                  _.arraylength))))]))
-
-(def: array::length::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array <s>.any)
-    (function (_ extension-name generate [elementJT arrayS])
-      (do /////.monad
-        [arrayG (generate arrayS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array elementJT))
-                  _.arraylength))))]))
-
-(def: (new-primitive-array-handler jvm-primitive)
-  (-> Primitive-Array-Type Handler)
-  (..custom
-   [<s>.any
-    (function (_ extension-name generate [lengthS])
-      (do /////.monad
-        [lengthG (generate lengthS)]
-        (wrap ($_ _.compose
-                  lengthG
-                  (_.newarray jvm-primitive)))))]))
-
-(def: array::new::object
-  Handler
-  (..custom
-   [($_ <>.and ..object <s>.any)
-    (function (_ extension-name generate [objectJT lengthS])
-      (do /////.monad
-        [lengthG (generate lengthS)]
-        (wrap ($_ _.compose
-                  lengthG
-                  (_.anewarray objectJT)))))]))
-
-(def: (read-primitive-array-handler jvm-primitive loadG)
-  (-> (Type Primitive) (Bytecode Any) Handler)
-  (..custom
-   [($_ <>.and <s>.any <s>.any)
-    (function (_ extension-name generate [idxS arrayS])
-      (do /////.monad
-        [arrayG (generate arrayS)
-         idxG (generate idxS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array jvm-primitive))
-                  idxG
-                  loadG))))]))
-
-(def: array::read::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array <s>.any <s>.any)
-    (function (_ extension-name generate [elementJT idxS arrayS])
-      (do /////.monad
-        [arrayG (generate arrayS)
-         idxG (generate idxS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array elementJT))
-                  idxG
-                  _.aaload))))]))
-
-(def: (write-primitive-array-handler jvm-primitive storeG)
-  (-> (Type Primitive) (Bytecode Any) Handler)
-  (..custom
-   [($_ <>.and <s>.any <s>.any <s>.any)
-    (function (_ extension-name generate [idxS valueS arrayS])
-      (do /////.monad
-        [arrayG (generate arrayS)
-         idxG (generate idxS)
-         valueG (generate valueS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array jvm-primitive))
-                  _.dup
-                  idxG
-                  valueG
-                  storeG))))]))
-
-(def: array::write::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array <s>.any <s>.any <s>.any)
-    (function (_ extension-name generate [elementJT idxS valueS arrayS])
-      (do /////.monad
-        [arrayG (generate arrayS)
-         idxG (generate idxS)
-         valueG (generate valueS)]
-        (wrap ($_ _.compose
-                  arrayG
-                  (_.checkcast (type.array elementJT))
-                  _.dup
-                  idxG
-                  valueG
-                  _.aastore))))]))
-
-(def: bundle::array
-  Bundle
-  (<| (/////bundle.prefix "array")
-      (|> /////bundle.empty
-          (dictionary.merge (<| (/////bundle.prefix "length")
-                                (|> /////bundle.empty
-                                    (/////bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean))
-                                    (/////bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte))
-                                    (/////bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short))
-                                    (/////bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int))
-                                    (/////bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long))
-                                    (/////bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float))
-                                    (/////bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double))
-                                    (/////bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char))
-                                    (/////bundle.install "object" array::length::object))))
-          (dictionary.merge (<| (/////bundle.prefix "new")
-                                (|> /////bundle.empty
-                                    (/////bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler __.t-boolean))
-                                    (/////bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler __.t-byte))
-                                    (/////bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler __.t-short))
-                                    (/////bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler __.t-int))
-                                    (/////bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler __.t-long))
-                                    (/////bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler __.t-float))
-                                    (/////bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler __.t-double))
-                                    (/////bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler __.t-char))
-                                    (/////bundle.install "object" array::new::object))))
-          (dictionary.merge (<| (/////bundle.prefix "read")
-                                (|> /////bundle.empty
-                                    (/////bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.baload))
-                                    (/////bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.baload))
-                                    (/////bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.saload))
-                                    (/////bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.iaload))
-                                    (/////bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.laload))
-                                    (/////bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.faload))
-                                    (/////bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.daload))
-                                    (/////bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.caload))
-                                    (/////bundle.install "object" array::read::object))))
-          (dictionary.merge (<| (/////bundle.prefix "write")
-                                (|> /////bundle.empty
-                                    (/////bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.bastore))
-                                    (/////bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.bastore))
-                                    (/////bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.sastore))
-                                    (/////bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.iastore))
-                                    (/////bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.lastore))
-                                    (/////bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.fastore))
-                                    (/////bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.dastore))
-                                    (/////bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.castore))
-                                    (/////bundle.install "object" array::write::object))))
-          )))
-
-(def: (object::null _)
-  (Nullary (Bytecode Any))
-  _.aconst-null)
-
-(def: (object::null? objectG)
-  (Unary (Bytecode Any))
-  (do _.monad
-    [@then _.new-label
-     @end _.new-label]
-    ($_ _.compose
-        objectG
-        (_.ifnull @then)
-        ..falseG
-        (_.goto @end)
-        (_.set-label @then)
-        ..trueG
-        (_.set-label @end))))
-
-(def: (object::synchronized [monitorG exprG])
-  (Binary (Bytecode Any))
-  ($_ _.compose
-      monitorG
-      _.dup
-      _.monitorenter
-      exprG
-      _.swap
-      _.monitorexit))
-
-(def: (object::throw exceptionG)
-  (Unary (Bytecode Any))
-  ($_ _.compose
-      exceptionG
-      _.athrow))
-
-(def: $Class (type.class "java.lang.Class" (list)))
-(def: $String (type.class "java.lang.String" (list)))
-
-(def: object::class
-  Handler
-  (..custom
-   [<s>.text
-    (function (_ extension-name generate [class])
-      (do /////.monad
-        []
-        (wrap ($_ _.compose
-                  (_.string class)
-                  (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))]))
-
-(def: object::instance?
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.any)
-    (function (_ extension-name generate [class objectS])
-      (do /////.monad
-        [objectG (generate objectS)]
-        (wrap ($_ _.compose
-                  objectG
-                  (_.instanceof (type.class class (list)))
-                  (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))]))
-
-(def: reflection
-  (All [category]
-    (-> (Type (<| Return' Value' category)) Text))
-  (|>> type.reflection reflection.reflection))
-
-(def: object::cast
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.text <s>.any)
-    (function (_ extension-name generate [from to valueS])
-      (do /////.monad
-        [valueG (generate valueS)]
-        (wrap (`` (cond (~~ (template [<object> <type> <unwrap>]
-                              [(and (text@= (..reflection <type>)
-                                            from)
-                                    (text@= <object>
-                                            to))
-                               (let [$<object> (type.class <object> (list))]
-                                 ($_ _.compose
-                                     valueG
-                                     (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)]))))
-
-                               (and (text@= <object>
-                                            from)
-                                    (text@= (..reflection <type>)
-                                            to))
-                               (let [$<object> (type.class <object> (list))]
-                                 ($_ _.compose
-                                     valueG
-                                     (_.checkcast $<object>)
-                                     (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))]
-                              
-                              [box.boolean type.boolean "booleanValue"]
-                              [box.byte    type.byte    "byteValue"]
-                              [box.short   type.short   "shortValue"]
-                              [box.int     type.int     "intValue"]
-                              [box.long    type.long    "longValue"]
-                              [box.float   type.float   "floatValue"]
-                              [box.double  type.double  "doubleValue"]
-                              [box.char    type.char    "charValue"]))
-                        ## else
-                        valueG)))))]))
-
-(def: bundle::object
-  Bundle
-  (<| (/////bundle.prefix "object")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "null" (nullary object::null))
-          (/////bundle.install "null?" (unary object::null?))
-          (/////bundle.install "synchronized" (binary object::synchronized))
-          (/////bundle.install "throw" (unary object::throw))
-          (/////bundle.install "class" object::class)
-          (/////bundle.install "instance?" object::instance?)
-          (/////bundle.install "cast" object::cast)
-          )))
-
-(def: primitives
-  (Dictionary Text (Type Primitive))
-  (|> (list [(reflection.reflection reflection.boolean) type.boolean]
-            [(reflection.reflection reflection.byte) type.byte]
-            [(reflection.reflection reflection.short) type.short]
-            [(reflection.reflection reflection.int) type.int]
-            [(reflection.reflection reflection.long) type.long]
-            [(reflection.reflection reflection.float) type.float]
-            [(reflection.reflection reflection.double) type.double]
-            [(reflection.reflection reflection.char) type.char])
-      (dictionary.from-list text.hash)))
-
-(def: get::static
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text)
-    (function (_ extension-name generate [class field unboxed])
-      (do /////.monad
-        [#let [$class (type.class class (list))]]
-        (case (dictionary.get unboxed ..primitives)
-          (#.Some primitive)
-          (wrap (_.getstatic $class field primitive))
-          
-          #.None
-          (wrap (_.getstatic $class field (type.class unboxed (list)))))))]))
-
-(def: unitG (_.string //////synthesis.unit))
-
-(def: put::static
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
-    (function (_ extension-name generate [class field unboxed valueS])
-      (do /////.monad
-        [valueG (generate valueS)
-         #let [$class (type.class class (list))]]
-        (case (dictionary.get unboxed ..primitives)
-          (#.Some primitive)
-          (wrap ($_ _.compose
-                    valueG
-                    (_.putstatic $class field primitive)
-                    ..unitG))
-          
-          #.None
-          (wrap ($_ _.compose
-                    valueG
-                    (_.checkcast $class)
-                    (_.putstatic $class field $class)
-                    ..unitG)))))]))
-
-(def: get::virtual
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
-    (function (_ extension-name generate [class field unboxed objectS])
-      (do /////.monad
-        [objectG (generate objectS)
-         #let [$class (type.class class (list))
-               getG (case (dictionary.get unboxed ..primitives)
-                      (#.Some primitive)
-                      (_.getfield $class field primitive)
-                      
-                      #.None
-                      (_.getfield $class field (type.class unboxed (list))))]]
-        (wrap ($_ _.compose
-                  objectG
-                  (_.checkcast $class)
-                  getG))))]))
-
-(def: put::virtual
-  Handler
-  (..custom
-   [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any)
-    (function (_ extension-name generate [class field unboxed valueS objectS])
-      (do /////.monad
-        [valueG (generate valueS)
-         objectG (generate objectS)
-         #let [$class (type.class class (list))
-               putG (case (dictionary.get unboxed ..primitives)
-                      (#.Some primitive)
-                      (_.putfield $class field primitive)
-                      
-                      #.None
-                      (let [$unboxed (type.class unboxed (list))]
-                        ($_ _.compose
-                            (_.checkcast $unboxed)
-                            (_.putfield $class field $unboxed))))]]
-        (wrap ($_ _.compose
-                  objectG
-                  (_.checkcast $class)
-                  _.dup
-                  valueG
-                  putG))))]))
-
-(type: Input (Typed Synthesis))
-
-(def: input
-  (Parser Input)
-  (<s>.tuple (<>.and ..value <s>.any)))
-
-(def: (generate-input generate [valueT valueS])
-  (-> (-> Synthesis (Operation (Bytecode Any))) Input
-      (Operation (Typed (Bytecode Any))))
-  (do /////.monad
-    [valueG (generate valueS)]
-    (case (type.primitive? valueT)
-      (#.Right valueT)
-      (wrap [valueT valueG])
-      
-      (#.Left valueT)
-      (wrap [valueT ($_ _.compose
-                        valueG
-                        (_.checkcast valueT))]))))
-
-(def: (prepare-output outputT)
-  (-> (Type Return) (Bytecode Any))
-  (case (type.void? outputT)
-    (#.Right outputT)
-    ..unitG
-    
-    (#.Left outputT)
-    (:: _.monad wrap [])))
-
-(def: invoke::static
-  Handler
-  (..custom
-   [($_ <>.and ..class <s>.text ..return (<>.some ..input))
-    (function (_ extension-name generate [class method outputT inputsTS])
-      (do /////.monad
-        [inputsTG (monad.map @ (generate-input generate) inputsTS)]
-        (wrap ($_ _.compose
-                  (monad.map _.monad product.right inputsTG)
-                  (_.invokestatic class method (type.method [(list@map product.left inputsTG) outputT (list)]))
-                  (prepare-output outputT)))))]))
-
-(template [<name> <invoke>]
-  [(def: <name>
-     Handler
-     (..custom
-      [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input))
-       (function (_ extension-name generate [class method outputT objectS inputsTS])
-         (do /////.monad
-           [objectG (generate objectS)
-            inputsTG (monad.map @ (generate-input generate) inputsTS)]
-           (wrap ($_ _.compose
-                     objectG
-                     (_.checkcast class)
-                     (monad.map _.monad product.right inputsTG)
-                     (<invoke> class method (type.method [(list@map product.left inputsTG) outputT (list)]))
-                     (prepare-output outputT)))))]))]
-
-  [invoke::virtual _.invokevirtual]
-  [invoke::special _.invokespecial]
-  [invoke::interface _.invokeinterface]
-  )
-
-(def: invoke::constructor
-  Handler
-  (..custom
-   [($_ <>.and ..class (<>.some ..input))
-    (function (_ extension-name generate [class inputsTS])
-      (do /////.monad
-        [inputsTG (monad.map @ (generate-input generate) inputsTS)]
-        (wrap ($_ _.compose
-                  (_.new class)
-                  _.dup
-                  (monad.map _.monad product.right inputsTG)
-                  (_.invokespecial class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))))))]))
-
-(def: bundle::member
-  Bundle
-  (<| (/////bundle.prefix "member")
-      (|> (: Bundle /////bundle.empty)
-          (dictionary.merge (<| (/////bundle.prefix "get")
-                                (|> (: Bundle /////bundle.empty)
-                                    (/////bundle.install "static" get::static)
-                                    (/////bundle.install "virtual" get::virtual))))
-          (dictionary.merge (<| (/////bundle.prefix "put")
-                                (|> (: Bundle /////bundle.empty)
-                                    (/////bundle.install "static" put::static)
-                                    (/////bundle.install "virtual" put::virtual))))
-          (dictionary.merge (<| (/////bundle.prefix "invoke")
-                                (|> (: Bundle /////bundle.empty)
-                                    (/////bundle.install "static" invoke::static)
-                                    (/////bundle.install "virtual" invoke::virtual)
-                                    (/////bundle.install "special" invoke::special)
-                                    (/////bundle.install "interface" invoke::interface)
-                                    (/////bundle.install "constructor" invoke::constructor))))
-          )))
-
-(def: annotation-parameter
-  (Parser (/.Annotation-Parameter Synthesis))
-  (<s>.tuple (<>.and <s>.text <s>.any)))
-
-(def: annotation
-  (Parser (/.Annotation Synthesis))
-  (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter))))
-
-(def: argument
-  (Parser Argument)
-  (<s>.tuple (<>.and <s>.text ..value)))
-
-(def: overriden-method-definition
-  (Parser [Environment (/.Overriden-Method Synthesis)])
-  (<s>.tuple (do <>.monad
-               [_ (<s>.text! /.overriden-tag)
-                ownerT ..class
-                name <s>.text
-                strict-fp? <s>.bit
-                annotations (<s>.tuple (<>.some ..annotation))
-                vars (<s>.tuple (<>.some ..var))
-                self-name <s>.text
-                arguments (<s>.tuple (<>.some ..argument))
-                returnT ..return
-                exceptionsT (<s>.tuple (<>.some ..class))
-                [environment body] (<s>.function 1
-                                     (<s>.tuple <s>.any))]
-               (wrap [environment
-                      [ownerT name
-                       strict-fp? annotations vars
-                       self-name arguments returnT exceptionsT
-                       body]]))))
-
-(def: (normalize-path normalize)
-  (-> (-> Synthesis Synthesis)
-      (-> Path Path))
-  (function (recur path)
-    (case path
-      (^ (//////synthesis.path/then bodyS))
-      (//////synthesis.path/then (normalize bodyS))
-
-      (^template [<tag>]
-        (^ (<tag> leftP rightP))
-        (<tag> (recur leftP) (recur rightP)))
-      ([#//////synthesis.Alt]
-       [#//////synthesis.Seq])
-
-      (^template [<tag>]
-        (^ (<tag> value))
-        path)
-      ([#//////synthesis.Pop]
-       [#//////synthesis.Test]
-       [#//////synthesis.Bind]
-       [#//////synthesis.Access]))))
-
-(def: (normalize-method-body mapping)
-  (-> (Dictionary Variable Variable) Synthesis Synthesis)
-  (function (recur body)
-    (case body
-      (^template [<tag>]
-        (^ (<tag> value))
-        body)
-      ([#//////synthesis.Primitive]
-       [//////synthesis.constant])
-
-      (^ (//////synthesis.variant [lefts right? sub]))
-      (//////synthesis.variant [lefts right? (recur sub)])
-
-      (^ (//////synthesis.tuple members))
-      (//////synthesis.tuple (list@map recur members))
-
-      (^ (//////synthesis.variable var))
-      (|> mapping
-          (dictionary.get var)
-          (maybe.default var)
-          //////synthesis.variable)
-
-      (^ (//////synthesis.branch/case [inputS pathS]))
-      (//////synthesis.branch/case [(recur inputS) (normalize-path recur pathS)])
-
-      (^ (//////synthesis.branch/let [inputS register outputS]))
-      (//////synthesis.branch/let [(recur inputS) register (recur outputS)])
-
-      (^ (//////synthesis.branch/if [testS thenS elseS]))
-      (//////synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
-
-      (^ (//////synthesis.loop/scope [offset initsS+ bodyS]))
-      (//////synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
-
-      (^ (//////synthesis.loop/recur updatesS+))
-      (//////synthesis.loop/recur (list@map recur updatesS+))
-
-      (^ (//////synthesis.function/abstraction [environment arity bodyS]))
-      (//////synthesis.function/abstraction [(|> environment (list@map (function (_ local)
-                                                                         (|> mapping
-                                                                             (dictionary.get local)
-                                                                             (maybe.default local)))))
-                                             arity
-                                             bodyS])
-
-      (^ (//////synthesis.function/apply [functionS inputsS+]))
-      (//////synthesis.function/apply [(recur functionS) (list@map recur inputsS+)])
-
-      (#//////synthesis.Extension [name inputsS+])
-      (#//////synthesis.Extension [name (list@map recur inputsS+)]))))
-
-(def: $Object (type.class "java.lang.Object" (list)))
-
-(def: (anonymous-init-method env)
-  (-> Environment (Type category.Method))
-  (type.method [(list.repeat (list.size env) ..$Object)
-                type.void
-                (list)]))
-
-(def: (with-anonymous-init class env super-class inputsTG)
-  (-> (Type category.Class) Environment (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method))
-  (let [store-capturedG (|> env
-                            list.size
-                            list.indices
-                            (monad.map _.monad (.function (_ register)
-                                                 ($_ _.compose
-                                                     (_.aload 0)
-                                                     (_.aload (inc register))
-                                                     (_.putfield class (///reference.foreign-name register) $Object)))))]
-    (method.method method.public "<init>" (anonymous-init-method env)
-                   (list)
-                   (#.Some ($_ _.compose
-                               (_.aload 0)
-                               (monad.map _.monad product.right inputsTG)
-                               (_.invokespecial super-class "<init>" (type.method [(list@map product.left inputsTG) type.void (list)]))
-                               store-capturedG
-                               _.return)))))
-
-(def: (anonymous-instance class env)
-  (-> (Type category.Class) Environment (Operation (Bytecode Any)))
-  (do /////.monad
-    [captureG+ (monad.map @ ///reference.variable env)]
-    (wrap ($_ _.compose
-              (_.new class)
-              _.dup
-              (monad.seq _.monad captureG+)
-              (_.invokespecial class "<init>" (anonymous-init-method env))))))
-
-(def: (returnG returnT)
-  (-> (Type Return) (Bytecode Any))
-  (case (type.void? returnT)
-    (#.Right returnT)
-    _.return
-
-    (#.Left returnT)
-    (case (type.primitive? returnT)
-      (#.Left returnT)
-      ($_ _.compose
-          (_.checkcast returnT)
-          _.areturn)
-      
-      (#.Right returnT)
-      (cond (or (:: type.equivalence = type.boolean returnT)
-                (:: type.equivalence = type.byte returnT)
-                (:: type.equivalence = type.short returnT)
-                (:: type.equivalence = type.int returnT)
-                (:: type.equivalence = type.char returnT))
-            _.ireturn
-
-            (:: type.equivalence = type.long returnT)
-            _.lreturn
-
-            (:: type.equivalence = type.float returnT)
-            _.freturn
-
-            ## (:: type.equivalence = type.double returnT)
-            _.dreturn))))
-
-(def: class::anonymous
-  Handler
-  (..custom
-   [($_ <>.and
-        <s>.text
-        ..class
-        (<s>.tuple (<>.some ..class))
-        (<s>.tuple (<>.some ..input))
-        (<s>.tuple (<>.some ..overriden-method-definition)))
-    (function (_ extension-name generate [class-name
-                                          super-class super-interfaces
-                                          inputsTS
-                                          overriden-methods])
-      (do /////.monad
-        [#let [class (type.class class-name (list))
-               total-environment (|> overriden-methods
-                                     ## Get all the environments.
-                                     (list@map product.left)
-                                     ## Combine them.
-                                     list@join
-                                     ## Remove duplicates.
-                                     (set.from-list //////reference.hash)
-                                     set.to-list)
-               global-mapping (|> total-environment
-                                  ## Give them names as "foreign" variables.
-                                  list.enumerate
-                                  (list@map (function (_ [id capture])
-                                              [capture (#//////reference.Foreign id)]))
-                                  (dictionary.from-list //////reference.hash))
-               normalized-methods (list@map (function (_ [environment
-                                                          [ownerT name
-                                                           strict-fp? annotations vars
-                                                           self-name arguments returnT exceptionsT
-                                                           body]])
-                                              (let [local-mapping (|> environment
-                                                                      list.enumerate
-                                                                      (list@map (function (_ [foreign-id capture])
-                                                                                  [(#//////reference.Foreign foreign-id)
-                                                                                   (|> global-mapping
-                                                                                       (dictionary.get capture)
-                                                                                       maybe.assume)]))
-                                                                      (dictionary.from-list //////reference.hash))]
-                                                [ownerT name
-                                                 strict-fp? annotations vars
-                                                 self-name arguments returnT exceptionsT
-                                                 (normalize-method-body local-mapping body)]))
-                                            overriden-methods)]
-         inputsTI (monad.map @ (generate-input generate) inputsTS)
-         method-definitions (monad.map @ (function (_ [ownerT name
-                                                       strict-fp? annotations vars
-                                                       self-name arguments returnT exceptionsT
-                                                       bodyS])
-                                           (do @
-                                             [bodyG (//////generation.with-specific-context class-name
-                                                      (generate bodyS))]
-                                             (wrap (method.method ($_ modifier@compose
-                                                                      method.public
-                                                                      method.final
-                                                                      (if strict-fp?
-                                                                        method.strict
-                                                                        modifier@identity))
-                                                                  name
-                                                                  (type.method [(list@map product.right arguments)
-                                                                                returnT
-                                                                                exceptionsT])
-                                                                  (list)
-                                                                  (#.Some ($_ _.compose
-                                                                              bodyG
-                                                                              (returnG returnT)))))))
-                                       normalized-methods)
-         bytecode (<| (:: @ map (format.run class.writer))
-                      /////.lift
-                      (class.class version.v6_0 ($_ modifier@compose class.public class.final)
-                                   (name.internal class-name)
-                                   (name.internal (..reflection super-class))
-                                   (list@map (|>> ..reflection name.internal) super-interfaces)
-                                   (foreign.variables total-environment)
-                                   (list& (..with-anonymous-init class total-environment super-class inputsTI)
-                                          method-definitions)
-                                   (row.row)))
-         _ (//////generation.save! true ["" class-name] [class-name bytecode])]
-        (anonymous-instance class total-environment)))]))
-
-(def: bundle::class
-  Bundle
-  (<| (/////bundle.prefix "class")
-      (|> (: Bundle /////bundle.empty)
-          (/////bundle.install "anonymous" class::anonymous)
-          )))
-
-(def: #export bundle
-  Bundle
-  (<| (/////bundle.prefix "jvm")
-      (|> ..bundle::conversion
-          (dictionary.merge ..bundle::int)
-          (dictionary.merge ..bundle::long)
-          (dictionary.merge ..bundle::float)
-          (dictionary.merge ..bundle::double)
-          (dictionary.merge ..bundle::char)
-          (dictionary.merge ..bundle::array)
-          (dictionary.merge ..bundle::object)
-          (dictionary.merge ..bundle::member)
-          (dictionary.merge ..bundle::class)
-          )))
-- 
cgit v1.2.3