Split new-luxc into lux-jvm and lux-r.

2 files changed, 0 insertions, 1435 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
deleted file mode 100644
index 383415c0a..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux
+++ /dev/null
@@ -1,388 +0,0 @@
-(.module:
-  [lux (#- Type)
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." try]
-    ["<>" parser
-     ["<s>" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    [number
-     ["f" frac]]
-    [collection
-     ["." list ("#@." monad)]
-     ["." dictionary]]]
-   [target
-    [jvm
-     ["." type]]]
-   [tool
-    [compiler
-     ["." phase]
-     [meta
-      [archive (#+ Archive)]]
-     [language
-      [lux
-       ["." 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 Archive s (Operation Inst))]
-        Handler))
-  (function (_ extension-name phase archive input)
-    (case (<s>.run parser input)
-      (#try.Success input')
-      (handler extension-name phase archive 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 archive [input else conditionals])
-               (<| _.with-label (function (_ @end))
-                   _.with-label (function (_ @else))
-                   (do {@ phase.monad}
-                     [inputG (phase archive input)
-                      elseG (phase archive else)
-                      conditionalsG+ (: (Operation (List [(List [Int Label])
-                                                          Inst]))
-                                        (monad.map @ (function (_ [chars branch])
-                                                       (do @
-                                                         [branchG (phase archive 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
deleted file mode 100644
index 7b90a8e4f..000000000
--- a/new-luxc/source/luxc/lang/translation/jvm/extension/host.lux
+++ /dev/null
@@ -1,1047 +0,0 @@
-(.module:
-  [lux (#- Type primitive int char type)
-   [host (#+ import:)]
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." exception (#+ exception:)]
-    ["." function]
-    ["<>" parser ("#@." monad)
-     ["<t>" text]
-     ["<s>" synthesis (#+ Parser)]]]
-   [data
-    ["." product]
-    ["." maybe]
-    ["." text ("#@." equivalence)
-     ["%" format (#+ format)]]
-    [number
-     ["." nat]]
-    [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]
-      ["." signature]
-      ["." parser]]]]
-   [tool
-    [compiler
-     ["." reference (#+ Variable)]
-     ["." phase ("#@." monad)]
-     [meta
-      [archive (#+ Archive)]]
-     [language
-      [lux
-       [analysis (#+ Environment)]
-       ["." synthesis (#+ Synthesis Path %synthesis)]
-       ["." generation]
-       [phase
-        [generation
-         [extension (#+ Nullary Unary Binary
-                        nullary unary binary)]]
-        [analysis
-         [".A" reference]]
-        ["." extension
-         ["." bundle]
-         [analysis
-          ["/" jvm]]]]]]]]]
-  [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 archive arrayS)
-      (do phase.monad
-        [arrayI (generate archive arrayS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array jvm-primitive))
-                   _.ARRAYLENGTH))))]))
-
-(def: array::length::object
-  Handler
-  (..custom
-   [($_ <>.and ..object-array <s>.any)
-    (function (_ extension-name generate archive [elementJT arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)]
-        (wrap (|>> arrayI
-                   (_.CHECKCAST (type.array elementJT))
-                   _.ARRAYLENGTH))))]))
-
-(def: (new-primitive-array-handler jvm-primitive)
-  (-> (Type Primitive) Handler)
-  (function (_ extension-name generate archive inputs)
-    (case inputs
-      (^ (list lengthS))
-      (do phase.monad
-        [lengthI (generate archive 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 archive [objectJT lengthS])
-      (do phase.monad
-        [lengthI (generate archive lengthS)]
-        (wrap (|>> lengthI
-                   (_.ANEWARRAY objectJT)))))]))
-
-(def: (read-primitive-array-handler jvm-primitive loadI)
-  (-> (Type Primitive) Inst Handler)
-  (function (_ extension-name generate archive inputs)
-    (case inputs
-      (^ (list idxS arrayS))
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive 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 archive [elementJT idxS arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive 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 archive inputs)
-    (case inputs
-      (^ (list idxS valueS arrayS))
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)
-         valueI (generate archive 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 archive [elementJT idxS valueS arrayS])
-      (do phase.monad
-        [arrayI (generate archive arrayS)
-         idxI (generate archive idxS)
-         valueI (generate archive 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 archive 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 archive [class objectS])
-      (do phase.monad
-        [objectI (generate archive objectS)]
-        (wrap (|>> objectI
-                   (_.INSTANCEOF (type.class class (list)))
-                   (_.wrap type.boolean)))))]))
-
-(def: (object::cast extension-name generate archive inputs)
-  Handler
-  (case inputs
-    (^ (list (synthesis.text from) (synthesis.text to) valueS))
-    (do phase.monad
-      [valueI (generate archive 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 archive [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 archive [class field unboxed valueS])
-      (do phase.monad
-        [valueI (generate archive 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 archive [class field unboxed objectS])
-      (do phase.monad
-        [objectI (generate archive 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 archive [class field unboxed valueS objectS])
-      (do phase.monad
-        [valueI (generate archive valueS)
-         objectI (generate archive 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 archive [valueT valueS])
-  (-> Phase Archive Input
-      (Operation (Typed Inst)))
-  (do phase.monad
-    [valueI (generate archive 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 archive [class method outputT inputsTS])
-      (do {@ phase.monad}
-        [inputsTI (monad.map @ (generate-input generate archive) 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 archive [class method outputT objectS inputsTS])
-         (do {@ phase.monad}
-           [objectI (generate archive objectS)
-            inputsTI (monad.map @ (generate-input generate archive) 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 archive [class inputsTS])
-      (do {@ phase.monad}
-        [inputsTI (monad.map @ (generate-input generate archive) 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 (Type 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 archive class env)
-  (-> Archive (Type Class) Environment (Operation Inst))
-  (do {@ phase.monad}
-    [captureI+ (monad.map @ (///reference.variable archive) 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)
-      (|>> (_.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
-        ..class
-        (<s>.tuple (<>.some ..class))
-        (<s>.tuple (<>.some ..input))
-        (<s>.tuple (<>.some ..overriden-method-definition)))
-    (function (_ extension-name generate archive [super-class super-interfaces
-                                                  inputsTS
-                                                  overriden-methods])
-      (do {@ phase.monad}
-        [[context _] (generation.with-new-context archive (wrap []))
-         #let [[module-id artifact-id] context
-               anonymous-class-name (///.class-name context)
-               class (type.class anonymous-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 archive) inputsTS)
-         method-definitions (|> normalized-methods
-                                (monad.map @ (function (_ [ownerT name
-                                                           strict-fp? annotations vars
-                                                           self-name arguments returnT exceptionsT
-                                                           bodyS])
-                                               (do @
-                                                 [bodyG (generation.with-context artifact-id
-                                                          (generate archive 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 ["" (%.nat artifact-id)]
-                             [anonymous-class-name
-                              (_def.class #$.V1_6 #$.Public $.finalC
-                                          anonymous-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 archive 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)
-          )))