- Moved all translation code under the JVM path (in preparation for porting the JS back-end).

2 files changed, 1570 insertions, 0 deletions

diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
new file mode 100644
index 000000000..c7513fd6e
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -0,0 +1,809 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["p" parser]
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [macro #+ with-gensyms]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" lang]
+        (lang [".L" host]
+              (host ["$" jvm]
+                    (jvm ["$t" type]
+                         ["$d" def]
+                         ["$i" inst]))
+              ["la" analysis]
+              ["ls" synthesis]))
+  (/// [".T" runtime]
+       [".T" case]
+       [".T" function]
+       [".T" loop]))
+
+(host.import java/lang/Long
+  (#static MIN_VALUE Long)
+  (#static MAX_VALUE Long))
+
+(host.import java/lang/Double
+  (#static MIN_VALUE Double)
+  (#static MAX_VALUE Double)
+  (#static NaN Double)
+  (#static POSITIVE_INFINITY Double)
+  (#static NEGATIVE_INFINITY Double))
+
+## [Types]
+(type: #export Translator
+  (-> ls.Synthesis (Meta $.Inst)))
+
+(type: #export Proc
+  (-> Translator (List ls.Synthesis) (Meta $.Inst)))
+
+(type: #export Bundle
+  (Dict Text Proc))
+
+(syntax: (Vector [size s.nat] elemT)
+  (wrap (list (` [(~+ (list.repeat size elemT))]))))
+
+(type: #export Nullary (-> (Vector +0 $.Inst) $.Inst))
+(type: #export Unary   (-> (Vector +1 $.Inst) $.Inst))
+(type: #export Binary  (-> (Vector +2 $.Inst) $.Inst))
+(type: #export Trinary (-> (Vector +3 $.Inst) $.Inst))
+(type: #export Variadic (-> (List $.Inst) $.Inst))
+
+## [Utils]
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
+(def: $Object-Array $.Type ($t.array +1 $Object))
+(def: $Variant $.Type ($t.array +1 $Object))
+(def: $String $.Type ($t.class "java.lang.String" (list)))
+(def: $CharSequence $.Type ($t.class "java.lang.CharSequence" (list)))
+(def: $Function $.Type ($t.class hostL.function-class (list)))
+
+(def: #export (install name unnamed)
+  (-> Text (-> Text Proc)
+      (-> Bundle Bundle))
+  (dict.put name (unnamed name)))
+
+(def: #export (prefix prefix bundle)
+  (-> Text Bundle Bundle)
+  (|> bundle
+      dict.entries
+      (list/map (function [[key val]] [(format prefix " " key) val]))
+      (dict.from-list text.Hash<Text>)))
+
+(def: (wrong-arity proc expected actual)
+  (-> Text Nat Nat Text)
+  (format "Wrong number of arguments for " (%t proc) "\n"
+          "Expected: " (|> expected nat-to-int %i) "\n"
+          "  Actual: " (|> actual nat-to-int %i)))
+
+(syntax: (arity: [name s.local-symbol] [arity s.nat])
+  (with-gensyms [g!proc g!name g!translate g!inputs]
+    (do @
+      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+      (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc))
+                       (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst)
+                           (-> Text ..Proc))
+                       (function [(~ g!name)]
+                         (function [(~ g!translate) (~ g!inputs)]
+                           (case (~ g!inputs)
+                             (^ (list (~+ g!input+)))
+                             (do macro.Monad<Meta>
+                               [(~+ (|> g!input+
+                                        (list/map (function [g!input]
+                                                    (list g!input (` ((~ g!translate) (~ g!input))))))
+                                        list.concat))]
+                               ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
+
+                             (~' _)
+                             (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
+
+(arity: nullary +0)
+(arity: unary +1)
+(arity: binary +2)
+(arity: trinary +3)
+
+(def: #export (variadic proc)
+  (-> Variadic (-> Text Proc))
+  (function [proc-name]
+    (function [translate inputsS]
+      (do macro.Monad<Meta>
+        [inputsI (monad.map @ translate inputsS)]
+        (wrap (proc inputsI))))))
+
+## [Instructions]
+(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long)))
+(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I))
+
+(def: (array-writeI arrayI idxI elemI)
+  (-> $.Inst $.Inst $.Inst
+      $.Inst)
+  (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
+       $i.DUP
+       idxI jvm-intI
+       elemI
+       $i.AASTORE))
+
+(def: (predicateI tester)
+  (-> (-> $.Label $.Inst)
+      $.Inst)
+  (<| $i.with-label (function [@then])
+      $i.with-label (function [@end])
+      (|>> (tester @then)
+           ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+           ($i.GOTO @end)
+           ($i.label @then)
+           ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+           ($i.label @end)
+           )))
+
+(def: unitI $.Inst ($i.string hostL.unit))
+
+## [Procedures]
+## [[Lux]]
+(def: (lux//is [leftI rightI])
+  Binary
+  (|>> leftI
+       rightI
+       (predicateI $i.IF_ACMPEQ)))
+
+(def: (lux//if [testI thenI elseI])
+  Trinary
+  (caseT.translate-if testI thenI elseI))
+
+(def: (lux//try riskyI)
+  Unary
+  (|>> riskyI
+       ($i.CHECKCAST hostL.function-class)
+       ($i.INVOKESTATIC hostL.runtime-class "try"
+                        ($t.method (list $Function) (#.Some $Object-Array) (list))
+                        false)))
+
+(def: (lux//noop valueI)
+  Unary
+  valueI)
+
+(exception: #export Wrong-Syntax)
+(def: #export (wrong-syntax procedure args)
+  (-> Text (List ls.Synthesis) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code.tuple args))))
+
+(def: lux//loop
+  (-> Text Proc)
+  (function [proc-name]
+    (function [translate inputsS]
+      (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any))
+        (#e.Success [offset initsS+ bodyS])
+        (loopT.translate-loop translate offset initsS+ bodyS)
+
+        (#e.Error error)
+        (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
+      )))
+
+(def: lux//recur
+  (-> Text Proc)
+  (function [proc-name]
+    (function [translate inputsS]
+      (loopT.translate-recur translate inputsS))))
+
+## [[Bits]]
+(do-template [<name> <op>]
+  [(def: (<name> [inputI maskI])
+     Binary
+     (|>> inputI ($i.unwrap #$.Long)
+          maskI ($i.unwrap #$.Long)
+          <op> ($i.wrap #$.Long)))]
+
+  [bit//and $i.LAND]
+  [bit//or  $i.LOR]
+  [bit//xor $i.LXOR]
+  )
+
+(def: (bit//count inputI)
+  Unary
+  (|>> inputI ($i.unwrap #$.Long)
+       ($i.INVOKESTATIC "java.lang.Long" "bitCount" ($t.method (list $t.long) (#.Some $t.int) (list)) false)
+       lux-intI))
+
+(do-template [<name> <op>]
+  [(def: (<name> [inputI shiftI])
+     Binary
+     (|>> inputI ($i.unwrap #$.Long)
+          shiftI jvm-intI
+          <op>
+          ($i.wrap #$.Long)))]
+
+  [bit//shift-left           $i.LSHL]
+  [bit//shift-right          $i.LSHR]
+  [bit//unsigned-shift-right $i.LUSHR]
+  )
+
+## [[Arrays]]
+(def: (array//new lengthI)
+  Unary
+  (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object"))))
+
+(def: (array//get [arrayI idxI])
+  Binary
+  (<| $i.with-label (function [@is-null])
+      $i.with-label (function [@end])
+      (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
+           idxI jvm-intI
+           $i.AALOAD
+           $i.DUP
+           ($i.IFNULL @is-null)
+           runtimeT.someI
+           ($i.GOTO @end)
+           ($i.label @is-null)
+           $i.POP
+           runtimeT.noneI
+           ($i.label @end))))
+
+(def: (array//put [arrayI idxI elemI])
+  Trinary
+  (array-writeI arrayI idxI elemI))
+
+(def: (array//remove [arrayI idxI])
+  Binary
+  (array-writeI arrayI idxI $i.NULL))
+
+(def: (array//size arrayI)
+  Unary
+  (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array))
+       $i.ARRAYLENGTH
+       lux-intI))
+
+## [[Numbers]]
+(def: nat-method
+  $.Method
+  ($t.method (list $t.long $t.long) (#.Some $t.long) (list)))
+
+(def: deg-method $.Method nat-method)
+
+(def: compare-nat-method
+  $.Method
+  ($t.method (list $t.long $t.long) (#.Some $t.int) (list)))
+
+(do-template [<name> <const> <type>]
+  [(def: (<name> _)
+     Nullary
+     (|>> <const> ($i.wrap <type>)))]
+
+  [nat//min                ($i.long 0)                              #$.Long]
+  [nat//max                ($i.long -1)                             #$.Long]
+
+  [int//min                ($i.long Long::MIN_VALUE)                #$.Long]
+  [int//max                ($i.long Long::MAX_VALUE)                #$.Long]
+  
+  [frac//smallest          ($i.double Double::MIN_VALUE)            #$.Double]
+  [frac//min               ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double]
+  [frac//max               ($i.double Double::MAX_VALUE)            #$.Double]
+  [frac//not-a-number      ($i.double Double::NaN)                  #$.Double]
+  [frac//positive-infinity ($i.double Double::POSITIVE_INFINITY)    #$.Double]
+  [frac//negative-infinity ($i.double Double::NEGATIVE_INFINITY)    #$.Double]
+
+  [deg//min                ($i.long 0)                              #$.Long]
+  [deg//max                ($i.long -1)                             #$.Long]
+  )
+
+(do-template [<name> <type> <op>]
+  [(def: (<name> [subjectI paramI])
+     Binary
+     (|>> subjectI ($i.unwrap <type>)
+          paramI ($i.unwrap <type>)
+          <op>
+          ($i.wrap <type>)))]
+
+  [int//add        #$.Long   $i.LADD]
+  [int//sub        #$.Long   $i.LSUB]
+  [int//mul        #$.Long   $i.LMUL]
+  [int//div        #$.Long   $i.LDIV]
+  [int//rem        #$.Long   $i.LREM]
+  
+  [nat//add        #$.Long   $i.LADD]
+  [nat//sub        #$.Long   $i.LSUB]
+  [nat//mul        #$.Long   $i.LMUL]
+  [nat//div        #$.Long   ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)]
+  [nat//rem        #$.Long   ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)]
+
+  [frac//add       #$.Double $i.DADD]
+  [frac//sub       #$.Double $i.DSUB]
+  [frac//mul       #$.Double $i.DMUL]
+  [frac//div       #$.Double $i.DDIV]
+  [frac//rem       #$.Double $i.DREM]
+
+  [deg//add        #$.Long   $i.LADD]
+  [deg//sub        #$.Long   $i.LSUB]
+  [deg//mul        #$.Long   ($i.INVOKESTATIC hostL.runtime-class "mul_deg" deg-method false)]
+  [deg//div        #$.Long   ($i.INVOKESTATIC hostL.runtime-class "div_deg" deg-method false)]
+  [deg//rem        #$.Long   $i.LSUB]
+  [deg//scale      #$.Long   $i.LMUL]
+  [deg//reciprocal #$.Long   $i.LDIV]
+  )
+
+(do-template [<eq> <lt> <unwrap> <cmp>]
+  [(do-template [<name> <reference>]
+     [(def: (<name> [subjectI paramI])
+        Binary
+        (|>> subjectI <unwrap>
+             paramI <unwrap>
+             <cmp>
+             ($i.int <reference>)
+             (predicateI $i.IF_ICMPEQ)))]
+     [<eq>  0]
+     [<lt> -1])]
+
+  [nat//eq  nat//lt  ($i.unwrap #$.Long)   ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
+  [int//eq  int//lt  ($i.unwrap #$.Long)   $i.LCMP]
+  [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG]
+  [deg//eq  deg//lt  ($i.unwrap #$.Long)   ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
+  )
+
+(do-template [<name> <prepare> <transform>]
+  [(def: (<name> inputI)
+     Unary
+     (|>> inputI <prepare> <transform>))]
+
+  [nat//to-int id id]
+  [nat//char ($i.unwrap #$.Long)
+   ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
+  
+  [int//to-nat id id]
+  [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)]
+
+  [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)]
+  [frac//to-deg ($i.unwrap #$.Double)
+   (<| ($i.wrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "frac_to_deg"
+                                          ($t.method (list $t.double) (#.Some $t.long) (list)) false))]
+  [frac//encode ($i.unwrap #$.Double)
+   ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) false)]
+  [frac//decode ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) false)]
+
+  [deg//to-frac ($i.unwrap #$.Long)
+   (<| ($i.wrap #$.Double) ($i.INVOKESTATIC hostL.runtime-class "deg_to_frac"
+                                            ($t.method (list $t.long) (#.Some $t.double) (list)) false))]
+  )
+
+## [[Text]]
+(do-template [<name> <class> <method> <post> <outputT>]
+  [(def: (<name> inputI)
+     Unary
+     (|>> inputI
+          ($i.CHECKCAST "java.lang.String")
+          ($i.INVOKEVIRTUAL <class> <method> ($t.method (list) (#.Some <outputT>) (list)) false)
+          <post>))]
+
+  [text//size  "java.lang.String" "length"      lux-intI $t.int]
+  [text//hash  "java.lang.Object" "hashCode"    lux-intI $t.int]
+  [text//trim  "java.lang.String" "trim"        id       $String]
+  [text//upper "java.lang.String" "toUpperCase" id       $String]
+  [text//lower "java.lang.String" "toLowerCase" id       $String]
+  )
+
+(do-template [<name> <pre-subject> <pre-param> <op> <post>]
+  [(def: (<name> [subjectI paramI])
+     Binary
+     (|>> subjectI <pre-subject>
+          paramI <pre-param>
+          <op> <post>))]
+
+  [text//eq id id
+   ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) false)
+   ($i.wrap #$.Boolean)]
+  [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) false)
+   (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))]
+  [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false)
+   id]
+  [text//contains? ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKEVIRTUAL "java.lang.String" "contains" ($t.method (list $CharSequence) (#.Some $t.boolean) (list)) false)
+   ($i.wrap #$.Boolean)]
+  [text//char ($i.CHECKCAST "java.lang.String") jvm-intI
+   ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) false)
+   id]
+  )
+
+(do-template [<name> <pre-subject> <pre-param> <pre-extra> <op>]
+  [(def: (<name> [subjectI paramI extraI])
+     Trinary
+     (|>> subjectI <pre-subject>
+          paramI <pre-param>
+          extraI <pre-extra>
+          <op>))]
+
+  [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI
+   ($i.INVOKESTATIC hostL.runtime-class "text_clip"
+                    ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) false)]
+  [text//replace-once ($i.CHECKCAST "java.lang.String")
+   (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false)
+       ($i.CHECKCAST "java.lang.String"))
+   ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKEVIRTUAL "java.lang.String" "replaceFirst" ($t.method (list $String $String) (#.Some $String) (list)) false)]
+  [text//replace-all ($i.CHECKCAST "java.lang.String")
+   (<| ($i.INVOKESTATIC "java.util.regex.Pattern" "quote" ($t.method (list $String) (#.Some $String) (list)) false)
+       ($i.CHECKCAST "java.lang.String"))
+   ($i.CHECKCAST "java.lang.String")
+   ($i.INVOKEVIRTUAL "java.lang.String" "replaceAll" ($t.method (list $String $String) (#.Some $String) (list)) false)]
+  )
+
+(def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list)))
+(do-template [<name> <method>]
+  [(def: (<name> [textI partI startI])
+     Trinary
+     (<| $i.with-label (function [@not-found])
+         $i.with-label (function [@end])
+         (|>> textI ($i.CHECKCAST "java.lang.String")
+              partI ($i.CHECKCAST "java.lang.String")
+              startI jvm-intI
+              ($i.INVOKEVIRTUAL "java.lang.String" <method> index-method false)
+              $i.DUP
+              ($i.int -1)
+              ($i.IF_ICMPEQ @not-found)
+              lux-intI
+              runtimeT.someI
+              ($i.GOTO @end)
+              ($i.label @not-found)
+              $i.POP
+              runtimeT.noneI
+              ($i.label @end))))]
+
+  [text//index      "indexOf"]
+  [text//last-index "lastIndexOf"]
+  )
+
+## [[Math]]
+(def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list)))
+(def: math-binary-method ($t.method (list $t.double $t.double) (#.Some $t.double) (list)))
+
+(do-template [<name> <method>]
+  [(def: (<name> inputI)
+     Unary
+     (|>> inputI
+          ($i.unwrap #$.Double)
+          ($i.INVOKESTATIC "java.lang.Math" <method> math-unary-method false)
+          ($i.wrap #$.Double)))]
+
+  [math//cos "cos"]
+  [math//sin "sin"]
+  [math//tan "tan"]
+  [math//acos "acos"]
+  [math//asin "asin"]
+  [math//atan "atan"]
+  [math//cosh "cosh"]
+  [math//sinh "sinh"]
+  [math//tanh "tanh"]
+  [math//exp "exp"]
+  [math//log "log"]
+  [math//root2 "sqrt"]
+  [math//root3 "cbrt"]
+  [math//ceil "ceil"]
+  [math//floor "floor"]
+  )
+
+(do-template [<name> <method>]
+  [(def: (<name> [inputI paramI])
+     Binary
+     (|>> inputI ($i.unwrap #$.Double)
+          paramI ($i.unwrap #$.Double)
+          ($i.INVOKESTATIC "java.lang.Math" <method> math-binary-method false)
+          ($i.wrap #$.Double)))]
+
+  [math//atan2 "atan2"]
+  [math//pow "pow"]
+  )
+
+(def: (math//round inputI)
+  Unary
+  (|>> inputI
+       ($i.unwrap #$.Double)
+       ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) false)
+       $i.L2D
+       ($i.wrap #$.Double)))
+
+## [[IO]]
+(def: string-method $.Method ($t.method (list $String) #.None (list)))
+(def: (io//log messageI)
+  Unary
+  (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list)))
+       messageI
+       ($i.CHECKCAST "java.lang.String")
+       ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method false)
+       unitI))
+
+(def: (io//error messageI)
+  Unary
+  (|>> ($i.NEW "java.lang.Error")
+       $i.DUP
+       messageI
+       ($i.CHECKCAST "java.lang.String")
+       ($i.INVOKESPECIAL "java.lang.Error" "<init>" string-method false)
+       $i.ATHROW))
+
+(def: (io//exit codeI)
+  Unary
+  (|>> codeI jvm-intI
+       ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) false)
+       $i.NULL))
+
+(def: (io//current-time [])
+  Nullary
+  (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) false)
+       ($i.wrap #$.Long)))
+
+## [[Atoms]]
+(def: atom-class Text "java.util.concurrent.atomic.AtomicReference")
+(def: (atom//new initI)
+  Unary
+  (|>> ($i.NEW atom-class)
+       $i.DUP
+       initI
+       ($i.INVOKESPECIAL atom-class "<init>" ($t.method (list $Object) #.None (list)) false)))
+
+(def: (atom//read atomI)
+  Unary
+  (|>> atomI
+       ($i.CHECKCAST atom-class)
+       ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) false)))
+
+(def: (atom//compare-and-swap [atomI oldI newI])
+  Trinary
+  (|>> atomI
+       ($i.CHECKCAST atom-class)
+       oldI
+       newI
+       ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) false)
+       ($i.wrap #$.Boolean)))
+
+## [[Box]]
+(def: empty-boxI
+  $.Inst
+  (|>> ($i.int 1) ($i.ANEWARRAY ($t.binary-name "java.lang.Object"))))
+
+(def: check-boxI
+  $.Inst
+  ($i.CHECKCAST ($t.descriptor $Object-Array)))
+
+(def: (box//new initI)
+  Unary
+  (|>> empty-boxI
+       $i.DUP ($i.int 0) initI $i.AASTORE))
+
+(def: (box//read boxI)
+  Unary
+  (|>> boxI check-boxI
+       ($i.int 0) $i.AALOAD))
+
+(def: (box//write [valueI boxI])
+  Binary
+  (|>> boxI check-boxI
+       ($i.int 0) valueI $i.AASTORE
+       unitI))
+
+## [[Processes]]
+(def: (process//concurrency-level [])
+  Nullary
+  (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) false)
+       ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) false)
+       lux-intI))
+
+(def: (process//future procedureI)
+  Unary
+  (|>> procedureI ($i.CHECKCAST hostL.function-class)
+       ($i.INVOKESTATIC hostL.runtime-class "future"
+                        ($t.method (list $Function) (#.Some $Object) (list)) false)))
+
+(def: (process//schedule [millisecondsI procedureI])
+  Binary
+  (|>> millisecondsI ($i.unwrap #$.Long)
+       procedureI ($i.CHECKCAST hostL.function-class)
+       ($i.INVOKESTATIC hostL.runtime-class "schedule"
+                        ($t.method (list $t.long $Function) (#.Some $Object) (list)) false)))
+
+## [Bundles]
+(def: lux-procs
+  Bundle
+  (|> (dict.new text.Hash<Text>)
+      (install "noop" (unary lux//noop))
+      (install "is" (binary lux//is))
+      (install "try" (unary lux//try))
+      (install "if" (trinary lux//if))
+      (install "loop" lux//loop)
+      (install "recur" lux//recur)
+      ))
+
+(def: bit-procs
+  Bundle
+  (<| (prefix "bit")
+      (|> (dict.new text.Hash<Text>)
+          (install "count" (unary bit//count))
+          (install "and" (binary bit//and))
+          (install "or" (binary bit//or))
+          (install "xor" (binary bit//xor))
+          (install "shift-left" (binary bit//shift-left))
+          (install "unsigned-shift-right" (binary bit//unsigned-shift-right))
+          (install "shift-right" (binary bit//shift-right))
+          )))
+
+(def: nat-procs
+  Bundle
+  (<| (prefix "nat")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary nat//add))
+          (install "-" (binary nat//sub))
+          (install "*" (binary nat//mul))
+          (install "/" (binary nat//div))
+          (install "%" (binary nat//rem))
+          (install "=" (binary nat//eq))
+          (install "<" (binary nat//lt))
+          (install "min" (nullary nat//min))
+          (install "max" (nullary nat//max))
+          (install "to-int" (unary nat//to-int))
+          (install "char" (unary nat//char)))))
+
+(def: int-procs
+  Bundle
+  (<| (prefix "int")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary int//add))
+          (install "-" (binary int//sub))
+          (install "*" (binary int//mul))
+          (install "/" (binary int//div))
+          (install "%" (binary int//rem))
+          (install "=" (binary int//eq))
+          (install "<" (binary int//lt))
+          (install "min" (nullary int//min))
+          (install "max" (nullary int//max))
+          (install "to-nat" (unary int//to-nat))
+          (install "to-frac" (unary int//to-frac)))))
+
+(def: deg-procs
+  Bundle
+  (<| (prefix "deg")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary deg//add))
+          (install "-" (binary deg//sub))
+          (install "*" (binary deg//mul))
+          (install "/" (binary deg//div))
+          (install "%" (binary deg//rem))
+          (install "=" (binary deg//eq))
+          (install "<" (binary deg//lt))
+          (install "scale" (binary deg//scale))
+          (install "reciprocal" (binary deg//reciprocal))
+          (install "min" (nullary deg//min))
+          (install "max" (nullary deg//max))
+          (install "to-frac" (unary deg//to-frac)))))
+
+(def: frac-procs
+  Bundle
+  (<| (prefix "frac")
+      (|> (dict.new text.Hash<Text>)
+          (install "+" (binary frac//add))
+          (install "-" (binary frac//sub))
+          (install "*" (binary frac//mul))
+          (install "/" (binary frac//div))
+          (install "%" (binary frac//rem))
+          (install "=" (binary frac//eq))
+          (install "<" (binary frac//lt))
+          (install "smallest" (nullary frac//smallest))
+          (install "min" (nullary frac//min))
+          (install "max" (nullary frac//max))
+          (install "not-a-number" (nullary frac//not-a-number))
+          (install "positive-infinity" (nullary frac//positive-infinity))
+          (install "negative-infinity" (nullary frac//negative-infinity))
+          (install "to-deg" (unary frac//to-deg))
+          (install "to-int" (unary frac//to-int))
+          (install "encode" (unary frac//encode))
+          (install "decode" (unary frac//decode)))))
+
+(def: text-procs
+  Bundle
+  (<| (prefix "text")
+      (|> (dict.new text.Hash<Text>)
+          (install "=" (binary text//eq))
+          (install "<" (binary text//lt))
+          (install "concat" (binary text//concat))
+          (install "index" (trinary text//index))
+          (install "size" (unary text//size))
+          (install "hash" (unary text//hash))
+          (install "replace-once" (trinary text//replace-once))
+          (install "replace-all" (trinary text//replace-all))
+          (install "char" (binary text//char))
+          (install "clip" (trinary text//clip))
+          (install "upper" (unary text//upper))
+          (install "lower" (unary text//lower))
+          )))
+
+(def: array-procs
+  Bundle
+  (<| (prefix "array")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" (unary array//new))
+          (install "get" (binary array//get))
+          (install "put" (trinary array//put))
+          (install "remove" (binary array//remove))
+          (install "size" (unary array//size))
+          )))
+
+(def: math-procs
+  Bundle
+  (<| (prefix "math")
+      (|> (dict.new text.Hash<Text>)
+          (install "cos" (unary math//cos))
+          (install "sin" (unary math//sin))
+          (install "tan" (unary math//tan))
+          (install "acos" (unary math//acos))
+          (install "asin" (unary math//asin))
+          (install "atan" (unary math//atan))
+          (install "cosh" (unary math//cosh))
+          (install "sinh" (unary math//sinh))
+          (install "tanh" (unary math//tanh))
+          (install "exp" (unary math//exp))
+          (install "log" (unary math//log))
+          (install "root2" (unary math//root2))
+          (install "root3" (unary math//root3))
+          (install "ceil" (unary math//ceil))
+          (install "floor" (unary math//floor))
+          (install "round" (unary math//round))
+          (install "atan2" (binary math//atan2))
+          (install "pow" (binary math//pow))
+          )))
+
+(def: io-procs
+  Bundle
+  (<| (prefix "io")
+      (|> (dict.new text.Hash<Text>)
+          (install "log" (unary io//log))
+          (install "error" (unary io//error))
+          (install "exit" (unary io//exit))
+          (install "current-time" (nullary io//current-time)))))
+
+(def: atom-procs
+  Bundle
+  (<| (prefix "atom")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" (unary atom//new))
+          (install "read" (unary atom//read))
+          (install "compare-and-swap" (trinary atom//compare-and-swap)))))
+
+(def: box-procs
+  Bundle
+  (<| (prefix "box")
+      (|> (dict.new text.Hash<Text>)
+          (install "new" (unary box//new))
+          (install "read" (unary box//read))
+          (install "write" (binary box//write)))))
+
+(def: process-procs
+  Bundle
+  (<| (prefix "process")
+      (|> (dict.new text.Hash<Text>)
+          (install "concurrency-level" (nullary process//concurrency-level))
+          (install "future" (unary process//future))
+          (install "schedule" (binary process//schedule))
+          )))
+
+(def: #export procedures
+  Bundle
+  (<| (prefix "lux")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge lux-procs)
+          (dict.merge bit-procs)
+          (dict.merge nat-procs)
+          (dict.merge int-procs)
+          (dict.merge deg-procs)
+          (dict.merge frac-procs)
+          (dict.merge text-procs)
+          (dict.merge array-procs)
+          (dict.merge math-procs)
+          (dict.merge io-procs)
+          (dict.merge atom-procs)
+          (dict.merge box-procs)
+          (dict.merge process-procs)
+          )))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
new file mode 100644
index 000000000..30d17cac3
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux
@@ -0,0 +1,761 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["p" parser "parser/" Monad<Parser>]
+                ["ex" exception #+ exception:])
+       (data [product]
+             ["e" error]
+             [text "text/" Eq<Text>]
+             (text format
+                   ["l" lexer])
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [macro "macro/" Monad<Meta>]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" lang]
+        (lang [".L" host]
+              (host ["$" jvm]
+                    (jvm ["$t" type]
+                         ["$d" def]
+                         ["$i" inst]))
+              ["la" analysis]
+              (extension (analysis ["&." host]))
+              ["ls" synthesis]))
+  (// ["@" common]))
+
+(exception: #export Invalid-Syntax-For-JVM-Type)
+(exception: #export Invalid-Syntax-For-Argument-Generation)
+
+(do-template [<name> <inst>]
+  [(def: <name>
+     $.Inst
+     <inst>)]
+
+  [L2S (|>> $i.L2I $i.I2S)]
+  [L2B (|>> $i.L2I $i.I2B)]
+  [L2C (|>> $i.L2I $i.I2C)]
+  )
+
+(do-template [<name> <unwrap> <conversion> <wrap>]
+  [(def: (<name> inputI)
+     @.Unary
+     (if (is $i.NOP <conversion>)
+       (|>> inputI
+            ($i.unwrap <unwrap>)
+            ($i.wrap <wrap>))
+       (|>> inputI
+            ($i.unwrap <unwrap>)
+            <conversion>
+            ($i.wrap <wrap>))))]
+  
+  [convert//double-to-float #$.Double $i.D2F #$.Float]
+  [convert//double-to-int #$.Double $i.D2I #$.Int]
+  [convert//double-to-long #$.Double $i.D2L #$.Long]
+  [convert//float-to-double #$.Float $i.F2D #$.Double]
+  [convert//float-to-int #$.Float $i.F2I #$.Int]
+  [convert//float-to-long #$.Float $i.F2L #$.Long]
+  [convert//int-to-byte #$.Int $i.I2B #$.Byte]
+  [convert//int-to-char #$.Int $i.I2C #$.Char]
+  [convert//int-to-double #$.Int $i.I2D #$.Double]
+  [convert//int-to-float #$.Int $i.I2F #$.Float]
+  [convert//int-to-long #$.Int $i.I2L #$.Long]
+  [convert//int-to-short #$.Int $i.I2S #$.Short]
+  [convert//long-to-double #$.Long $i.L2D #$.Double]
+  [convert//long-to-float #$.Long $i.L2F #$.Float]
+  [convert//long-to-int #$.Long $i.L2I #$.Int]
+  [convert//long-to-short #$.Long L2S #$.Short]
+  [convert//long-to-byte #$.Long L2B #$.Byte]
+  [convert//long-to-char #$.Long L2C #$.Char]
+  [convert//char-to-byte #$.Char $i.I2B #$.Byte]
+  [convert//char-to-short #$.Char $i.I2S #$.Short]
+  [convert//char-to-int #$.Char $i.NOP #$.Int]
+  [convert//char-to-long #$.Char $i.I2L #$.Long]
+  [convert//byte-to-long #$.Byte $i.I2L #$.Long]
+  [convert//short-to-long #$.Short $i.I2L #$.Long]
+  )
+
+(def: conversion-procs
+  @.Bundle
+  (<| (@.prefix "convert")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "double-to-float" (@.unary convert//double-to-float))
+          (@.install "double-to-int" (@.unary convert//double-to-int))
+          (@.install "double-to-long" (@.unary convert//double-to-long))
+          (@.install "float-to-double" (@.unary convert//float-to-double))
+          (@.install "float-to-int" (@.unary convert//float-to-int))
+          (@.install "float-to-long" (@.unary convert//float-to-long))
+          (@.install "int-to-byte" (@.unary convert//int-to-byte))
+          (@.install "int-to-char" (@.unary convert//int-to-char))
+          (@.install "int-to-double" (@.unary convert//int-to-double))
+          (@.install "int-to-float" (@.unary convert//int-to-float))
+          (@.install "int-to-long" (@.unary convert//int-to-long))
+          (@.install "int-to-short" (@.unary convert//int-to-short))
+          (@.install "long-to-double" (@.unary convert//long-to-double))
+          (@.install "long-to-float" (@.unary convert//long-to-float))
+          (@.install "long-to-int" (@.unary convert//long-to-int))
+          (@.install "long-to-short" (@.unary convert//long-to-short))
+          (@.install "long-to-byte" (@.unary convert//long-to-byte))
+          (@.install "long-to-char" (@.unary convert//long-to-char))
+          (@.install "char-to-byte" (@.unary convert//char-to-byte))
+          (@.install "char-to-short" (@.unary convert//char-to-short))
+          (@.install "char-to-int" (@.unary convert//char-to-int))
+          (@.install "char-to-long" (@.unary convert//char-to-long))
+          (@.install "byte-to-long" (@.unary convert//byte-to-long))
+          (@.install "short-to-long" (@.unary convert//short-to-long))
+          )))
+
+(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
+  [(def: (<name> [xI yI])
+     @.Binary
+     (|>> xI ($i.unwrap <unwrapX>)
+          yI ($i.unwrap <unwrapY>)
+          <op> ($i.wrap <wrap>)))]
+
+  [int//+ $i.IADD #$.Int #$.Int #$.Int]
+  [int//- $i.ISUB #$.Int #$.Int #$.Int]
+  [int//* $i.IMUL #$.Int #$.Int #$.Int]
+  [int/// $i.IDIV #$.Int #$.Int #$.Int]
+  [int//% $i.IREM #$.Int #$.Int #$.Int]
+  [int//and $i.IAND #$.Int #$.Int #$.Int]
+  [int//or $i.IOR #$.Int #$.Int #$.Int]
+  [int//xor $i.IXOR #$.Int #$.Int #$.Int]
+  [int//shl $i.ISHL #$.Int #$.Int #$.Int]
+  [int//shr $i.ISHR #$.Int #$.Int #$.Int]
+  [int//ushr $i.IUSHR #$.Int #$.Int #$.Int]
+  
+  [long//+ $i.LADD #$.Long #$.Long #$.Long]
+  [long//- $i.LSUB #$.Long #$.Long #$.Long]
+  [long//* $i.LMUL #$.Long #$.Long #$.Long]
+  [long/// $i.LDIV #$.Long #$.Long #$.Long]
+  [long//% $i.LREM #$.Long #$.Long #$.Long]
+  [long//and $i.LAND #$.Long #$.Long #$.Long]
+  [long//or $i.LOR #$.Long #$.Long #$.Long]
+  [long//xor $i.LXOR #$.Long #$.Long #$.Long]
+  [long//shl $i.LSHL #$.Long #$.Int #$.Long]
+  [long//shr $i.LSHR #$.Long #$.Int #$.Long]
+  [long//ushr $i.LUSHR #$.Long #$.Int #$.Long]
+
+  [float//+ $i.FADD #$.Float #$.Float #$.Float]
+  [float//- $i.FSUB #$.Float #$.Float #$.Float]
+  [float//* $i.FMUL #$.Float #$.Float #$.Float]
+  [float/// $i.FDIV #$.Float #$.Float #$.Float]
+  [float//% $i.FREM #$.Float #$.Float #$.Float]
+  
+  [double//+ $i.DADD #$.Double #$.Double #$.Double]
+  [double//- $i.DSUB #$.Double #$.Double #$.Double]
+  [double//* $i.DMUL #$.Double #$.Double #$.Double]
+  [double/// $i.DDIV #$.Double #$.Double #$.Double]
+  [double//% $i.DREM #$.Double #$.Double #$.Double]
+  )
+
+(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
+  [(def: (<name> [xI yI])
+     @.Binary
+     (<| $i.with-label (function [@then])
+         $i.with-label (function [@end])
+         (|>> xI ($i.unwrap <unwrapX>)
+              yI ($i.unwrap <unwrapY>)
+              (<op> @then)
+              ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+              ($i.GOTO @end)
+              ($i.label @then)
+              ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+              ($i.label @end))))]
+
+  [int//= $i.IF_ICMPEQ #$.Int #$.Int #$.Boolean]
+  [int//< $i.IF_ICMPLT #$.Int #$.Int #$.Boolean]
+
+  [char//= $i.IF_ICMPEQ #$.Char #$.Char #$.Boolean]
+  [char//< $i.IF_ICMPLT #$.Char #$.Char #$.Boolean]
+  )
+
+(do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>]
+  [(def: (<name> [xI yI])
+     @.Binary
+     (<| $i.with-label (function [@then])
+         $i.with-label (function [@end])
+         (|>> xI ($i.unwrap <unwrapX>)
+              yI ($i.unwrap <unwrapY>)
+              <op>
+              ($i.int <reference>)
+              ($i.IF_ICMPEQ @then)
+              ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+              ($i.GOTO @end)
+              ($i.label @then)
+              ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+              ($i.label @end))))]
+
+  [long//= $i.LCMP  0 #$.Long #$.Long #$.Boolean]
+  [long//< $i.LCMP -1 #$.Long #$.Long #$.Boolean]
+  
+  [float//= $i.FCMPG  0 #$.Float #$.Float #$.Boolean]
+  [float//< $i.FCMPG -1 #$.Float #$.Float #$.Boolean]
+
+  [double//= $i.DCMPG  0 #$.Double #$.Double #$.Boolean]
+  [double//< $i.DCMPG -1 #$.Double #$.Double #$.Boolean]
+  )
+
+(def: int-procs
+  @.Bundle
+  (<| (@.prefix "int")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "+" (@.binary int//+))
+          (@.install "-" (@.binary int//-))
+          (@.install "*" (@.binary int//*))
+          (@.install "/" (@.binary int///))
+          (@.install "%" (@.binary int//%))
+          (@.install "=" (@.binary int//=))
+          (@.install "<" (@.binary int//<))
+          (@.install "and" (@.binary int//and))
+          (@.install "or" (@.binary int//or))
+          (@.install "xor" (@.binary int//xor))
+          (@.install "shl" (@.binary int//shl))
+          (@.install "shr" (@.binary int//shr))
+          (@.install "ushr" (@.binary int//ushr))
+          )))
+
+(def: long-procs
+  @.Bundle
+  (<| (@.prefix "long")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "+" (@.binary long//+))
+          (@.install "-" (@.binary long//-))
+          (@.install "*" (@.binary long//*))
+          (@.install "/" (@.binary long///))
+          (@.install "%" (@.binary long//%))
+          (@.install "=" (@.binary long//=))
+          (@.install "<" (@.binary long//<))
+          (@.install "and" (@.binary long//and))
+          (@.install "or" (@.binary long//or))
+          (@.install "xor" (@.binary long//xor))
+          (@.install "shl" (@.binary long//shl))
+          (@.install "shr" (@.binary long//shr))
+          (@.install "ushr" (@.binary long//ushr))
+          )))
+
+(def: float-procs
+  @.Bundle
+  (<| (@.prefix "float")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "+" (@.binary float//+))
+          (@.install "-" (@.binary float//-))
+          (@.install "*" (@.binary float//*))
+          (@.install "/" (@.binary float///))
+          (@.install "%" (@.binary float//%))
+          (@.install "=" (@.binary float//=))
+          (@.install "<" (@.binary float//<))
+          )))
+
+(def: double-procs
+  @.Bundle
+  (<| (@.prefix "double")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "+" (@.binary double//+))
+          (@.install "-" (@.binary double//-))
+          (@.install "*" (@.binary double//*))
+          (@.install "/" (@.binary double///))
+          (@.install "%" (@.binary double//%))
+          (@.install "=" (@.binary double//=))
+          (@.install "<" (@.binary double//<))
+          )))
+
+(def: char-procs
+  @.Bundle
+  (<| (@.prefix "char")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "=" (@.binary char//=))
+          (@.install "<" (@.binary char//<))
+          )))
+
+(def: (array//length arrayI)
+  @.Unary
+  (|>> arrayI
+       $i.ARRAYLENGTH
+       $i.I2L
+       ($i.wrap #$.Long)))
+
+(def: (array//new proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Nat level)] [_ (#.Text class)] lengthS))
+    (do macro.Monad<Meta>
+      [lengthI (translate lengthS)
+       #let [arrayJT ($t.array level (case class
+                                       "boolean" $t.boolean
+                                       "byte" $t.byte
+                                       "short" $t.short
+                                       "int" $t.int
+                                       "long" $t.long
+                                       "float" $t.float
+                                       "double" $t.double
+                                       "char" $t.char
+                                       _ ($t.class class (list))))]]
+      (wrap (|>> lengthI
+                 ($i.unwrap #$.Long)
+                 $i.L2I
+                 ($i.array arrayJT))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (array//read proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] idxS arrayS))
+    (do macro.Monad<Meta>
+      [arrayI (translate arrayS)
+       idxI (translate idxS)
+       #let [loadI (case class
+                     "boolean" (|>> $i.BALOAD ($i.wrap #$.Boolean))
+                     "byte" (|>> $i.BALOAD ($i.wrap #$.Byte))
+                     "short" (|>> $i.SALOAD ($i.wrap #$.Short))
+                     "int" (|>> $i.IALOAD ($i.wrap #$.Int))
+                     "long" (|>> $i.LALOAD ($i.wrap #$.Long))
+                     "float" (|>> $i.FALOAD ($i.wrap #$.Float))
+                     "double" (|>> $i.DALOAD ($i.wrap #$.Double))
+                     "char" (|>> $i.CALOAD ($i.wrap #$.Char))
+                     _ $i.AALOAD)]]
+      (wrap (|>> arrayI
+                 idxI
+                 ($i.unwrap #$.Long)
+                 $i.L2I
+                 loadI)))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (array//write proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] idxS valueS arrayS))
+    (do macro.Monad<Meta>
+      [arrayI (translate arrayS)
+       idxI (translate idxS)
+       valueI (translate valueS)
+       #let [storeI (case class
+                      "boolean" (|>> ($i.unwrap #$.Boolean) $i.BASTORE)
+                      "byte" (|>> ($i.unwrap #$.Byte) $i.BASTORE)
+                      "short" (|>> ($i.unwrap #$.Short) $i.SASTORE)
+                      "int" (|>> ($i.unwrap #$.Int) $i.IASTORE)
+                      "long" (|>> ($i.unwrap #$.Long) $i.LASTORE)
+                      "float" (|>> ($i.unwrap #$.Float) $i.FASTORE)
+                      "double" (|>> ($i.unwrap #$.Double) $i.DASTORE)
+                      "char" (|>> ($i.unwrap #$.Char) $i.CASTORE)
+                      _ $i.AASTORE)]]
+      (wrap (|>> arrayI
+                 $i.DUP
+                 idxI
+                 ($i.unwrap #$.Long)
+                 $i.L2I
+                 valueI
+                 storeI)))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: array-procs
+  @.Bundle
+  (<| (@.prefix "array")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "length" (@.unary array//length))
+          (@.install "new" array//new)
+          (@.install "read" array//read)
+          (@.install "write" array//write)
+          )))
+
+(def: (object//null _)
+  @.Nullary
+  $i.NULL)
+
+(def: (object//null? objectI)
+  @.Unary
+  (<| $i.with-label (function [@then])
+      $i.with-label (function [@end])
+      (|>> objectI
+           ($i.IFNULL @then)
+           ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list)))
+           ($i.GOTO @end)
+           ($i.label @then)
+           ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list)))
+           ($i.label @end))))
+
+(def: (object//synchronized [monitorI exprI])
+  @.Binary
+  (|>> monitorI
+       $i.DUP
+       $i.MONITORENTER
+       exprI
+       $i.SWAP
+       $i.MONITOREXIT))
+
+(def: (object//throw exceptionI)
+  @.Unary
+  (|>> exceptionI
+       $i.ATHROW))
+
+(def: (object//class proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)]))
+    (do macro.Monad<Meta>
+      []
+      (wrap (|>> ($i.string class)
+                 ($i.INVOKESTATIC "java.lang.Class" "forName"
+                                  ($t.method (list ($t.class "java.lang.String" (list)))
+                                             (#.Some ($t.class "java.lang.Class" (list)))
+                                             (list))
+                                  false))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (object//instance? proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] objectS))
+    (do macro.Monad<Meta>
+      [objectI (translate objectS)]
+      (wrap (|>> objectI
+                 ($i.INSTANCEOF class)
+                 ($i.wrap #$.Boolean))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: object-procs
+  @.Bundle
+  (<| (@.prefix "object")
+      (|> (dict.new text.Hash<Text>)
+          (@.install "null" (@.nullary object//null))
+          (@.install "null?" (@.unary object//null?))
+          (@.install "synchronized" (@.binary object//synchronized))
+          (@.install "throw" (@.unary object//throw))
+          (@.install "class" object//class)
+          (@.install "instance?" object//instance?)
+          )))
+
+(def: primitives
+  (Dict Text $.Primitive)
+  (|> (list ["boolean" #$.Boolean]
+            ["byte" #$.Byte]
+            ["short" #$.Short]
+            ["int" #$.Int]
+            ["long" #$.Long]
+            ["float" #$.Float]
+            ["double" #$.Double]
+            ["char" #$.Char])
+      (dict.from-list text.Hash<Text>)))
+
+(def: (static//get proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)]))
+    (do macro.Monad<Meta>
+      []
+      (case (dict.get unboxed primitives)
+        (#.Some primitive)
+        (let [primitive (case unboxed
+                          "boolean" #$.Boolean
+                          "byte" #$.Byte
+                          "short" #$.Short
+                          "int" #$.Int
+                          "long" #$.Long
+                          "float" #$.Float
+                          "double" #$.Double
+                          "char" #$.Char
+                          _ (undefined))]
+          (wrap (|>> ($i.GETSTATIC class field (#$.Primitive primitive))
+                     ($i.wrap primitive))))
+        
+        #.None
+        (wrap ($i.GETSTATIC class field ($t.class unboxed (list))))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (static//put proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS))
+    (do macro.Monad<Meta>
+      [valueI (translate valueS)]
+      (case (dict.get unboxed primitives)
+        (#.Some primitive)
+        (let [primitive (case unboxed
+                          "boolean" #$.Boolean
+                          "byte" #$.Byte
+                          "short" #$.Short
+                          "int" #$.Int
+                          "long" #$.Long
+                          "float" #$.Float
+                          "double" #$.Double
+                          "char" #$.Char
+                          _ (undefined))]
+          (wrap (|>> valueI
+                     ($i.unwrap primitive)
+                     ($i.PUTSTATIC class field (#$.Primitive primitive))
+                     ($i.string hostL.unit))))
+        
+        #.None
+        (wrap (|>> valueI
+                   ($i.CHECKCAST class)
+                   ($i.PUTSTATIC class field ($t.class class (list)))
+                   ($i.string hostL.unit)))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (virtual//get proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] objectS))
+    (do macro.Monad<Meta>
+      [objectI (translate objectS)]
+      (case (dict.get unboxed primitives)
+        (#.Some primitive)
+        (let [primitive (case unboxed
+                          "boolean" #$.Boolean
+                          "byte" #$.Byte
+                          "short" #$.Short
+                          "int" #$.Int
+                          "long" #$.Long
+                          "float" #$.Float
+                          "double" #$.Double
+                          "char" #$.Char
+                          _ (undefined))]
+          (wrap (|>> objectI
+                     ($i.CHECKCAST class)
+                     ($i.GETFIELD class field (#$.Primitive primitive))
+                     ($i.wrap primitive))))
+        
+        #.None
+        (wrap (|>> objectI
+                   ($i.CHECKCAST class)
+                   ($i.GETFIELD class field ($t.class unboxed (list)))))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: (virtual//put proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list [_ (#.Text class)] [_ (#.Text field)] [_ (#.Text unboxed)] valueS objectS))
+    (do macro.Monad<Meta>
+      [valueI (translate valueS)
+       objectI (translate objectS)]
+      (case (dict.get unboxed primitives)
+        (#.Some primitive)
+        (let [primitive (case unboxed
+                          "boolean" #$.Boolean
+                          "byte" #$.Byte
+                          "short" #$.Short
+                          "int" #$.Int
+                          "long" #$.Long
+                          "float" #$.Float
+                          "double" #$.Double
+                          "char" #$.Char
+                          _ (undefined))]
+          (wrap (|>> objectI
+                     ($i.CHECKCAST class)
+                     $i.DUP
+                     valueI
+                     ($i.unwrap primitive)
+                     ($i.PUTFIELD class field (#$.Primitive primitive)))))
+        
+        #.None
+        (wrap (|>> objectI
+                   ($i.CHECKCAST class)
+                   $i.DUP
+                   valueI
+                   ($i.CHECKCAST unboxed)
+                   ($i.PUTFIELD class field ($t.class unboxed (list)))))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: base-type
+  (l.Lexer $.Type)
+  ($_ p.either
+      (p.after (l.this "boolean") (parser/wrap $t.boolean))
+      (p.after (l.this "byte") (parser/wrap $t.byte))
+      (p.after (l.this "short") (parser/wrap $t.short))
+      (p.after (l.this "int") (parser/wrap $t.int))
+      (p.after (l.this "long") (parser/wrap $t.long))
+      (p.after (l.this "float") (parser/wrap $t.float))
+      (p.after (l.this "double") (parser/wrap $t.double))
+      (p.after (l.this "char") (parser/wrap $t.char))
+      (parser/map (function [name]
+                    ($t.class name (list)))
+                  (l.many (l.none-of "[")))
+      ))
+
+(def: java-type
+  (l.Lexer $.Type)
+  (do p.Monad<Parser>
+    [raw base-type
+     nesting (p.some (l.this "[]"))]
+    (wrap ($t.array (list.size nesting) raw))))
+
+(def: (translate-type argD)
+  (-> Text (Meta $.Type))
+  (case (l.run argD java-type)
+    (#e.Error error)
+    (&.throw Invalid-Syntax-For-JVM-Type argD)
+
+    (#e.Success type)
+    (macro/wrap type)))
+
+(def: (prepare-input inputT inputI)
+  (-> $.Type $.Inst $.Inst)
+  (case inputT
+    (#$.Primitive primitive)
+    (|>> inputI ($i.unwrap primitive))
+
+    (#$.Generic generic)
+    (case generic
+      (^or (#$.Var _) (#$.Wildcard _))
+      (|>> inputI ($i.CHECKCAST "java.lang.Object"))
+      
+      (#$.Class class-name _)
+      (|>> inputI ($i.CHECKCAST class-name)))
+
+    _
+    (|>> inputI ($i.CHECKCAST ($t.descriptor inputT)))))
+
+(def: (translate-args translate argsS)
+  (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis)
+      (Meta (List [$.Type $.Inst])))
+  (case argsS
+    #.Nil
+    (macro/wrap #.Nil)
+
+    (^ (list& [_ (#.Tuple (list [_ (#.Text argD)] argS))] tail))
+    (do macro.Monad<Meta>
+      [argT (translate-type argD)
+       argI (:: @ map (prepare-input argT) (translate argS))
+       =tail (translate-args translate tail)]
+      (wrap (list& [argT argI] =tail)))
+
+    _
+    (&.throw Invalid-Syntax-For-Argument-Generation "")))
+
+(def: (method-return-type description)
+  (-> Text (Meta (Maybe $.Type)))
+  (case description
+    "void"
+    (macro/wrap #.None)
+
+    _
+    (macro/map (|>> #.Some) (translate-type description))))
+
+(def: (prepare-return returnT returnI)
+  (-> (Maybe $.Type) $.Inst $.Inst)
+  (case returnT
+    #.None
+    (|>> returnI
+         ($i.string hostL.unit))
+
+    (#.Some type)
+    (case type
+      (#$.Primitive primitive)
+      (|>> returnI ($i.wrap primitive))
+
+      _
+      returnI)))
+
+(def: (invoke//static proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+              [_ (#.Text unboxed)] argsS))
+    (do macro.Monad<Meta>
+      [argsTI (translate-args translate argsS)
+       returnT (method-return-type unboxed)
+       #let [callI (|>> ($i.fuse (list/map product.right argsTI))
+                        ($i.INVOKESTATIC class method
+                                         ($t.method (list/map product.left argsTI) returnT (list))
+                                         false))]]
+      (wrap (prepare-return returnT callI)))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(do-template [<name> <invoke> <interface?>]
+  [(def: (<name> proc translate inputs)
+     (-> Text @.Proc)
+     (case inputs
+       (^ (list& [_ (#.Text class)] [_ (#.Text method)]
+                 [_ (#.Text unboxed)] objectS argsS))
+       (do macro.Monad<Meta>
+         [objectI (translate objectS)
+          argsTI (translate-args translate argsS)
+          returnT (method-return-type unboxed)
+          #let [callI (|>> objectI
+                           ($i.CHECKCAST class)
+                           ($i.fuse (list/map product.right argsTI))
+                           (<invoke> class method
+                                     ($t.method (list/map product.left argsTI) returnT (list))
+                                     <interface?>))]]
+         (wrap (prepare-return returnT callI)))
+
+       _
+       (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))]
+
+  [invoke//virtual $i.INVOKEVIRTUAL false]
+  [invoke//special $i.INVOKESPECIAL false]
+  [invoke//interface $i.INVOKEINTERFACE true]
+  )
+
+(def: (invoke//constructor proc translate inputs)
+  (-> Text @.Proc)
+  (case inputs
+    (^ (list& [_ (#.Text class)] argsS))
+    (do macro.Monad<Meta>
+      [argsTI (translate-args translate argsS)]
+      (wrap (|>> ($i.NEW class)
+                 $i.DUP
+                 ($i.fuse (list/map product.right argsTI))
+                 ($i.INVOKESPECIAL class "<init>"
+                                   ($t.method (list/map product.left argsTI) #.None (list))
+                                   false))))
+
+    _
+    (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+(def: member-procs
+  @.Bundle
+  (<| (@.prefix "member")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge (<| (@.prefix "static")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "get" static//get)
+                              (@.install "put" static//put))))
+          (dict.merge (<| (@.prefix "virtual")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "get" virtual//get)
+                              (@.install "put" virtual//put))))
+          (dict.merge (<| (@.prefix "invoke")
+                          (|> (dict.new text.Hash<Text>)
+                              (@.install "static" invoke//static)
+                              (@.install "virtual" invoke//virtual)
+                              (@.install "special" invoke//special)
+                              (@.install "interface" invoke//interface)
+                              (@.install "constructor" invoke//constructor))))
+          )))
+
+(def: #export procedures
+  @.Bundle
+  (<| (@.prefix "jvm")
+      (|> (dict.new text.Hash<Text>)
+          (dict.merge conversion-procs)
+          (dict.merge int-procs)
+          (dict.merge long-procs)
+          (dict.merge float-procs)
+          (dict.merge double-procs)
+          (dict.merge char-procs)
+          (dict.merge array-procs)
+          (dict.merge object-procs)
+          (dict.merge member-procs)
+          )))