Some refactoring.

2 files changed, 1423 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
new file mode 100644
index 000000000..a46813232
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
@@ -0,0 +1,385 @@
+(.module:
+  [lux (#- Type)
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try]
+    ["<>" parser
+     ["<s>" synthesis (#+ Parser)]]
+    ["ex" exception (#+ exception:)]]
+   [data
+    ["." product]
+    [number
+     ["f" frac]]
+    [collection
+     ["." list ("#@." monad)]
+     ["." dictionary]]]
+   [target
+    [jvm
+     ["." type
+      ["." signature]]]]
+   [tool
+    [compiler
+     ["." synthesis (#+ Synthesis %synthesis)]
+     ["." phase
+      [generation
+       [extension (#+ Nullary Unary Binary Trinary Variadic
+                      nullary unary binary trinary variadic)]]
+      ["." extension
+       ["." bundle]]]]]
+   [host (#+ import:)]]
+  [luxc
+   [lang
+    [host
+     ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
+      ["_" inst]]]]]
+  ["." ///
+   ["." runtime]])
+
+(def: #export (custom [parser handler])
+  (All [s]
+    (-> [(Parser s)
+         (-> Text Phase s (Operation Inst))]
+        Handler))
+  (function (_ extension-name phase input)
+    (case (<s>.run input parser)
+      (#try.Success input')
+      (handler extension-name phase input')
+
+      (#try.Failure error)
+      (phase.throw extension.invalid-syntax [extension-name %synthesis input]))))
+
+(import: java/lang/Double
+  (#static MIN_VALUE Double)
+  (#static MAX_VALUE Double))
+
+(def: $String (type.class "java.lang.String" (list)))
+(def: $CharSequence (type.class "java.lang.CharSequence" (list)))
+(def: $System (type.class "java.lang.System" (list)))
+(def: $Object (type.class "java.lang.Object" (list)))
+
+(def: lux-intI Inst (|>> _.I2L (_.wrap type.long)))
+(def: jvm-intI Inst (|>> (_.unwrap type.long) _.L2I))
+(def: check-stringI Inst (_.CHECKCAST $String))
+
+(def: (predicateI tester)
+  (-> (-> Label Inst)
+      Inst)
+  (let [$Boolean (type.class "java.lang.Boolean" (list))]
+    (<| _.with-label (function (_ @then))
+        _.with-label (function (_ @end))
+        (|>> (tester @then)
+             (_.GETSTATIC $Boolean "FALSE" $Boolean)
+             (_.GOTO @end)
+             (_.label @then)
+             (_.GETSTATIC $Boolean "TRUE" $Boolean)
+             (_.label @end)
+             ))))
+
+(def: unitI Inst (_.string synthesis.unit))
+
+## 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 [input else conditionals])
+               (<| _.with-label (function (_ @end))
+                   _.with-label (function (_ @else))
+                   (do phase.monad
+                     [inputG (phase input)
+                      elseG (phase else)
+                      conditionalsG+ (: (Operation (List [(List [Int Label])
+                                                          Inst]))
+                                        (monad.map @ (function (_ [chars branch])
+                                                       (do @
+                                                         [branchG (phase branch)]
+                                                         (wrap (<| _.with-label (function (_ @branch))
+                                                                   [(list@map (function (_ char)
+                                                                                [(.int char) @branch])
+                                                                              chars)
+                                                                    (|>> (_.label @branch)
+                                                                         branchG
+                                                                         (_.GOTO @end))]))))
+                                                   conditionals))
+                      #let [table (|> conditionalsG+
+                                      (list@map product.left)
+                                      list@join)
+                            conditionalsG (|> conditionalsG+
+                                              (list@map product.right)
+                                              _.fuse)]]
+                     (wrap (|>> inputG (_.unwrap type.long) _.L2I
+                                (_.LOOKUPSWITCH @else table)
+                                conditionalsG
+                                (_.label @else)
+                                elseG
+                                (_.label @end)
+                                )))))]))
+
+(def: (lux::is [referenceI sampleI])
+  (Binary Inst)
+  (|>> referenceI
+       sampleI
+       (predicateI _.IF_ACMPEQ)))
+
+(def: (lux::try riskyI)
+  (Unary Inst)
+  (|>> riskyI
+       (_.CHECKCAST ///.$Function)
+       (_.INVOKESTATIC ///.$Runtime "try" runtime.try)))
+
+(template [<name> <op>]
+  [(def: (<name> [maskI inputI])
+     (Binary Inst)
+     (|>> inputI (_.unwrap type.long)
+          maskI (_.unwrap type.long)
+          <op> (_.wrap type.long)))]
+
+  [i64::and _.LAND]
+  [i64::or  _.LOR]
+  [i64::xor _.LXOR]
+  )
+
+(template [<name> <op>]
+  [(def: (<name> [shiftI inputI])
+     (Binary Inst)
+     (|>> inputI (_.unwrap type.long)
+          shiftI jvm-intI
+          <op>
+          (_.wrap type.long)))]
+
+  [i64::left-shift             _.LSHL]
+  [i64::arithmetic-right-shift _.LSHR]
+  [i64::logical-right-shift    _.LUSHR]
+  )
+
+(template [<name> <const> <type>]
+  [(def: (<name> _)
+     (Nullary Inst)
+     (|>> <const> (_.wrap <type>)))]
+
+  [f64::smallest (_.double (Double::MIN_VALUE))            type.double]
+  [f64::min      (_.double (f.* -1.0 (Double::MAX_VALUE))) type.double]
+  [f64::max      (_.double (Double::MAX_VALUE))            type.double]
+  )
+
+(template [<name> <type> <op>]
+  [(def: (<name> [paramI subjectI])
+     (Binary Inst)
+     (|>> subjectI (_.unwrap <type>)
+          paramI (_.unwrap <type>)
+          <op>
+          (_.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> [paramI subjectI])
+        (Binary Inst)
+        (|>> subjectI (_.unwrap <type>)
+             paramI (_.unwrap <type>)
+             <cmp>
+             (_.int <reference>)
+             (predicateI _.IF_ICMPEQ)))]
+     
+     [<eq> +0]
+     [<lt> -1])]
+
+  [i64::= i64::< type.long   _.LCMP]
+  [f64::= f64::< type.double _.DCMPG]
+  )
+
+(template [<name> <prepare> <transform>]
+  [(def: (<name> inputI)
+     (Unary Inst)
+     (|>> inputI <prepare> <transform>))]
+
+  [i64::f64 (_.unwrap type.long) (<| (_.wrap type.double) _.L2D)]
+  [i64::char (_.unwrap type.long)
+   ((|>> _.L2I _.I2C (_.INVOKESTATIC (type.class "java.lang.Character" (list)) "toString" (type.method [(list type.char) $String (list)]))))]
+
+  [f64::i64 (_.unwrap type.double) (<| (_.wrap type.long) _.D2L)]
+  [f64::encode (_.unwrap type.double)
+   (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "toString" (type.method [(list type.double) $String (list)]))]
+  [f64::decode ..check-stringI
+   (_.INVOKESTATIC ///.$Runtime "decode_frac" (type.method [(list $String) ///.$Variant (list)]))]
+  )
+
+(def: (text::size inputI)
+  (Unary Inst)
+  (|>> inputI
+       ..check-stringI
+       (_.INVOKEVIRTUAL $String "length" (type.method [(list) type.int (list)]))
+       lux-intI))
+
+(template [<name> <pre-subject> <pre-param> <op> <post>]
+  [(def: (<name> [paramI subjectI])
+     (Binary Inst)
+     (|>> subjectI <pre-subject>
+          paramI <pre-param>
+          <op> <post>))]
+
+  [text::= (<|) (<|)
+   (_.INVOKEVIRTUAL $Object "equals" (type.method [(list $Object) type.boolean (list)]))
+   (_.wrap type.boolean)]
+  [text::< ..check-stringI ..check-stringI
+   (_.INVOKEVIRTUAL $String "compareTo" (type.method [(list $String) type.int (list)]))
+   (predicateI _.IFLT)]
+  [text::char ..check-stringI jvm-intI
+   (_.INVOKEVIRTUAL $String "charAt" (type.method [(list type.int) type.char (list)]))
+   lux-intI]
+  )
+
+(def: (text::concat [leftI rightI])
+  (Binary Inst)
+  (|>> leftI ..check-stringI
+       rightI ..check-stringI
+       (_.INVOKEVIRTUAL $String "concat" (type.method [(list $String) $String (list)]))))
+
+(def: (text::clip [startI endI subjectI])
+  (Trinary Inst)
+  (|>> subjectI ..check-stringI
+       startI jvm-intI
+       endI jvm-intI
+       (_.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 [startI partI textI])
+  (Trinary Inst)
+  (<| _.with-label (function (_ @not-found))
+      _.with-label (function (_ @end))
+      (|>> textI ..check-stringI
+           partI ..check-stringI
+           startI jvm-intI
+           (_.INVOKEVIRTUAL $String "indexOf" index-method)
+           _.DUP
+           (_.int -1)
+           (_.IF_ICMPEQ @not-found)
+           lux-intI
+           runtime.someI
+           (_.GOTO @end)
+           (_.label @not-found)
+           _.POP
+           runtime.noneI
+           (_.label @end))))
+
+(def: string-method (type.method [(list $String) type.void (list)]))
+(def: (io::log messageI)
+  (Unary Inst)
+  (let [$PrintStream (type.class "java.io.PrintStream" (list))]
+    (|>> (_.GETSTATIC $System "out" $PrintStream)
+         messageI
+         ..check-stringI
+         (_.INVOKEVIRTUAL $PrintStream "println" string-method)
+         unitI)))
+
+(def: (io::error messageI)
+  (Unary Inst)
+  (let [$Error (type.class "java.lang.Error" (list))]
+    (|>> (_.NEW $Error)
+         _.DUP
+         messageI
+         ..check-stringI
+         (_.INVOKESPECIAL $Error "<init>" string-method)
+         _.ATHROW)))
+
+(def: (io::exit codeI)
+  (Unary Inst)
+  (|>> codeI jvm-intI
+       (_.INVOKESTATIC $System "exit" (type.method [(list type.int) type.void (list)]))
+       _.NULL))
+
+(def: (io::current-time _)
+  (Nullary Inst)
+  (|>> (_.INVOKESTATIC $System "currentTimeMillis" (type.method [(list) type.long (list)]))
+       (_.wrap type.long)))
+
+(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))))
+
+(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: 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: 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/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
new file mode 100644
index 000000000..ca6e31bfd
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
@@ -0,0 +1,1038 @@
+(.module:
+  [lux (#- Type primitive int char type)
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." exception (#+ exception:)]
+    ["." function]
+    ["<>" parser ("#@." monad)
+     ["<t>" text]
+     ["<s>" synthesis (#+ Parser)]]]
+   [data
+    ["." product]
+    ["." maybe]
+    [number
+     ["." nat]]
+    ["." text ("#@." equivalence)]
+    [collection
+     ["." list ("#@." monad)]
+     ["." dictionary (#+ Dictionary)]
+     ["." set]]]
+   [target
+    [jvm
+     ["." type (#+ Type Typed Argument)
+      ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+      ["." box]
+      ["." reflection]
+      ["." descriptor (#+ Descriptor)]
+      ["." signature (#+ Signature)]
+      ["." parser]]]]
+   [tool
+    [compiler
+     [analysis (#+ Environment)]
+     ["." reference (#+ Variable)]
+     ["." synthesis (#+ Synthesis Path %synthesis)]
+     ["." phase ("#@." monad)
+      ["." generation
+       [extension (#+ Nullary Unary Binary
+                      nullary unary binary)]]
+      [analysis
+       [".A" reference]]
+      ["." extension
+       ["." bundle]
+       [analysis
+        ["/" jvm]]]]]]
+   [host (#+ import:)]]
+  [luxc
+   [lang
+    [host
+     ["$" jvm (#+ Label Inst Def Handler Bundle Operation Phase)
+      ["_" inst]
+      ["_." def]]]]]
+  ["." // #_
+   [common (#+ custom)]
+   ["/#" // #_
+    ["#." reference]
+    ["#." function]]])
+
+(template [<name> <category> <parser>]
+  [(def: #export <name>
+     (Parser (Type <category>))
+     (<t>.embed <parser> <s>.text))]
+
+  [var Var parser.var]
+  [class 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))))
+
+(template [<name> <inst>]
+  [(def: <name>
+     Inst
+     <inst>)]
+
+  [L2S (|>> _.L2I _.I2S)]
+  [L2B (|>> _.L2I _.I2B)]
+  [L2C (|>> _.L2I _.I2C)]
+  )
+
+(template [<conversion> <name>]
+  [(def: (<name> inputI)
+     (Unary Inst)
+     (if (is? _.NOP <conversion>)
+       inputI
+       (|>> inputI
+            <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: 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> [xI yI])
+     (Binary Inst)
+     (|>> xI
+          yI
+          <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: falseI (_.GETSTATIC $Boolean "FALSE" $Boolean))
+(def: trueI (_.GETSTATIC $Boolean "TRUE" $Boolean))
+
+(template [<name> <op>]
+  [(def: (<name> [xI yI])
+     (Binary Inst)
+     (<| _.with-label (function (_ @then))
+         _.with-label (function (_ @end))
+         (|>> xI
+              yI
+              (<op> @then)
+              falseI
+              (_.GOTO @end)
+              (_.label @then)
+              trueI
+              (_.label @end))))]
+
+  [int::= _.IF_ICMPEQ]
+  [int::< _.IF_ICMPLT]
+
+  [char::= _.IF_ICMPEQ]
+  [char::< _.IF_ICMPLT]
+  )
+
+(template [<name> <op> <reference>]
+  [(def: (<name> [xI yI])
+     (Binary Inst)
+     (<| _.with-label (function (_ @then))
+         _.with-label (function (_ @end))
+         (|>> xI
+              yI
+              <op>
+              (_.int <reference>)
+              (_.IF_ICMPEQ @then)
+              falseI
+              (_.GOTO @end)
+              (_.label @then)
+              trueI
+              (_.label @end))))]
+
+  [long::= _.LCMP +0]
+  [long::< _.LCMP -1]
+  
+  [float::= _.FCMPG +0]
+  [float::< _.FCMPG -1]
+
+  [double::= _.DCMPG +0]
+  [double::< _.DCMPG -1]
+  )
+
+(def: 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: 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: 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: 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: char
+  Bundle
+  (<| (bundle.prefix (reflection.reflection reflection.char))
+      (|> (: Bundle bundle.empty)
+          (bundle.install "=" (binary char::=))
+          (bundle.install "<" (binary char::<))
+          )))
+
+(def: (primitive-array-length-handler jvm-primitive)
+  (-> (Type Primitive) Handler)
+  (..custom
+   [<s>.any
+    (function (_ extension-name generate arrayS)
+      (do phase.monad
+        [arrayI (generate arrayS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array jvm-primitive))
+                   _.ARRAYLENGTH))))]))
+
+(def: array::length::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any)
+    (function (_ extension-name generate [elementJT arrayS])
+      (do phase.monad
+        [arrayI (generate arrayS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array elementJT))
+                   _.ARRAYLENGTH))))]))
+
+(def: (new-primitive-array-handler jvm-primitive)
+  (-> (Type Primitive) Handler)
+  (function (_ extension-name generate inputs)
+    (case inputs
+      (^ (list lengthS))
+      (do phase.monad
+        [lengthI (generate lengthS)]
+        (wrap (|>> lengthI
+                   (_.array jvm-primitive))))
+
+      _
+      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
+
+(def: array::new::object
+  Handler
+  (..custom
+   [($_ <>.and ..object <s>.any)
+    (function (_ extension-name generate [objectJT lengthS])
+      (do phase.monad
+        [lengthI (generate lengthS)]
+        (wrap (|>> lengthI
+                   (_.ANEWARRAY objectJT)))))]))
+
+(def: (read-primitive-array-handler jvm-primitive loadI)
+  (-> (Type Primitive) Inst Handler)
+  (function (_ extension-name generate inputs)
+    (case inputs
+      (^ (list idxS arrayS))
+      (do phase.monad
+        [arrayI (generate arrayS)
+         idxI (generate idxS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array jvm-primitive))
+                   idxI
+                   loadI)))
+
+      _
+      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
+
+(def: array::read::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any <s>.any)
+    (function (_ extension-name generate [elementJT idxS arrayS])
+      (do phase.monad
+        [arrayI (generate arrayS)
+         idxI (generate idxS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array elementJT))
+                   idxI
+                   _.AALOAD))))]))
+
+(def: (write-primitive-array-handler jvm-primitive storeI)
+  (-> (Type Primitive) Inst Handler)
+  (function (_ extension-name generate inputs)
+    (case inputs
+      (^ (list idxS valueS arrayS))
+      (do phase.monad
+        [arrayI (generate arrayS)
+         idxI (generate idxS)
+         valueI (generate valueS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array jvm-primitive))
+                   _.DUP
+                   idxI
+                   valueI
+                   storeI)))
+
+      _
+      (phase.throw extension.invalid-syntax [extension-name %synthesis inputs]))))
+
+(def: array::write::object
+  Handler
+  (..custom
+   [($_ <>.and ..object-array <s>.any <s>.any <s>.any)
+    (function (_ extension-name generate [elementJT idxS valueS arrayS])
+      (do phase.monad
+        [arrayI (generate arrayS)
+         idxI (generate idxS)
+         valueI (generate valueS)]
+        (wrap (|>> arrayI
+                   (_.CHECKCAST (type.array elementJT))
+                   _.DUP
+                   idxI
+                   valueI
+                   _.AASTORE))))]))
+
+(def: 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 type.boolean))
+                                    (bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler type.byte))
+                                    (bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler type.short))
+                                    (bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler type.int))
+                                    (bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler type.long))
+                                    (bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler type.float))
+                                    (bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler type.double))
+                                    (bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler type.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 Inst)
+  _.NULL)
+
+(def: (object::null? objectI)
+  (Unary Inst)
+  (<| _.with-label (function (_ @then))
+      _.with-label (function (_ @end))
+      (|>> objectI
+           (_.IFNULL @then)
+           falseI
+           (_.GOTO @end)
+           (_.label @then)
+           trueI
+           (_.label @end))))
+
+(def: (object::synchronized [monitorI exprI])
+  (Binary Inst)
+  (|>> monitorI
+       _.DUP
+       _.MONITORENTER
+       exprI
+       _.SWAP
+       _.MONITOREXIT))
+
+(def: (object::throw exceptionI)
+  (Unary Inst)
+  (|>> exceptionI
+       _.ATHROW))
+
+(def: $Class (type.class "java.lang.Class" (list)))
+
+(def: (object::class extension-name generate inputs)
+  Handler
+  (case inputs
+    (^ (list (synthesis.text class)))
+    (do phase.monad
+      []
+      (wrap (|>> (_.string class)
+                 (_.INVOKESTATIC $Class "forName" (type.method [(list (type.class "java.lang.String" (list))) $Class (list)])))))
+
+    _
+    (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+
+(def: object::instance?
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.any)
+    (function (_ extension-name generate [class objectS])
+      (do phase.monad
+        [objectI (generate objectS)]
+        (wrap (|>> objectI
+                   (_.INSTANCEOF (type.class class (list)))
+                   (_.wrap type.boolean)))))]))
+
+(def: (object::cast extension-name generate inputs)
+  Handler
+  (case inputs
+    (^ (list (synthesis.text from) (synthesis.text to) valueS))
+    (do phase.monad
+      [valueI (generate valueS)]
+      (`` (cond (~~ (template [<object> <type>]
+                      [(and (text@= (reflection.reflection (type.reflection <type>))
+                                    from)
+                            (text@= <object>
+                                    to))
+                       (wrap (|>> valueI (_.wrap <type>)))
+
+                       (and (text@= <object>
+                                    from)
+                            (text@= (reflection.reflection (type.reflection <type>))
+                                    to))
+                       (wrap (|>> valueI (_.unwrap <type>)))]
+                      
+                      [box.boolean type.boolean]
+                      [box.byte    type.byte]
+                      [box.short   type.short]
+                      [box.int     type.int]
+                      [box.long    type.long]
+                      [box.float   type.float]
+                      [box.double  type.double]
+                      [box.char    type.char]))
+                ## else
+                (wrap valueI))))
+
+    _
+    (phase.throw extension.invalid-syntax [extension-name %synthesis inputs])))
+
+(def: object-bundle
+  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 phase.monad
+        []
+        (case (dictionary.get unboxed ..primitives)
+          (#.Some primitive)
+          (wrap (_.GETSTATIC (type.class class (list)) field primitive))
+          
+          #.None
+          (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))]))
+
+(def: put::static
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+    (function (_ extension-name generate [class field unboxed valueS])
+      (do phase.monad
+        [valueI (generate valueS)
+         #let [$class (type.class class (list))]]
+        (case (dictionary.get unboxed ..primitives)
+          (#.Some primitive)
+          (wrap (|>> valueI
+                     (_.PUTSTATIC $class field primitive)
+                     (_.string synthesis.unit)))
+          
+          #.None
+          (wrap (|>> valueI
+                     (_.CHECKCAST $class)
+                     (_.PUTSTATIC $class field $class)
+                     (_.string synthesis.unit))))))]))
+
+(def: get::virtual
+  Handler
+  (..custom
+   [($_ <>.and <s>.text <s>.text <s>.text <s>.any)
+    (function (_ extension-name generate [class field unboxed objectS])
+      (do phase.monad
+        [objectI (generate objectS)
+         #let [$class (type.class class (list))
+               getI (case (dictionary.get unboxed ..primitives)
+                      (#.Some primitive)
+                      (_.GETFIELD $class field primitive)
+                      
+                      #.None
+                      (_.GETFIELD $class field (type.class unboxed (list))))]]
+        (wrap (|>> objectI
+                   (_.CHECKCAST $class)
+                   getI))))]))
+
+(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 phase.monad
+        [valueI (generate valueS)
+         objectI (generate objectS)
+         #let [$class (type.class class (list))
+               putI (case (dictionary.get unboxed ..primitives)
+                      (#.Some primitive)
+                      (_.PUTFIELD $class field primitive)
+                      
+                      #.None
+                      (let [$unboxed (type.class unboxed (list))]
+                        (|>> (_.CHECKCAST $unboxed)
+                             (_.PUTFIELD $class field $unboxed))))]]
+        (wrap (|>> objectI
+                   (_.CHECKCAST $class)
+                   _.DUP
+                   valueI
+                   putI))))]))
+
+(type: Input (Typed Synthesis))
+
+(def: input
+  (Parser Input)
+  (<s>.tuple (<>.and ..value <s>.any)))
+
+(def: (generate-input generate [valueT valueS])
+  (-> (-> Synthesis (Operation Inst)) Input
+      (Operation (Typed Inst)))
+  (do phase.monad
+    [valueI (generate valueS)]
+    (case (type.primitive? valueT)
+      (#.Right valueT)
+      (wrap [valueT valueI])
+      
+      (#.Left valueT)
+      (wrap [valueT (|>> valueI
+                         (_.CHECKCAST valueT))]))))
+
+(def: voidI (_.string synthesis.unit))
+
+(def: (prepare-output outputT)
+  (-> (Type Return) Inst)
+  (case (type.void? outputT)
+    (#.Right outputT)
+    ..voidI
+    
+    (#.Left outputT)
+    function.identity))
+
+(def: invoke::static
+  Handler
+  (..custom
+   [($_ <>.and ..class <s>.text ..return (<>.some ..input))
+    (function (_ extension-name generate [class method outputT inputsTS])
+      (do phase.monad
+        [inputsTI (monad.map @ (generate-input generate) inputsTS)]
+        (wrap (|>> (_.fuse (list@map product.right inputsTI))
+                   (_.INVOKESTATIC class method (type.method [(list@map product.left inputsTI) 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 phase.monad
+           [objectI (generate objectS)
+            inputsTI (monad.map @ (generate-input generate) inputsTS)]
+           (wrap (|>> objectI
+                      (_.CHECKCAST class)
+                      (_.fuse (list@map product.right inputsTI))
+                      (<invoke> class method
+                                (type.method [(list@map product.left inputsTI)
+                                              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 phase.monad
+        [inputsTI (monad.map @ (generate-input generate) inputsTS)]
+        (wrap (|>> (_.NEW class)
+                   _.DUP
+                   (_.fuse (list@map product.right inputsTI))
+                   (_.INVOKESPECIAL class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)]))))))]))
+
+(def: 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 [(Signature Method) (Descriptor Method)])
+  (type.method [(list.repeat (list.size env) $Object)
+                type.void
+                (list)]))
+
+(def: (with-anonymous-init class env super-class inputsTI)
+  (-> (Type Class) Environment (Type Class) (List (Typed Inst)) Def)
+  (let [store-capturedI (|> env
+                            list.size
+                            list.indices
+                            (list@map (.function (_ register)
+                                        (|>> (_.ALOAD 0)
+                                             (_.ALOAD (inc register))
+                                             (_.PUTFIELD class (///reference.foreign-name register) $Object))))
+                            _.fuse)]
+    (_def.method #$.Public $.noneM "<init>" (anonymous-init-method env)
+                 (|>> (_.ALOAD 0)
+                      ((_.fuse (list@map product.right inputsTI)))
+                      (_.INVOKESPECIAL super-class "<init>" (type.method [(list@map product.left inputsTI) type.void (list)]))
+                      store-capturedI
+                      _.RETURN))))
+
+(def: (anonymous-instance class env)
+  (-> (Type Class) Environment (Operation Inst))
+  (do phase.monad
+    [captureI+ (monad.map @ ///reference.variable env)]
+    (wrap (|>> (_.NEW class)
+               _.DUP
+               (_.fuse captureI+)
+               (_.INVOKESPECIAL class "<init>" (anonymous-init-method env))))))
+
+(def: (returnI returnT)
+  (-> (Type Return) Inst)
+  (case (type.void? returnT)
+    (#.Right returnT)
+    _.RETURN
+
+    (#.Left returnT)
+    (case (type.primitive? returnT)
+      (#.Left 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 phase.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 (|> normalized-methods
+                                (monad.map @ (function (_ [ownerT name
+                                                           strict-fp? annotations vars
+                                                           self-name arguments returnT exceptionsT
+                                                           bodyS])
+                                               (do @
+                                                 [bodyG (generate bodyS)]
+                                                 (wrap (_def.method #$.Public
+                                                                    (if strict-fp?
+                                                                      ($_ $.++M $.finalM $.strictM)
+                                                                      $.finalM)
+                                                                    name
+                                                                    (type.method [(list@map product.right arguments)
+                                                                                  returnT
+                                                                                  exceptionsT])
+                                                                    (|>> bodyG (returnI returnT)))))))
+                                (:: @ map _def.fuse))
+         _ (generation.save! true ["" class-name]
+                             [class-name
+                              (_def.class #$.V1_6 #$.Public $.finalC
+                                          class-name (list)
+                                          super-class super-interfaces
+                                          (|>> (///function.with-environment total-environment)
+                                               (..with-anonymous-init class total-environment super-class inputsTI)
+                                               method-definitions))])]
+        (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")
+      (|> ..conversion
+          (dictionary.merge ..int)
+          (dictionary.merge ..long)
+          (dictionary.merge ..float)
+          (dictionary.merge ..double)
+          (dictionary.merge ..char)
+          (dictionary.merge ..array)
+          (dictionary.merge ..object-bundle)
+          (dictionary.merge ..member)
+          (dictionary.merge ..bundle::class)
+          )))