- Re-organized code-generation, and re-named it "translation".

author: Eduardo Julian 2017-11-01 00:51:45 -0400
committer: Eduardo Julian 2017-11-01 00:51:45 -0400
commit: 012f6bd41e527479dddbccbdab10daa78fd9a0fd (patch)
tree: 621f344a09acd52736f343d94582b3f1a2f0c5f9 /new-luxc/source/luxc/lang
parent: 71d7a4c7206155e09f3e1e1d8699561ea6967382 (diff)
15 files changed, 3336 insertions, 4 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index e3a623089..de0e49dbc 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -11,9 +11,9 @@
        [host])
   (luxc ["&" base]
         [";L" host]
-        (lang ["la" analysis])
-        ["&;" module]
-        (generator [";G" common]))
+        (lang ["la" analysis]
+              (translation [";T" common]))
+        ["&;" module])
   (.. [";A" common]
       [";A" function]
       [";A" primitive]
@@ -37,7 +37,7 @@
                    (def: (call-macro macro inputs)
                      (-> Macro (List Code) (Meta (List Code)))
                      (do meta;Monad<Meta>
-                       [class (commonG;load-class hostL;function-class)]
+                       [class (commonT;load-class hostL;function-class)]
                        (function [compiler]
                          (do e;Monad<Error>
                            [apply-method (Class.getMethod ["apply" _apply-args] class)
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
new file mode 100644
index 000000000..4fcc3ccb2
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -0,0 +1,179 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (concurrency ["T" task])
+       (data ["e" error]
+             [text "text/" Hash<Text>]
+             text/format
+             (coll [dict]))
+       [meta]
+       [host]
+       [io]
+       (world [file #+ File]))
+  (luxc ["&" base]
+        [";L" host]
+        ["&;" io]
+        ["&;" module]
+        ["&;" eval]
+        (lang ["&;" syntax]
+              (analysis [";A" expression]
+                        [";A" common])
+              (synthesis [";S" expression])
+              (translation [";T" runtime]
+                           [";T" statement]
+                           [";T" common]
+                           [";T" expression]
+                           [";T" eval]))
+        ))
+
+(def: analyse
+  (&;Analyser)
+  (expressionA;analyser &eval;eval))
+
+(def: (generate code)
+  (-> Code (Meta Unit))
+  (case code
+    (^ [_ (#;Form (list [_ (#;Text "lux def")]
+                        [_ (#;Symbol ["" def-name])]
+                        valueC
+                        metaC))])
+    (do meta;Monad<Meta>
+      [[_ metaA] (&;with-scope
+                   (&;with-expected-type Code
+                     (analyse metaC)))
+       metaI (expressionT;generate (expressionS;synthesize metaA))
+       metaV (evalT;eval metaI)
+       [_ valueT valueA] (&;with-scope
+                           (if (meta;type? (:! Code metaV))
+                             (&;with-expected-type Type
+                               (do @
+                                 [valueA (analyse valueC)]
+                                 (wrap [Type valueA])))
+                             (commonA;with-unknown-type
+                               (analyse valueC))))
+       valueI (expressionT;generate (expressionS;synthesize valueA))
+       _ (&;with-scope
+           (statementT;generate-def def-name valueT valueI metaI (:! Code metaV)))]
+      (wrap []))
+
+    (^ [_ (#;Form (list [_ (#;Text "lux program")]
+                        [_ (#;Symbol ["" program-args])]
+                        programC))])
+    (do meta;Monad<Meta>
+      [[_ programA] (&;with-scope
+                      (&;with-expected-type (type (io;IO Unit))
+                        (analyse programC)))
+       programI (expressionT;generate (expressionS;synthesize programA))]
+      (statementT;generate-program program-args programI))
+
+    _
+    (&;fail (format "Unrecognized statement: " (%code code)))))
+
+(def: (exhaust action)
+  (All [a] (-> (Meta a) (Meta Unit)))
+  (do meta;Monad<Meta>
+    [result action]
+    (exhaust action)))
+
+(def: prelude Text "lux")
+
+(def: (with-active-compilation [module-name file-name source-code] action)
+  (All [a] (-> [Text Text Text] (Meta a) (Meta a)))
+  (do meta;Monad<Meta>
+    [#let [init-cursor [file-name +1 +0]]
+     output (&;with-source-code [init-cursor +0 source-code]
+              action)
+     _ (&module;flag-compiled! module-name)]
+    (wrap output)))
+
+(def: parse
+  (Meta Code)
+  (function [compiler]
+    (case (&syntax;parse (get@ #;source compiler))
+      (#e;Error error)
+      (#e;Error error)
+
+      (#e;Success [source' output])
+      (#e;Success [(set@ #;source source' compiler)
+                   output]))))
+
+(def: (generate-module source-dirs module-name target-dir compiler)
+  (-> (List File) Text File Compiler (T;Task Compiler))
+  (do T;Monad<Task>
+    [_ (&io;prepare-module target-dir module-name)
+     [file-name file-content] (&io;read-module source-dirs module-name)
+     #let [module-hash (text/hash file-content)]]
+    (case (meta;run' compiler
+                     (do meta;Monad<Meta>
+                       [[_ artifacts _] (&module;with-module module-hash module-name
+                                          (commonT;with-artifacts
+                                            (with-active-compilation [module-name
+                                                                      file-name
+                                                                      file-content]
+                                              (exhaust
+                                               (do @
+                                                 [code parse
+                                                  #let [[cursor _] code]]
+                                                 (&;with-cursor cursor
+                                                   (generate code)))))))]
+                       (wrap artifacts)
+                       ## (&module;generate-descriptor module-name)
+                       ))
+      (#e;Success [compiler artifacts ## module-descriptor
+                   ])
+      (do @
+        [## _ (&io;write-module module-name module-descriptor)
+         _ (monad;map @ (function [[class-name class-bytecode]]
+                          (&io;write-file target-dir class-name class-bytecode))
+                      (dict;entries artifacts))]
+        (wrap compiler))
+      
+      (#e;Error error)
+      (T;fail error))))
+
+(def: init-cursor Cursor ["" +1 +0])
+
+(def: #export init-type-context
+  Type-Context
+  {#;ex-counter +0
+   #;var-counter +0
+   #;var-bindings (list)})
+
+(def: #export init-info
+  Info
+  {#;target  "JVM"
+   #;version &;version
+   #;mode    #;Build})
+
+(def: #export (init-compiler host)
+  (-> commonT;Host Compiler)
+  {#;info            init-info
+   #;source          [init-cursor +0 ""]
+   #;cursor          init-cursor
+   #;current-module  #;None
+   #;modules         (list)
+   #;scopes          (list)
+   #;type-context    init-type-context
+   #;expected        #;None
+   #;seed            +0
+   #;scope-type-vars (list)
+   #;host            (:! Void host)})
+
+(def: #export (generate-program program target sources)
+  (-> Text File (List File) (T;Task Unit))
+  (do T;Monad<Task>
+    [compiler (|> (case (runtimeT;generate (init-compiler (io;run hostL;init-host)))
+                    (#e;Error error)
+                    (T;fail error)
+
+                    (#e;Success [compiler [runtime-bc function-bc]])
+                    (do @
+                      [_ (&io;prepare-target target)
+                       _ (&io;write-file target hostL;runtime-class runtime-bc)
+                       _ (&io;write-file target hostL;function-class function-bc)]
+                      (wrap compiler)))
+                  (: (T;Task Compiler))
+                  (:: @ map (generate-module sources prelude target)) (:: @ join)
+                  (:: @ map (generate-module sources program target)) (:: @ join))
+     #let [_ (log! "Compilation complete!")]]
+    (wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux
new file mode 100644
index 000000000..a9ea4482a
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -0,0 +1,225 @@
+(;module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data text/format)
+       [meta "meta/" Monad<Meta>])
+  (luxc ["_" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$i" inst]))
+        (lang ["ls" synthesis]))
+  [../runtime])
+
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+
+(def: (pop-altI stack-depth)
+  (-> Nat $;Inst)
+  (case stack-depth
+    +0 id
+    +1 $i;POP
+    +2 $i;POP2
+    _ ## (n.> +2)
+    (|>. $i;POP2
+         (pop-altI (n.- +2 stack-depth)))))
+
+(def: peekI
+  $;Inst
+  (|>. $i;DUP
+       ($i;INVOKESTATIC hostL;runtime-class
+                        "pm_peek"
+                        ($t;method (list ../runtime;$Stack)
+                                   (#;Some $Object)
+                                   (list))
+                        false)))
+
+(def: popI
+  $;Inst
+  (|>. ($i;INVOKESTATIC hostL;runtime-class
+                        "pm_pop"
+                        ($t;method (list ../runtime;$Stack)
+                                   (#;Some ../runtime;$Stack)
+                                   (list))
+                        false)))
+
+(def: pushI
+  $;Inst
+  (|>. ($i;INVOKESTATIC hostL;runtime-class
+                        "pm_push"
+                        ($t;method (list ../runtime;$Stack $Object)
+                                   (#;Some ../runtime;$Stack)
+                                   (list))
+                        false)))
+
+(exception: #export Unrecognized-Path)
+
+(def: (generate-path' generate stack-depth @else @end path)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      Nat $;Label $;Label ls;Path (Meta $;Inst))
+  (case path
+    (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
+    (do meta;Monad<Meta>
+      [bodyI (generate bodyS)]
+      (wrap (|>. (pop-altI stack-depth)
+                 bodyI
+                 ($i;GOTO @end))))
+
+    (^ [_ (#;Form (list [_ (#;Text "lux case pop")]))])
+    (meta/wrap popI)
+
+    (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
+    (meta/wrap (|>. peekI
+                    ($i;ASTORE register)
+                    popI))
+
+    [_ (#;Bool value)]
+    (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
+                 (|>. peekI
+                      ($i;unwrap #$;Boolean)
+                      (jumpI @else))))
+
+    (^template [<tag> <prep>]
+      [_ (<tag> value)]
+      (meta/wrap (|>. peekI
+                      ($i;unwrap #$;Long)
+                      ($i;long (|> value <prep>))
+                      $i;LCMP
+                      ($i;IFNE @else))))
+    ([#;Nat (:! Int)]
+     [#;Int (: Int)]
+     [#;Deg (:! Int)])
+
+    [_ (#;Frac value)]
+    (meta/wrap (|>. peekI
+                    ($i;unwrap #$;Double)
+                    ($i;double value)
+                    $i;DCMPL
+                    ($i;IFNE @else)))
+    
+    [_ (#;Text value)]
+    (meta/wrap (|>. peekI
+                    ($i;string value)
+                    ($i;INVOKEVIRTUAL "java.lang.Object"
+                                      "equals"
+                                      ($t;method (list $Object)
+                                                 (#;Some $t;boolean)
+                                                 (list))
+                                      false)
+                    ($i;IFEQ @else)))
+
+    (^template [<special> <method>]
+      (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
+      (do meta;Monad<Meta>
+        [subI (generate-path' generate stack-depth @else @end subP)]
+        (wrap (case idx
+                +0
+                (|>. peekI
+                     ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
+                     ($i;int 0)
+                     $i;AALOAD
+                     pushI
+                     subI)
+                
+                _
+                (|>. peekI
+                     ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
+                     ($i;int (nat-to-int idx))
+                     ($i;INVOKESTATIC hostL;runtime-class
+                                      <method>
+                                      ($t;method (list ../runtime;$Tuple $t;int)
+                                                 (#;Some $Object)
+                                                 (list))
+                                      false)
+                     pushI
+                     subI)))))
+    (["lux case tuple left" "pm_left"]
+     ["lux case tuple right" "pm_right"])
+
+    (^template [<special> <flag>]
+      (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
+      (do meta;Monad<Meta>
+        [subI (generate-path' generate stack-depth @else @end subP)]
+        (wrap (<| $i;with-label (function [@success])
+                  $i;with-label (function [@fail])
+                  (|>. peekI
+                       ($i;CHECKCAST ($t;descriptor ../runtime;$Variant))
+                       ($i;int (nat-to-int idx))
+                       <flag>
+                       ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
+                                        ($t;method (list ../runtime;$Variant ../runtime;$Tag ../runtime;$Flag)
+                                                   (#;Some ../runtime;$Datum)
+                                                   (list))
+                                        false)
+                       $i;DUP
+                       ($i;IFNULL @fail)
+                       ($i;GOTO @success)
+                       ($i;label @fail)
+                       $i;POP
+                       ($i;GOTO @else)
+                       ($i;label @success)
+                       pushI
+                       subI)))))
+    (["lux case variant left" $i;NULL]
+     ["lux case variant right" ($i;string "")])
+    
+    (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
+    (do meta;Monad<Meta>
+      [leftI (generate-path' generate stack-depth @else @end leftP)
+       rightI (generate-path' generate stack-depth @else @end rightP)]
+      (wrap (|>. leftI
+                 rightI)))
+
+    (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
+    (do meta;Monad<Meta>
+      [@alt-else $i;make-label
+       leftI (generate-path' generate (n.inc stack-depth) @alt-else @end leftP)
+       rightI (generate-path' generate stack-depth @else @end rightP)]
+      (wrap (|>. $i;DUP
+                 leftI
+                 ($i;label @alt-else)
+                 $i;POP
+                 rightI)))
+
+    _
+    (_;throw Unrecognized-Path (%code path))))
+
+(def: (generate-path generate path @end)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      ls;Path $;Label (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [@else $i;make-label
+     pathI (generate-path' generate +1 @else @end path)]
+    (wrap (|>. pathI
+               ($i;label @else)
+               $i;POP
+               ($i;INVOKESTATIC hostL;runtime-class
+                                "pm_fail"
+                                ($t;method (list) #;None (list))
+                                false)
+               $i;NULL
+               ($i;GOTO @end)))))
+
+(def: #export (generate-case generate valueS path)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      ls;Synthesis ls;Path (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [@end $i;make-label
+     valueI (generate valueS)
+     pathI (generate-path generate path @end)]
+    (wrap (|>. valueI
+               $i;NULL
+               $i;SWAP
+               pushI
+               pathI
+               ($i;label @end)))))
+
+(def: #export (generate-let generate register inputS exprS)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [inputI (generate inputS)
+     exprI (generate exprS)]
+    (wrap (|>. inputI
+               ($i;ASTORE register)
+               exprI))))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
new file mode 100644
index 000000000..1870530c2
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -0,0 +1,131 @@
+(;module:
+  [lux #- function]
+  (lux (control ["ex" exception #+ exception:])
+       [io]
+       (concurrency ["A" atom])
+       (data ["e" error]
+             [text]
+             text/format
+             (coll [dict #+ Dict]))
+       [host]
+       (world [blob #+ Blob]))
+  (luxc (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))))
+
+(host;import org.objectweb.asm.Opcodes
+  (#static V1_6 int))
+
+(host;import java.lang.Object)
+
+(host;import (java.lang.Class a))
+
+(host;import java.lang.ClassLoader
+  (loadClass [String] (Class Object)))
+
+(type: #export Bytecode (host;type (Array byte)))
+
+(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
+
+(type: #export Artifacts (Dict Text Blob))
+
+(type: #export Host
+  {#loader ClassLoader
+   #store Class-Store
+   #function-class (Maybe Text)
+   #artifacts Artifacts})
+
+(exception: Unknown-Class)
+(exception: Class-Already-Stored)
+(exception: No-Function-Being-Compiled)
+(exception: Cannot-Overwrite-Artifact)
+
+(def: #export (with-artifacts action)
+  (All [a] (-> (Meta a) (Meta [Artifacts a])))
+  (;function [compiler]
+    (case (action (update@ #;host
+                           (|>. (:! Host)
+                                (set@ #artifacts (dict;new text;Hash<Text>))
+                                (:! Void))
+                           compiler))
+      (#e;Success [compiler' output])
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts)))
+                                 (:! Void))
+                            compiler')
+                   [(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts))
+                    output]])
+      
+      (#e;Error error)
+      (#e;Error error))))
+
+(def: #export (record-artifact name content)
+  (-> Text Blob (Meta Unit))
+  (;function [compiler]
+    (if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name))
+      (ex;throw Cannot-Overwrite-Artifact name)
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (update@ #artifacts (dict;put name content))
+                                 (:! Void))
+                            compiler)
+                   []]))))
+
+(def: #export (store-class name byte-code)
+  (-> Text Bytecode (Meta Unit))
+  (;function [compiler]
+    (let [store (|> (get@ #;host compiler)
+                    (:! Host)
+                    (get@ #store))]
+      (if (dict;contains? name (|> store A;get io;run))
+        (ex;throw Class-Already-Stored name)
+        (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))])
+        ))))
+
+(def: #export (load-class name)
+  (-> Text (Meta (Class Object)))
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))
+          store (|> host (get@ #store) A;get io;run)]
+      (if (dict;contains? name store)
+        (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
+        (ex;throw Unknown-Class name)))))
+
+(def: #export (with-function class expr)
+  (All [a] (-> Text (Meta a) (Meta a)))
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))
+          old-function-class (get@ #function-class host)]
+      (case (expr (set@ #;host
+                        (:! Void (set@ #function-class
+                                       (#;Some class)
+                                       host))
+                        compiler))
+        (#e;Success [compiler' output])
+        (#e;Success [(update@ #;host
+                              (|>. (:! Host)
+                                   (set@ #function-class old-function-class)
+                                   (:! Void))
+                              compiler')
+                     output])
+
+        (#e;Error error)
+        (#e;Error error)))))
+
+(def: #export function
+  (Meta Text)
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))]
+      (case (get@ #function-class host)
+        #;None
+        (ex;throw No-Function-Being-Compiled "")
+        
+        (#;Some function-class)
+        (#e;Success [compiler function-class])))))
+
+(def: #export bytecode-version Int Opcodes.V1_6)
+
+(def: #export value-field Text "_value")
+(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))
diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
new file mode 100644
index 000000000..9514741f8
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux
@@ -0,0 +1,80 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [meta]
+       [host #+ do-to])
+  (luxc ["&" base]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common]))
+        ))
+
+(host;import java.lang.Object)
+(host;import java.lang.String)
+
+(host;import java.lang.reflect.Field
+  (get [Object] Object))
+
+(host;import (java.lang.Class a)
+  (getField [String] Field))
+
+(host;import org.objectweb.asm.Opcodes
+  (#static ACC_PUBLIC int)
+  (#static ACC_SUPER int)
+  (#static ACC_FINAL int)
+  (#static ACC_STATIC int)
+  (#static PUTSTATIC int)
+  (#static RETURN int)
+  (#static V1_6 int)
+  )
+
+(host;import org.objectweb.asm.MethodVisitor
+  (visitCode [] void)
+  (visitEnd [] void)
+  (visitLdcInsn [Object] void)
+  (visitFieldInsn [int String String String] void)
+  (visitInsn [int] void)
+  (visitMaxs [int int] void))
+
+(host;import org.objectweb.asm.FieldVisitor
+  (visitEnd [] void))
+
+(host;import org.objectweb.asm.ClassWriter
+  (#static COMPUTE_MAXS int)
+  (new [int])
+  (visit [int int String String String (Array String)] void)
+  (visitEnd [] void)
+  (visitField [int String String String Object] FieldVisitor)
+  (visitMethod [int String String String (Array String)] MethodVisitor)
+  (toByteArray [] (Array byte)))
+
+(def: #export (eval valueI)
+  (-> $;Inst (Meta Top))
+  (do meta;Monad<Meta>
+    [class-name (:: @ map %code (meta;gensym "eval"))
+     #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+                        (ClassWriter.visit [commonT;bytecode-version
+                                            (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER)
+                                            class-name
+                                            (host;null)
+                                            "java/lang/Object"
+                                            (host;null)]))
+                      ($d;field #$;Public ($_ $;++F $;finalF $;staticF)
+                                commonT;value-field commonT;$Object)
+                      ($d;method #$;Public ($_ $;++M $;staticM $;strictM)
+                                 "<clinit>"
+                                 ($t;method (list) #;None (list))
+                                 (|>. valueI
+                                      ($i;PUTSTATIC class-name commonT;value-field commonT;$Object)
+                                      $i;RETURN)))
+           bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+     _ (commonT;store-class class-name bytecode)
+     class (commonT;load-class class-name)]
+    (wrap (|> class
+              (Class.getField [commonT;value-field])
+              (Field.get (host;null))))))
diff --git a/new-luxc/source/luxc/lang/translation/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
new file mode 100644
index 000000000..af66d4994
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux
@@ -0,0 +1,76 @@
+(;module:
+  lux
+  (lux (control monad
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             text/format)
+       [meta]
+       (meta ["s" syntax]))
+  (luxc ["&" base]
+        (host ["$" jvm])
+        (lang ["ls" synthesis]
+              (translation [";T" common]
+                           [";T" primitive]
+                           [";T" structure]
+                           [";T" eval]
+                           [";T" procedure]
+                           [";T" function]
+                           [";T" reference]
+                           [";T" case])
+              [";L" variable #+ Variable Register])))
+
+(exception: #export Unrecognized-Synthesis)
+
+(def: #export (generate synthesis)
+  (-> ls;Synthesis (Meta $;Inst))
+  (case synthesis
+    (^code [])
+    primitiveT;generate-unit
+
+    (^code [(~ singleton)])
+    (generate singleton)
+
+    (^template [<tag> <generator>]
+      [_ (<tag> value)]
+      (<generator> value))
+    ([#;Bool primitiveT;generate-bool]
+     [#;Nat  primitiveT;generate-nat]
+     [#;Int  primitiveT;generate-int]
+     [#;Deg  primitiveT;generate-deg]
+     [#;Frac primitiveT;generate-frac]
+     [#;Text primitiveT;generate-text])
+
+    (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Bool last?)]) (~ valueS)))
+    (structureT;generate-variant generate tag last? valueS)
+
+    (^code [(~@ members)])
+    (structureT;generate-tuple generate members)
+
+    (^ [_ (#;Form (list [_ (#;Int var)]))])
+    (if (variableL;captured? var)
+      (referenceT;generate-captured var)
+      (referenceT;generate-variable var))
+
+    [_ (#;Symbol definition)]
+    (referenceT;generate-definition definition)
+
+    (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ exprS)))
+    (caseT;generate-let generate register inputS exprS)
+
+    (^code ("lux case" (~ inputS) (~ pathPS)))
+    (caseT;generate-case generate inputS pathPS)
+
+    (^multi (^code ("lux function" (~ [_ (#;Nat arity)]) [(~@ environment)] (~ bodyS)))
+            [(s;run environment (p;some s;int)) (#e;Success environment)])
+    (functionT;generate-function generate environment arity bodyS)
+
+    (^code ("lux call" (~ functionS) (~@ argsS)))
+    (functionT;generate-call generate functionS argsS)
+
+    (^code ((~ [_ (#;Text procedure)]) (~@ argsS)))
+    (procedureT;generate-procedure generate procedure argsS)
+
+    _
+    (&;throw Unrecognized-Synthesis (%code synthesis))
+    ))
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
new file mode 100644
index 000000000..35c88e4ed
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -0,0 +1,333 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data text/format
+             (coll [list "list/" Functor<List> Monoid<List>]))
+       [meta])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common]
+                           [";T" runtime])
+              [";L" variable #+ Variable])))
+
+
+(def: arity-field Text "arity")
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+
+(do-template [<name> <prefix>]
+  [(def: #export (<name> idx)
+     (-> Nat Text)
+     (|> idx nat-to-int %i (format <prefix>)))]
+
+  [captured "c"]
+  [partial  "p"]
+  )
+
+(def: (poly-arg? arity)
+  (-> ls;Arity Bool)
+  (n.> +1 arity))
+
+(def: (reset-method class)
+  (-> Text $;Method)
+  ($t;method (list) (#;Some ($t;class class (list))) (list)))
+
+(def: (captured-args env)
+  (-> (List Variable) (List $;Type))
+  (list;repeat (list;size env) $Object))
+
+(def: (init-method env arity)
+  (-> (List Variable) ls;Arity $;Method)
+  (if (poly-arg? arity)
+    ($t;method (list;concat (list (captured-args env)
+                                  (list $t;int)
+                                  (list;repeat (n.dec arity) $Object)))
+               #;None
+               (list))
+    ($t;method (captured-args env) #;None (list))))
+
+(def: (implementation-method arity)
+  ($t;method (list;repeat arity $Object) (#;Some $Object) (list)))
+
+(def: get-amount-of-partialsI
+  $;Inst
+  (|>. ($i;ALOAD +0)
+       ($i;GETFIELD hostL;function-class runtimeT;partials-field $t;int)))
+
+(def: (load-fieldI class field)
+  (-> Text Text $;Inst)
+  (|>. ($i;ALOAD +0)
+       ($i;GETFIELD class field $Object)))
+
+(def: (inputsI start amount)
+  (-> $;Register Nat $;Inst)
+  (|> (list;n.range start (n.+ start (n.dec amount)))
+      (list/map $i;ALOAD)
+      $i;fuse))
+
+(def: (applysI start amount)
+  (-> $;Register Nat $;Inst)
+  (let [max-args (n.min amount runtimeT;num-apply-variants)
+        later-applysI (if (n.> runtimeT;num-apply-variants amount)
+                        (applysI (n.+ runtimeT;num-apply-variants start) (n.- runtimeT;num-apply-variants amount))
+                        id)]
+    (|>. ($i;CHECKCAST hostL;function-class)
+         (inputsI start max-args)
+         ($i;INVOKEVIRTUAL hostL;function-class runtimeT;apply-method (runtimeT;apply-signature max-args) false)
+         later-applysI)))
+
+(def: (inc-intI by)
+  (-> Nat $;Inst)
+  (|>. ($i;int (nat-to-int by))
+       $i;IADD))
+
+(def: (nullsI amount)
+  (-> Nat $;Inst)
+  (|> $i;NULL
+      (list;repeat amount)
+      $i;fuse))
+
+(def: (with-captured env)
+  (-> (List Variable) $;Def)
+  (|> (list;enumerate env)
+      (list/map (function [[env-idx env-source]]
+                  ($d;field #$;Private $;finalF (captured env-idx) $Object)))
+      $d;fuse))
+
+(def: (with-partial arity)
+  (-> ls;Arity $;Def)
+  (if (poly-arg? arity)
+    (|> (list;n.range +0 (n.- +2 arity))
+        (list/map (function [idx]
+                    ($d;field #$;Private $;finalF (partial idx) $Object)))
+        $d;fuse)
+    id))
+
+(def: (instance class arity env)
+  (-> Text ls;Arity (List Variable) $;Inst)
+  (let [captureI (|> env
+                     (list/map (function [source]
+                                 (if (variableL;captured? source)
+                                   ($i;GETFIELD class (captured (variableL;captured-register source)) $Object)
+                                   ($i;ALOAD (int-to-nat source)))))
+                     $i;fuse)
+        argsI (if (poly-arg? arity)
+                (|> (nullsI (n.dec arity))
+                    (list ($i;int 0))
+                    $i;fuse)
+                id)]
+    (|>. ($i;NEW class)
+         $i;DUP
+         captureI
+         argsI
+         ($i;INVOKESPECIAL class "<init>" (init-method env arity) false))))
+
+(def: (with-reset class arity env)
+  (-> Text ls;Arity (List Variable) $;Def)
+  ($d;method #$;Public $;noneM "reset" (reset-method class)
+             (if (poly-arg? arity)
+               (let [env-size (list;size env)
+                     captureI (|> (case env-size
+                                    +0 (list)
+                                    _ (list;n.range +0 (n.dec env-size)))
+                                  (list/map (function [source]
+                                              (|>. ($i;ALOAD +0)
+                                                   ($i;GETFIELD class (captured source) $Object))))
+                                  $i;fuse)
+                     argsI (|> (nullsI (n.dec arity))
+                               (list ($i;int 0))
+                               $i;fuse)]
+                 (|>. ($i;NEW class)
+                      $i;DUP
+                      captureI
+                      argsI
+                      ($i;INVOKESPECIAL class "<init>" (init-method env arity) false)
+                      $i;ARETURN))
+               (|>. ($i;ALOAD +0)
+                    $i;ARETURN))))
+
+(def: (with-implementation arity @begin bodyI)
+  (-> Nat $;Label $;Inst $;Def)
+  ($d;method #$;Public $;strictM "impl" (implementation-method arity)
+             (|>. ($i;label @begin)
+                  bodyI
+                  $i;ARETURN)))
+
+(def: function-init-method
+  $;Method
+  ($t;method (list $t;int) #;None (list)))
+
+(def: (function-init arity env-size)
+  (-> ls;Arity Nat $;Inst)
+  (if (n.= +1 arity)
+    (|>. ($i;int 0)
+         ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))
+    (|>. ($i;ILOAD (n.inc env-size))
+         ($i;INVOKESPECIAL hostL;function-class "<init>" function-init-method false))))
+
+(def: (with-init class env arity)
+  (-> Text (List Variable) ls;Arity $;Def)
+  (let [env-size (list;size env)
+        offset-partial (: (-> Nat Nat)
+                          (|>. n.inc (n.+ env-size)))
+        store-capturedI (|> (case env-size
+                              +0 (list)
+                              _ (list;n.range +0 (n.dec env-size)))
+                            (list/map (function [register]
+                                        (|>. ($i;ALOAD +0)
+                                             ($i;ALOAD (n.inc register))
+                                             ($i;PUTFIELD class (captured register) $Object))))
+                            $i;fuse)
+        store-partialI (if (poly-arg? arity)
+                         (|> (list;n.range +0 (n.- +2 arity))
+                             (list/map (function [idx]
+                                         (let [register (offset-partial idx)]
+                                           (|>. ($i;ALOAD +0)
+                                                ($i;ALOAD (n.inc register))
+                                                ($i;PUTFIELD class (partial idx) $Object)))))
+                             $i;fuse)
+                         id)]
+    ($d;method #$;Public $;noneM "<init>" (init-method env arity)
+               (|>. ($i;ALOAD +0)
+                    (function-init arity env-size)
+                    store-capturedI
+                    store-partialI
+                    $i;RETURN))))
+
+(def: (with-apply class env function-arity @begin bodyI apply-arity)
+  (-> Text (List Variable) ls;Arity $;Label $;Inst ls;Arity
+      $;Def)
+  (let [num-partials (n.dec function-arity)
+        @default ($;new-label [])
+        @labels (list/map $;new-label (list;repeat num-partials []))
+        arity-over-extent (|> (nat-to-int function-arity) (i.- (nat-to-int apply-arity)))
+        casesI (|> (list/compose @labels (list @default))
+                   (list;zip2 (list;n.range +0 num-partials))
+                   (list/map (function [[stage @label]]
+                               (let [load-partialsI (if (n.> +0 stage)
+                                                      (|> (list;n.range +0 (n.dec stage))
+                                                          (list/map (|>. partial (load-fieldI class)))
+                                                          $i;fuse)
+                                                      id)]
+                                 (cond (i.= arity-over-extent (nat-to-int stage))
+                                       (|>. ($i;label @label)
+                                            ($i;ALOAD +0)
+                                            (when (n.> +0 stage)
+                                                  ($i;INVOKEVIRTUAL class "reset" (reset-method class) false))
+                                            load-partialsI
+                                            (inputsI +1 apply-arity)
+                                            ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+                                            $i;ARETURN)
+
+                                       (i.> arity-over-extent (nat-to-int stage))
+                                       (let [args-to-completion (|> function-arity (n.- stage))
+                                             args-left (|> apply-arity (n.- args-to-completion))]
+                                         (|>. ($i;label @label)
+                                              ($i;ALOAD +0)
+                                              ($i;INVOKEVIRTUAL class "reset" (reset-method class) false)
+                                              load-partialsI
+                                              (inputsI +1 args-to-completion)
+                                              ($i;INVOKEVIRTUAL class "impl" (implementation-method function-arity) false)
+                                              (applysI (n.inc args-to-completion) args-left)
+                                              $i;ARETURN))
+
+                                       ## (i.< arity-over-extent (nat-to-int stage))
+                                       (let [env-size (list;size env)
+                                             load-capturedI (|> (case env-size
+                                                                  +0 (list)
+                                                                  _ (list;n.range +0 (n.dec env-size)))
+                                                                (list/map (|>. captured (load-fieldI class)))
+                                                                $i;fuse)]
+                                         (|>. ($i;label @label)
+                                              ($i;NEW class)
+                                              $i;DUP
+                                              load-capturedI
+                                              get-amount-of-partialsI
+                                              (inc-intI apply-arity)
+                                              load-partialsI
+                                              (inputsI +1 apply-arity)
+                                              (nullsI (|> num-partials (n.- apply-arity) (n.- stage)))
+                                              ($i;INVOKESPECIAL class "<init>" (init-method env function-arity) false)
+                                              $i;ARETURN))
+                                       ))))
+                   $i;fuse)]
+    ($d;method #$;Public $;noneM runtimeT;apply-method (runtimeT;apply-signature apply-arity)
+               (|>. get-amount-of-partialsI
+                    ($i;TABLESWITCH 0 (|> num-partials n.dec nat-to-int)
+                                    @default @labels)
+                    casesI
+                    ($i;INVOKESTATIC hostL;runtime-class "apply_fail" ($t;method (list) #;None (list)) false)
+                    $i;NULL
+                    $i;ARETURN
+                    ))))
+
+(def: #export (with-function generate class env arity body)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      Text (List Variable) ls;Arity ls;Synthesis
+      (Meta [$;Def $;Inst]))
+  (do meta;Monad<Meta>
+    [@begin $i;make-label
+     bodyI (commonT;with-function class (generate body))
+     #let [env-size (list;size env)
+           applyD (: $;Def
+                     (if (poly-arg? arity)
+                       (|> (n.min arity runtimeT;num-apply-variants)
+                           (list;n.range +1)
+                           (list/map (with-apply class env arity @begin bodyI))
+                           (list& (with-implementation arity @begin bodyI))
+                           $d;fuse)
+                       ($d;method #$;Public $;strictM runtimeT;apply-method (runtimeT;apply-signature +1)
+                                  (|>. ($i;label @begin)
+                                       bodyI
+                                       $i;ARETURN))))
+           functionD (: $;Def
+                        (|>. ($d;int-field #$;Public ($_ $;++F $;staticF $;finalF) arity-field (nat-to-int arity))
+                             (with-captured env)
+                             (with-partial arity)
+                             (with-init class env arity)
+                             (with-reset class arity env)
+                             applyD))
+           instanceI (instance class arity env)]]
+    (wrap [functionD instanceI])))
+
+(def: #export (generate-function generate env arity body)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      (List Variable) ls;Arity ls;Synthesis
+      (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [function-class (:: @ map %code (meta;gensym "function"))
+     [functionD instanceI] (with-function generate function-class env arity body)
+     _ (commonT;store-class function-class
+                            ($d;class #$;V1.6 #$;Public $;finalC
+                                      function-class (list)
+                                      ($;simple-class hostL;function-class) (list)
+                                      functionD))]
+    (wrap instanceI)))
+
+(def: (segment size elems)
+  (All [a] (-> Nat (List a) (List (List a))))
+  (let [[pre post] (list;split size elems)]
+    (if (list;empty? post)
+      (list pre)
+      (list& pre (segment size post)))))
+
+(def: #export (generate-call generate functionS argsS)
+  (-> (-> ls;Synthesis (Meta $;Inst))
+      ls;Synthesis (List ls;Synthesis)
+      (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [functionI (generate functionS)
+     argsI (monad;map @ generate argsS)
+     #let [applyI (|> (segment runtimeT;num-apply-variants argsI)
+                      (list/map (function [chunkI+]
+                                  (|>. ($i;CHECKCAST hostL;function-class)
+                                       ($i;fuse chunkI+)
+                                       ($i;INVOKEVIRTUAL hostL;function-class runtimeT;apply-method (runtimeT;apply-signature (list;size chunkI+)) false))))
+                      $i;fuse)]]
+    (wrap (|>. functionI
+               applyI))))
diff --git a/new-luxc/source/luxc/lang/translation/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
new file mode 100644
index 000000000..72b5f4e9d
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/primitive.jvm.lux
@@ -0,0 +1,36 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format)
+       [meta "meta/" Monad<Meta>])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$i" inst]
+                   ["$t" type]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common])))
+  [../runtime])
+
+(def: #export generate-unit
+  (Meta $;Inst)
+  (meta/wrap ($i;string hostL;unit)))
+
+(def: #export (generate-bool value)
+  (-> Bool (Meta $;Inst))
+  (meta/wrap ($i;GETSTATIC "java.lang.Boolean"
+                           (if value "TRUE" "FALSE")
+                           ($t;class "java.lang.Boolean" (list)))))
+
+(do-template [<name> <type> <load> <wrap>]
+  [(def: #export (<name> value)
+     (-> <type> (Meta $;Inst))
+     (meta/wrap (|>. (<load> value) <wrap>)))]
+
+  [generate-nat  Nat  (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
+  [generate-int  Int  $i;long ($i;wrap #$;Long)]
+  [generate-deg  Deg  (|>. (:! Int) $i;long) ($i;wrap #$;Long)]
+  [generate-frac Frac $i;double ($i;wrap #$;Double)]
+  [generate-text Text $i;string id]
+  )
diff --git a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
new file mode 100644
index 000000000..973f0e968
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
@@ -0,0 +1,24 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data [maybe]
+             text/format
+             (coll [dict])))
+  (luxc ["&" base]
+        (host ["$" jvm])
+        (lang ["ls" synthesis]))
+  (. ["./;" common]
+     ["./;" host]))
+
+(def: procedures
+  ./common;Bundle
+  (|> ./common;procedures
+      (dict;merge ./host;procedures)))
+
+(def: #export (generate-procedure generate name args)
+  (-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Synthesis)
+      (Meta $;Inst))
+  (<| (maybe;default (&;fail (format "Unknown procedure: " (%t name))))
+      (do maybe;Monad<Maybe>
+        [proc (dict;get name procedures)]
+        (wrap (proc generate args)))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
new file mode 100644
index 000000000..80becb058
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -0,0 +1,707 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]
+                   [dict #+ Dict]))
+       [meta #+ with-gensyms]
+       (meta [code]
+             ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" runtime]))))
+
+(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 Generator
+  (-> ls;Synthesis (Meta $;Inst)))
+
+(type: #export Proc
+  (-> Generator (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))
+
+## [Utils]
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object-Array $;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!generate g!inputs]
+    (do @
+      [g!input+ (monad;seq @ (list;repeat arity (meta;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!generate) (~ g!inputs)]
+                           (case (~ g!inputs)
+                             (^ (list (~@ g!input+)))
+                             (do meta;Monad<Meta>
+                               [(~@ (|> g!input+
+                                        (list/map (function [g!input]
+                                                    (list g!input (` ((~ g!generate) (~ g!input))))))
+                                        list;concat))]
+                               ((~' wrap) ((~ g!proc) [(~@ g!input+)])))
+
+                             (~' _)
+                             (meta;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs))))))))))))))
+
+(arity: nullary +0)
+(arity: unary +1)
+(arity: binary +2)
+(arity: trinary +3)
+
+## [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)
+           )))
+
+## [Procedures]
+## [[Lux]]
+(def: (lux//is [leftI rightI])
+  Binary
+  (|>. leftI
+       rightI
+       (predicateI $i;IF_ACMPEQ)))
+
+(def: try-method
+  $;Method
+  ($t;method (list $Function) (#;Some $Object-Array) (list)))
+(def: (lux//try riskyI)
+  Unary
+  (|>. riskyI
+       ($i;CHECKCAST hostL;function-class)
+       ($i;INVOKESTATIC hostL;runtime-class "try" try-method false)))
+
+(def: (lux//noop valueI)
+  Unary
+  valueI)
+
+## [[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;descriptor $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> <wrapper>]
+  [(def: (<name> _)
+     Nullary
+     (|>. <const> <wrapper>))]
+
+  [nat//min                ($i;long 0)                             ($i;wrap #$;Long)]
+  [nat//max                ($i;long -1)                            ($i;wrap #$;Long)]
+
+  [int//min                ($i;long Long.MIN_VALUE)                ($i;wrap #$;Long)]
+  [int//max                ($i;long Long.MAX_VALUE)                ($i;wrap #$;Long)]
+  
+  [frac//smallest          ($i;double Double.MIN_VALUE)            ($i;wrap #$;Double)]
+  [frac//min               ($i;double (f.* -1.0 Double.MAX_VALUE)) ($i;wrap #$;Double)]
+  [frac//max               ($i;double Double.MAX_VALUE)            ($i;wrap #$;Double)]
+  [frac//not-a-number      ($i;double Double.NaN)                  ($i;wrap #$;Double)]
+  [frac//positive-infinity ($i;double Double.POSITIVE_INFINITY)    ($i;wrap #$;Double)]
+  [frac//negative-infinity ($i;double Double.NEGATIVE_INFINITY)    ($i;wrap #$;Double)]
+
+  [deg//min                ($i;long 0)                             ($i;wrap #$;Long)]
+  [deg//max                ($i;long -1)                            ($i;wrap #$;Long)]
+  )
+
+(do-template [<name> <unwrap> <wrap> <op>]
+  [(def: (<name> [subjectI paramI])
+     Binary
+     (|>. subjectI <unwrap>
+          paramI <unwrap>
+          <op>
+          <wrap>))]
+
+  [int//add        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LADD]
+  [int//sub        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LSUB]
+  [int//mul        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LMUL]
+  [int//div        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LDIV]
+  [int//rem        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LREM]
+  
+  [nat//add        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LADD]
+  [nat//sub        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LSUB]
+  [nat//mul        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LMUL]
+  [nat//div        ($i;unwrap #$;Long)   ($i;wrap #$;Long)
+   ($i;INVOKESTATIC hostL;runtime-class "div_nat" nat-method false)]
+  [nat//rem        ($i;unwrap #$;Long)   ($i;wrap #$;Long)
+   ($i;INVOKESTATIC hostL;runtime-class "rem_nat" nat-method false)]
+
+  [frac//add       ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DADD]
+  [frac//sub       ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DSUB]
+  [frac//mul       ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DMUL]
+  [frac//div       ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DDIV]
+  [frac//rem       ($i;unwrap #$;Double) ($i;wrap #$;Double) $i;DREM]
+
+  [deg//add        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LADD]
+  [deg//sub        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LSUB]
+  [deg//mul        ($i;unwrap #$;Long)   ($i;wrap #$;Long)
+   ($i;INVOKESTATIC hostL;runtime-class "mul_deg" deg-method false)]
+  [deg//div        ($i;unwrap #$;Long)   ($i;wrap #$;Long)
+   ($i;INVOKESTATIC hostL;runtime-class "div_deg" deg-method false)]
+  [deg//rem        ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LSUB]
+  [deg//scale      ($i;unwrap #$;Long)   ($i;wrap #$;Long)   $i;LMUL]
+  [deg//reciprocal ($i;unwrap #$;Long)   ($i;wrap #$;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//to-char ($i;unwrap #$;Long)
+   (<| ($i;INVOKESTATIC "java.lang.Character" "toString" ($t;method (list $t;char) (#;Some $String) (list)) false)
+       $i;I2C $i;L2I)]
+  
+  [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-case "java.lang.String" "toUpperCase" id       $String]
+  [text//lower-case "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)]
+  [text//append ($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 $t;int) (list)) false)
+   lux-intI]
+  )
+
+(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 $Object-Array) (list)) false)]
+  [text//replace ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
+   ($i;INVOKEVIRTUAL "java.lang.String" "replace" ($t;method (list $CharSequence $CharSequence) (#;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)
+       ($i;string hostL;unit)))
+
+(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)))
+
+## [[Processes]]
+(def: (process//concurrency-level [])
+  Nullary
+  (|>. ($i;GETSTATIC hostL;runtime-class "concurrency_level" $t;int)
+       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 "lux noop" (unary lux//noop))
+      (install "lux is" (binary lux//is))
+      (install "lux try" (unary lux//try))))
+
+(def: bit-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "bit count" (unary bit//count))
+      (install "bit and" (binary bit//and))
+      (install "bit or" (binary bit//or))
+      (install "bit xor" (binary bit//xor))
+      (install "bit shift-left" (binary bit//shift-left))
+      (install "bit unsigned-shift-right" (binary bit//unsigned-shift-right))
+      (install "bit shift-right" (binary bit//shift-right))
+      ))
+
+(def: nat-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "nat +" (binary nat//add))
+      (install "nat -" (binary nat//sub))
+      (install "nat *" (binary nat//mul))
+      (install "nat /" (binary nat//div))
+      (install "nat %" (binary nat//rem))
+      (install "nat =" (binary nat//eq))
+      (install "nat <" (binary nat//lt))
+      (install "nat min" (nullary nat//min))
+      (install "nat max" (nullary nat//max))
+      (install "nat to-int" (unary nat//to-int))
+      (install "nat to-char" (unary nat//to-char))))
+
+(def: int-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "int +" (binary int//add))
+      (install "int -" (binary int//sub))
+      (install "int *" (binary int//mul))
+      (install "int /" (binary int//div))
+      (install "int %" (binary int//rem))
+      (install "int =" (binary int//eq))
+      (install "int <" (binary int//lt))
+      (install "int min" (nullary int//min))
+      (install "int max" (nullary int//max))
+      (install "int to-nat" (unary int//to-nat))
+      (install "int to-frac" (unary int//to-frac))))
+
+(def: deg-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "deg +" (binary deg//add))
+      (install "deg -" (binary deg//sub))
+      (install "deg *" (binary deg//mul))
+      (install "deg /" (binary deg//div))
+      (install "deg %" (binary deg//rem))
+      (install "deg =" (binary deg//eq))
+      (install "deg <" (binary deg//lt))
+      (install "deg scale" (binary deg//scale))
+      (install "deg reciprocal" (binary deg//reciprocal))
+      (install "deg min" (nullary deg//min))
+      (install "deg max" (nullary deg//max))
+      (install "deg to-frac" (unary deg//to-frac))))
+
+(def: frac-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "frac +" (binary frac//add))
+      (install "frac -" (binary frac//sub))
+      (install "frac *" (binary frac//mul))
+      (install "frac /" (binary frac//div))
+      (install "frac %" (binary frac//rem))
+      (install "frac =" (binary frac//eq))
+      (install "frac <" (binary frac//lt))
+      (install "frac smallest" (nullary frac//smallest))
+      (install "frac min" (nullary frac//min))
+      (install "frac max" (nullary frac//max))
+      (install "frac not-a-number" (nullary frac//not-a-number))
+      (install "frac positive-infinity" (nullary frac//positive-infinity))
+      (install "frac negative-infinity" (nullary frac//negative-infinity))
+      (install "frac to-deg" (unary frac//to-deg))
+      (install "frac to-int" (unary frac//to-int))
+      (install "frac encode" (unary frac//encode))
+      (install "frac decode" (unary frac//decode))))
+
+(def: text-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "text =" (binary text//eq))
+      (install "text <" (binary text//lt))
+      (install "text append" (binary text//append))
+      (install "text index" (trinary text//index))
+      (install "text size" (unary text//size))
+      (install "text hash" (unary text//hash))
+      (install "text replace" (trinary text//replace))
+      (install "text char" (binary text//char))
+      (install "text clip" (trinary text//clip))
+      ))
+
+(def: array-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "array new" (unary array//new))
+      (install "array get" (binary array//get))
+      (install "array put" (trinary array//put))
+      (install "array remove" (binary array//remove))
+      (install "array size" (unary array//size))
+      ))
+
+(def: math-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "math cos" (unary math//cos))
+      (install "math sin" (unary math//sin))
+      (install "math tan" (unary math//tan))
+      (install "math acos" (unary math//acos))
+      (install "math asin" (unary math//asin))
+      (install "math atan" (unary math//atan))
+      (install "math cosh" (unary math//cosh))
+      (install "math sinh" (unary math//sinh))
+      (install "math tanh" (unary math//tanh))
+      (install "math exp" (unary math//exp))
+      (install "math log" (unary math//log))
+      (install "math root2" (unary math//root2))
+      (install "math root3" (unary math//root3))
+      (install "math ceil" (unary math//ceil))
+      (install "math floor" (unary math//floor))
+      (install "math round" (unary math//round))
+      (install "math atan2" (binary math//atan2))
+      (install "math pow" (binary math//pow))
+      ))
+
+(def: io-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "io log" (unary io//log))
+      (install "io error" (unary io//error))
+      (install "io exit" (unary io//exit))
+      (install "io current-time" (nullary io//current-time))))
+
+(def: atom-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "atom new" (unary atom//new))
+      (install "atom read" (unary atom//read))
+      (install "atom compare-and-swap" (trinary atom//compare-and-swap))))
+
+(def: process-procs
+  Bundle
+  (|> (dict;new text;Hash<Text>)
+      (install "process concurrency-level" (nullary process//concurrency-level))
+      (install "process future" (unary process//future))
+      (install "process schedule" (binary process//schedule))
+      ))
+
+(def: #export procedures
+  Bundle
+  (|> (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 process-procs)
+      ))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
new file mode 100644
index 000000000..c222e42cf
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/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]))
+       [meta #+ with-gensyms "meta/" Monad<Meta>]
+       (meta [code]
+             ["s" syntax #+ syntax:])
+       [host])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              (analysis (procedure ["&;" host]))
+              ["ls" synthesis]))
+  ["@" ../common])
+
+(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 generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Nat level)] [_ (#;Text class)] lengthS))
+    (do meta;Monad<Meta>
+      [lengthI (generate 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))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (array//read proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] idxS arrayS))
+    (do meta;Monad<Meta>
+      [arrayI (generate arrayS)
+       idxI (generate 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)))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (array//write proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] idxS valueS arrayS))
+    (do meta;Monad<Meta>
+      [arrayI (generate arrayS)
+       idxI (generate idxS)
+       valueI (generate 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)))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(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 generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)]))
+    (do meta;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))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (object//instance? proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] objectS))
+    (do meta;Monad<Meta>
+      [objectI (generate objectS)]
+      (wrap (|>. objectI
+                 ($i;INSTANCEOF class)
+                 ($i;wrap #$;Boolean))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(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 generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)]))
+    (do meta;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))))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (static//put proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS))
+    (do meta;Monad<Meta>
+      [valueI (generate 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)))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (virtual//get proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] objectS))
+    (do meta;Monad<Meta>
+      [objectI (generate 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)))))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (virtual//put proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS objectS))
+    (do meta;Monad<Meta>
+      [valueI (generate valueS)
+       objectI (generate 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)))))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(exception: #export Invalid-Syntax-For-Argument-Generation)
+
+(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: (generate-type argD)
+  (-> Text (Meta $;Type))
+  (case (l;run argD java-type)
+    (#e;Error error)
+    (&;fail error)
+
+    (#e;Success type)
+    (meta/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: (generate-args generate argsS)
+  (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis)
+      (Meta (List [$;Type $;Inst])))
+  (case argsS
+    #;Nil
+    (meta/wrap #;Nil)
+
+    (^ (list& [_ (#;Tuple (list [_ (#;Text argD)] argS))] tail))
+    (do meta;Monad<Meta>
+      [argT (generate-type argD)
+       argI (:: @ map (prepare-input argT) (generate argS))
+       =tail (generate-args generate tail)]
+      (wrap (list& [argT argI] =tail)))
+
+    _
+    (&;throw Invalid-Syntax-For-Argument-Generation "")))
+
+(def: (method-return-type description)
+  (-> Text (Meta (Maybe $;Type)))
+  (case description
+    "void"
+    (meta/wrap #;None)
+
+    _
+    (:: meta;Monad<Meta> map (|>. #;Some) (generate-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 generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list& [_ (#;Text class)] [_ (#;Text method)]
+              [_ (#;Text unboxed)] argsS))
+    (do meta;Monad<Meta>
+      [argsTI (generate-args generate 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)))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(do-template [<name> <invoke> <interface?>]
+  [(def: (<name> proc generate inputs)
+     (-> Text @;Proc)
+     (case inputs
+       (^ (list& [_ (#;Text class)] [_ (#;Text method)]
+                 [_ (#;Text unboxed)] objectS argsS))
+       (do meta;Monad<Meta>
+         [objectI (generate objectS)
+          argsTI (generate-args generate 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)))
+
+       _
+       (&;fail (format "Wrong syntax for '" proc "'."))))]
+
+  [invoke//virtual $i;INVOKEVIRTUAL false]
+  [invoke//special $i;INVOKESPECIAL false]
+  [invoke//interface $i;INVOKEINTERFACE true]
+  )
+
+(def: (invoke//constructor proc generate inputs)
+  (-> Text @;Proc)
+  (case inputs
+    (^ (list& [_ (#;Text class)] argsS))
+    (do meta;Monad<Meta>
+      [argsTI (generate-args generate 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))))
+
+    _
+    (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(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)
+          )))
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
new file mode 100644
index 000000000..7c42f9f08
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -0,0 +1,31 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data text/format)
+       [meta "meta/" Monad<Meta>])
+  (luxc ["&" base]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$i" inst]))
+        (lang ["ls" synthesis]
+              [";L" variable #+ Variable]
+              (translation [";T" common]
+                           [";T" function]))))
+
+(def: #export (generate-captured variable)
+  (-> Variable (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [function-class commonT;function]
+    (wrap (|>. ($i;ALOAD +0)
+               ($i;GETFIELD function-class
+                            (|> variable i.inc (i.* -1) int-to-nat functionT;captured)
+                            commonT;$Object)))))
+
+(def: #export (generate-variable variable)
+  (-> Variable (Meta $;Inst))
+  (meta/wrap ($i;ALOAD (int-to-nat variable))))
+
+(def: #export (generate-definition [def-module def-name])
+  (-> Ident (Meta $;Inst))
+  (let [bytecode-name (format def-module "/" (&;normalize-name def-name))]
+    (meta/wrap ($i;GETSTATIC bytecode-name commonT;value-field commonT;$Object))))
diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
new file mode 100644
index 000000000..e5d237fc7
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux
@@ -0,0 +1,608 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format
+             (coll [list "list/" Functor<List>]))
+       [math]
+       [meta]
+       [host])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common]))))
+
+(host;import java.lang.Object)
+(host;import java.lang.String)
+
+(host;import java.lang.reflect.Field
+  (get [Object] #try Object))
+
+(host;import (java.lang.Class a)
+  (getField [String] Field))
+
+(host;import org.objectweb.asm.Opcodes
+  (#static ACC_PUBLIC int)
+  (#static ACC_SUPER int)
+  (#static ACC_FINAL int)
+  (#static ACC_STATIC int)
+  (#static V1_6 int))
+
+(host;import org.objectweb.asm.ClassWriter
+  (#static COMPUTE_MAXS int)
+  (new [int])
+  (visit [int int String String String (Array String)] void)
+  (visitEnd [] void)
+  (toByteArray [] (Array byte)))
+
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object-Array $;Type ($t;array +1 $Object))
+(def: $String $;Type ($t;class "java.lang.String" (list)))
+(def: #export $Stack $;Type ($t;array +1 $Object))
+(def: #export $Tuple $;Type $Object-Array)
+(def: #export $Variant $;Type $Object-Array)
+(def: #export $Tag $;Type $t;int)
+(def: #export $Flag $;Type $Object)
+(def: #export $Datum $;Type $Object)
+(def: #export $Function $;Type ($t;class hostL;function-class (list)))
+(def: $Throwable $;Type ($t;class "java.lang.Throwable" (list)))
+
+(def: #export logI
+  $;Inst
+  (let [outI ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list)))
+        printI (function [method] ($i;INVOKEVIRTUAL "java.io.PrintStream" method ($t;method (list $Object) #;None (list)) false))]
+    (|>. outI ($i;string "LOG: ") (printI "print")
+         outI $i;SWAP (printI "println"))))
+
+(def: variant-method
+  $;Method
+  ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list)))
+
+(def: variantI
+  $;Inst
+  ($i;INVOKESTATIC hostL;runtime-class "variant_make" variant-method false))
+
+(def: #export leftI
+  $;Inst
+  (|>. ($i;int 0)
+       $i;NULL
+       $i;DUP2_X1
+       $i;POP2
+       variantI))
+
+(def: #export rightI
+  $;Inst
+  (|>. ($i;int 1)
+       ($i;string "")
+       $i;DUP2_X1
+       $i;POP2
+       variantI))
+
+(def: #export someI $;Inst rightI)
+
+(def: #export noneI
+  $;Inst
+  (|>. ($i;int 0)
+       $i;NULL
+       ($i;string hostL;unit)
+       variantI))
+
+(def: #export string-concatI
+  $;Inst
+  ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false))
+
+(def: #export partials-field Text "partials")
+(def: #export apply-method Text "apply")
+(def: #export num-apply-variants Nat +8)
+
+(def: #export (apply-signature arity)
+  (-> ls;Arity $;Method)
+  ($t;method (list;repeat arity $Object) (#;Some $Object) (list)))
+
+(def: adt-methods
+  $;Def
+  (let [store-tagI (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE)
+        store-flagI (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
+        store-valueI (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)
+        force-textMT ($t;method (list $Object) (#;Some $String) (list))]
+    (|>. ($d;method #$;Public $;staticM "force_text" force-textMT
+                    (<| $i;with-label (function [@is-null])
+                        $i;with-label (function [@normal-object])
+                        $i;with-label (function [@array-loop])
+                        $i;with-label (function [@within-bounds])
+                        $i;with-label (function [@is-first])
+                        $i;with-label (function [@elem-end])
+                        $i;with-label (function [@fold-end])
+                        (let [on-normal-objectI (|>. ($i;ALOAD +0)
+                                                     ($i;INVOKEVIRTUAL "java.lang.Object" "toString" ($t;method (list) (#;Some $String) (list)) false))
+                              on-null-objectI ($i;string "NULL")
+                              arrayI (|>. ($i;ALOAD +0)
+                                          ($i;CHECKCAST ($t;descriptor $Object-Array)))
+                              recurseI ($i;INVOKESTATIC hostL;runtime-class "force_text" force-textMT false)
+                              force-elemI (|>. $i;DUP arrayI $i;SWAP $i;AALOAD recurseI)
+                              swap2 (|>. $i;DUP2_X2 ## X,Y => Y,X,Y
+                                         $i;POP2 ## Y,X,Y => Y,X
+                                         )
+                              add-spacingI (|>. ($i;string ", ") $i;SWAP string-concatI)
+                              merge-with-totalI (|>. $i;DUP_X2 $i;POP ## TSIP => TPSI
+                                                     swap2 ## TPSI => SITP
+                                                     string-concatI ## SITP => SIT
+                                                     $i;DUP_X2 $i;POP ## SIT => TSI
+                                                     )
+                              foldI (|>. $i;DUP ## TSI => TSII
+                                         ($i;IFEQ @is-first) ## TSI
+                                         force-elemI add-spacingI merge-with-totalI ($i;GOTO @elem-end)
+                                         ($i;label @is-first) ## TSI
+                                         force-elemI merge-with-totalI
+                                         ($i;label @elem-end) ## TSI
+                                         )
+                              inc-idxI (|>. ($i;int 1) $i;IADD)
+                              on-array-objectI (|>. ($i;string "[") ## T
+                                                    arrayI $i;ARRAYLENGTH ## TS
+                                                    ($i;int 0) ## TSI
+                                                    ($i;label @array-loop) ## TSI
+                                                    $i;DUP2
+                                                    ($i;IF_ICMPGT @within-bounds) ## TSI
+                                                    $i;POP2 ($i;string "]") string-concatI ($i;GOTO @fold-end)
+                                                    ($i;label @within-bounds)
+                                                    foldI inc-idxI ($i;GOTO @array-loop)
+                                                    ($i;label @fold-end))])
+                        (|>. ($i;ALOAD +0)
+                             ($i;IFNULL @is-null)
+                             ($i;ALOAD +0)
+                             ($i;INSTANCEOF ($t;descriptor $Object-Array))
+                             ($i;IFEQ @normal-object)
+                             on-array-objectI $i;ARETURN
+                             ($i;label @normal-object) on-normal-objectI $i;ARETURN
+                             ($i;label @is-null) on-null-objectI $i;ARETURN)))
+         ($d;method #$;Public $;staticM "variant_make"
+                    ($t;method (list $t;int $Object $Object)
+                               (#;Some $Variant)
+                               (list))
+                    (|>. ($i;int 3)
+                         ($i;array $Object)
+                         store-tagI
+                         store-flagI
+                         store-valueI
+                         $i;ARETURN)))))
+
+(def: #export force-textI
+  $;Inst
+  ($i;INVOKESTATIC hostL;runtime-class "force_text" ($t;method (list $Object) (#;Some $String) (list)) false))
+
+(def: nat-methods
+  $;Def
+  (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
+        less-thanI (function [@where] (|>. ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false) ($i;IFLT @where)))
+        $BigInteger ($t;class "java.math.BigInteger" (list))
+        upcast-method ($t;method (list $t;long) (#;Some $BigInteger) (list))
+        div-method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))
+        upcastI ($i;INVOKESTATIC hostL;runtime-class "_toUnsignedBigInteger" upcast-method false)
+        downcastI ($i;INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t;method (list) (#;Some $t;long) (list)) false)]
+    ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
+    (|>. ($d;method #$;Public $;staticM "_toUnsignedBigInteger" upcast-method
+                    (let [upcastI ($i;INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
+                          discernI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGE @where)))
+                          prepare-upperI (|>. ($i;LLOAD +0) ($i;int 32) $i;LUSHR
+                                              upcastI
+                                              ($i;int 32) ($i;INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t;method (list $t;int) (#;Some $BigInteger) (list)) false))
+                          prepare-lowerI (|>. ($i;LLOAD +0) ($i;int 32) $i;LSHL
+                                              ($i;int 32)   $i;LUSHR
+                                              upcastI)]
+                      (<| $i;with-label (function [@simple])
+                          (|>. (discernI @simple)
+                               ## else
+                               prepare-upperI
+                               prepare-lowerI
+                               ($i;INVOKEVIRTUAL "java.math.BigInteger" "add" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)
+                               $i;ARETURN
+                               ## then
+                               ($i;label @simple)
+                               ($i;LLOAD +0)
+                               upcastI
+                               $i;ARETURN))))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267
+         ($d;method #$;Public $;staticM "compare_nat" compare-nat-method
+                    (let [shiftI (|>. ($i;GETSTATIC "java.lang.Long" "MIN_VALUE" $t;long) $i;LADD)]
+                      (|>. ($i;LLOAD +0) shiftI
+                           ($i;LLOAD +2) shiftI
+                           $i;LCMP
+                           $i;IRETURN)))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290
+         ($d;method #$;Public $;staticM "div_nat" div-method
+                    (let [is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLT @where)))
+                          is-subject-smallI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGT @where)))
+                          small-division (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LDIV $i;LRETURN)
+                          big-divisionI ($i;INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
+                      (<| $i;with-label (function [@is-zero])
+                          $i;with-label (function [@param-is-large])
+                          $i;with-label (function [@subject-is-small])
+                          (|>. (is-param-largeI @param-is-large)
+                               ## Param is not too large
+                               (is-subject-smallI @subject-is-small)
+                               ## Param is small, but subject is large
+                               ($i;LLOAD +0) upcastI
+                               ($i;LLOAD +2) upcastI
+                               big-divisionI downcastI $i;LRETURN
+                               ## Both param and subject are small,
+                               ## and can thus be divided normally.
+                               ($i;label @subject-is-small)
+                               small-division
+                               ## Param is too large. Cannot simply divide.
+                               ## Depending on the result of the
+                               ## comparison, a result will be determined.
+                               ($i;label @param-is-large)
+                               ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @is-zero)
+                               ## Greater-than or equals
+                               ($i;long 1) $i;LRETURN
+                               ## Less than
+                               ($i;label @is-zero)
+                               ($i;long 0) $i;LRETURN))))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323
+         ($d;method #$;Public $;staticM "rem_nat" div-method
+                    (let [is-subject-largeI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFLE @where)))
+                          is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLE @where)))
+                          small-remainderI (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LREM $i;LRETURN)
+                          big-remainderI ($i;INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
+                      (<| $i;with-label (function [@large-number])
+                          $i;with-label (function [@subject-is-smaller-than-param])
+                          (|>. (is-subject-largeI @large-number)
+                               (is-param-largeI @large-number)
+                               small-remainderI
+
+                               ($i;label @large-number)
+                               ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @subject-is-smaller-than-param)
+                               
+                               ($i;LLOAD +0) upcastI
+                               ($i;LLOAD +2) upcastI
+                               big-remainderI downcastI $i;LRETURN
+                               
+                               ($i;label @subject-is-smaller-than-param)
+                               ($i;LLOAD +0)
+                               $i;LRETURN))))
+         )))
+
+(def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0)))
+
+(def: frac-methods
+  $;Def
+  (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list))
+                  (<| $i;with-label (function [@from])
+                      $i;with-label (function [@to])
+                      $i;with-label (function [@handler])
+                      (|>. ($i;try @from @to @handler "java.lang.Exception")
+                           ($i;label @from)
+                           ($i;ALOAD +0)
+                           ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false)
+                           ($i;wrap #$;Double)
+                           someI
+                           $i;ARETURN
+                           ($i;label @to)
+                           ($i;label @handler)
+                           noneI
+                           $i;ARETURN)))
+       ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list))
+                  (let [swap2 (|>. $i;DUP2_X2 $i;POP2)
+                        drop-excessI (|>. ($i;double 1.0) $i;DREM)
+                        shiftI (|>. frac-shiftI $i;DMUL)]
+                    (|>. ($i;DLOAD +0)
+                         ## Get upper half
+                         drop-excessI
+                         shiftI
+                         ## Make a copy, so the lower half can be extracted
+                         $i;DUP2
+                         ## Get lower half
+                         drop-excessI
+                         shiftI
+                         ## Turn it into a deg
+                         $i;D2L
+                         ## Turn the upper half into deg too
+                         swap2
+                         $i;D2L
+                         ## Combine both pieces
+                         $i;LADD
+                         ## FINISH
+                         $i;LRETURN
+                         )))
+       ))
+
+(def: deg-bits Nat +64)
+(def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list)))
+(def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list)))
+
+(def: deg-methods
+  $;Def
+  (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits.
+        low-half (|>. ($i;int -1) $i;I2L $i;LAND)
+        high-half (|>. ($i;int 32) $i;LUSHR)]
+    (|>. ($d;method #$;Public $;staticM "mul_deg" deg-method
+                    ## Based on: http://stackoverflow.com/a/31629280/6823464
+                    (let [shift-downI (|>. ($i;int 32) $i;LUSHR)
+                          low-leftI (|>. ($i;LLOAD +0) low-half)
+                          high-leftI (|>. ($i;LLOAD +0) high-half)
+                          low-rightI (|>. ($i;LLOAD +2) low-half)
+                          high-rightI (|>. ($i;LLOAD +2) high-half)
+                          bottomI (|>. low-leftI low-rightI $i;LMUL)
+                          middleLI (|>. high-leftI low-rightI $i;LMUL)
+                          middleRI (|>. low-leftI high-rightI $i;LMUL)
+                          middleI (|>. middleLI middleRI $i;LADD)
+                          topI (|>. high-leftI high-rightI $i;LMUL)]
+                      (|>. bottomI shift-downI
+                           middleI $i;LADD shift-downI
+                           topI $i;LADD
+                           $i;LRETURN)))
+         ($d;method #$;Public $;staticM "count_leading_zeros" clz-method
+                    (let [when-zeroI (function [@where] (|>. ($i;long 0) $i;LCMP ($i;IFEQ @where)))
+                          shift-rightI (function [amount] (|>. ($i;int amount) $i;LUSHR))
+                          decI (|>. ($i;int 1) $i;ISUB)]
+                      (<| $i;with-label (function [@start])
+                          $i;with-label (function [@done])
+                          (|>. ($i;int 64)
+                               ($i;label @start)
+                               ($i;LLOAD +0) (when-zeroI @done)
+                               ($i;LLOAD +0) (shift-rightI 1) ($i;LSTORE +0)
+                               decI
+                               ($i;GOTO @start)
+                               ($i;label @done)
+                               $i;IRETURN))))
+         ($d;method #$;Public $;staticM "div_deg" deg-method
+                    (<| $i;with-label (function [@same])
+                        (let [subjectI ($i;LLOAD +0)
+                              paramI ($i;LLOAD +2)
+                              equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where)))
+                              count-leading-zerosI ($i;INVOKESTATIC hostL;runtime-class "count_leading_zeros" clz-method false)
+                              calc-max-shiftI (|>. subjectI count-leading-zerosI
+                                                   paramI count-leading-zerosI
+                                                   ($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false)
+                                                   ($i;ISTORE +4))
+                              shiftI (|>. ($i;ILOAD +4) $i;LSHL)
+                              imprecise-divisionI (|>. subjectI shiftI
+                                                       paramI shiftI high-half
+                                                       $i;LDIV)
+                              scale-downI (|>. ($i;int 32) $i;LSHL)]
+                          (|>. subjectI paramI
+                               (equal?I @same)
+                               ## Based on: http://stackoverflow.com/a/8510587/6823464
+                               ## Shifting the operands as much as possible can help
+                               ## avoid some loss of precision later.
+                               calc-max-shiftI
+                               imprecise-divisionI
+                               scale-downI
+                               $i;LRETURN
+                               ($i;label @same)
+                               ($i;long -1) ## ~= 1.0 Degrees
+                               $i;LRETURN))))
+         ($d;method #$;Public $;staticM "deg_to_frac" ($t;method (list $t;long) (#;Some $t;double) (list))
+                    (let [highI (|>. ($i;LLOAD +0) high-half $i;L2D)
+                          lowI (|>. ($i;LLOAD +0) low-half $i;L2D)
+                          scaleI (|>. frac-shiftI $i;DDIV)]
+                      (|>. highI scaleI
+                           lowI scaleI scaleI
+                           $i;DADD
+                           $i;DRETURN)))
+         )))
+
+(def: pm-methods
+  $;Def
+  (let [tuple-sizeI (|>. ($i;ALOAD +0) $i;ARRAYLENGTH)
+        tuple-elemI (|>. ($i;ALOAD +0) ($i;ILOAD +1) $i;AALOAD)
+        expected-last-sizeI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD)
+        tuple-tailI (|>. ($i;ALOAD +0) tuple-sizeI ($i;int 1) $i;ISUB $i;AALOAD ($i;CHECKCAST ($t;descriptor $Tuple)))]
+    (|>. ($d;method #$;Public $;staticM "pm_fail" ($t;method (list) #;None (list))
+                    (|>. ($i;NEW "java.lang.IllegalStateException")
+                         $i;DUP
+                         ($i;string "Invalid expression for pattern-matching.")
+                         ($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
+                         $i;ATHROW))
+         ($d;method #$;Public $;staticM "apply_fail" ($t;method (list) #;None (list))
+                    (|>. ($i;NEW "java.lang.IllegalStateException")
+                         $i;DUP
+                         ($i;string "Error while applying function.")
+                         ($i;INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t;method (list $String) #;None (list)) false)
+                         $i;ATHROW))
+         ($d;method #$;Public $;staticM "pm_push" ($t;method (list $Stack $Object) (#;Some $Stack) (list))
+                    (|>. ($i;int 2)
+                         ($i;ANEWARRAY "java.lang.Object")
+                         $i;DUP
+                         ($i;int 0)
+                         ($i;ALOAD +0)
+                         $i;AASTORE
+                         $i;DUP
+                         ($i;int 1)
+                         ($i;ALOAD +1)
+                         $i;AASTORE
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_pop" ($t;method (list $Stack) (#;Some $Stack) (list))
+                    (|>. ($i;ALOAD +0)
+                         ($i;int 0)
+                         $i;AALOAD
+                         ($i;CHECKCAST ($t;descriptor $Stack))
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_peek" ($t;method (list $Stack) (#;Some $Object) (list))
+                    (|>. ($i;ALOAD +0)
+                         ($i;int 1)
+                         $i;AALOAD
+                         $i;ARETURN))
+         ($d;method #$;Public $;staticM "pm_variant" ($t;method (list $Variant $Tag $Flag) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@just-return])
+                        $i;with-label (function [@then])
+                        $i;with-label (function [@further])
+                        $i;with-label (function [@shorten])
+                        $i;with-label (function [@wrong])
+                        (let [variant-partI (: (-> Nat $;Inst)
+                                               (function [idx]
+                                                 (|>. ($i;int (nat-to-int idx)) $i;AALOAD)))
+                              tagI (: $;Inst
+                                      (|>. (variant-partI +0) ($i;unwrap #$;Int)))
+                              flagI (variant-partI +1)
+                              datumI (variant-partI +2)
+                              shortenI (|>. ($i;ALOAD +0) tagI ## Get tag
+                                            ($i;ILOAD +1) $i;ISUB ## Shorten tag
+                                            ($i;ALOAD +0) flagI ## Get flag
+                                            ($i;ALOAD +0) datumI ## Get value
+                                            variantI ## Build sum
+                                            $i;ARETURN)
+                              update-tagI (|>. $i;ISUB ($i;ISTORE +1))
+                              update-variantI (|>. ($i;ALOAD +0) datumI ($i;CHECKCAST ($t;descriptor $Variant)) ($i;ASTORE +0))
+                              wrongI (|>. $i;NULL $i;ARETURN)
+                              return-datumI (|>. ($i;ALOAD +0) datumI $i;ARETURN)])
+                        (|>. ($i;label @begin)
+                             ($i;ILOAD +1) ## tag
+                             ($i;ALOAD +0) tagI ## tag, sumT
+                             $i;DUP2 ($i;IF_ICMPEQ @then)
+                             $i;DUP2 ($i;IF_ICMPGT @further)
+                             $i;DUP2 ($i;IF_ICMPLT @shorten)
+                             ## $i;POP2
+                             wrongI
+                             ($i;label @then) ## tag, sumT
+                             ($i;ALOAD +2) ## tag, sumT, wants-last?
+                             ($i;ALOAD +0) flagI ## tag, sumT, wants-last?, is-last?
+                             ($i;IF_ACMPEQ @just-return) ## tag, sumT
+                             ($i;label @further) ## tag, sumT
+                             ($i;ALOAD +0) flagI ## tag, sumT, last?
+                             ($i;IFNULL @wrong) ## tag, sumT
+                             update-tagI
+                             update-variantI
+                             ($i;GOTO @begin)
+                             ($i;label @just-return) ## tag, sumT
+                             ## $i;POP2
+                             return-datumI
+                             ($i;label @shorten) ## tag, sumT
+                             ($i;ALOAD +2) ($i;IFNULL @wrong)
+                             ## $i;POP2
+                             shortenI
+                             ($i;label @wrong) ## tag, sumT
+                             ## $i;POP2
+                             wrongI)))
+         ($d;method #$;Public $;staticM "pm_left" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@not-recursive])
+                        (let [updated-idxI (|>. $i;SWAP $i;ISUB)])
+                        (|>. ($i;label @begin)
+                             tuple-sizeI
+                             expected-last-sizeI
+                             $i;DUP2 ($i;IF_ICMPGT @not-recursive)
+                             ## Recursive
+                             updated-idxI ($i;ISTORE +1)
+                             tuple-tailI ($i;ASTORE +0)
+                             ($i;GOTO @begin)
+                             ($i;label @not-recursive)
+                             ## $i;POP2
+                             tuple-elemI
+                             $i;ARETURN)))
+         ($d;method #$;Public $;staticM "pm_right" ($t;method (list $Tuple $t;int) (#;Some $Object) (list))
+                    (<| $i;with-label (function [@begin])
+                        $i;with-label (function [@tail])
+                        $i;with-label (function [@slice])
+                        (let [updated-idxI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD tuple-sizeI $i;ISUB)
+                              sliceI (|>. ($i;ALOAD +0) ($i;ILOAD +1) tuple-sizeI
+                                          ($i;INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t;method (list $Object-Array $t;int $t;int) (#;Some $Object-Array) (list)) false))])
+                        (|>. ($i;label @begin)
+                             tuple-sizeI
+                             expected-last-sizeI
+                             $i;DUP2 ($i;IF_ICMPEQ @tail)
+                             ($i;IF_ICMPGT @slice)
+                             ## Must recurse
+                             tuple-tailI ($i;ASTORE +0)
+                             updated-idxI ($i;ISTORE +1)
+                             ($i;GOTO @begin)
+                             ($i;label @slice)
+                             sliceI
+                             $i;ARETURN
+                             ($i;label @tail)
+                             ## $i;POP2
+                             tuple-elemI
+                             $i;ARETURN)))
+         )))
+
+(def: io-methods
+  $;Def
+  (let [string-writerI (|>. ($i;NEW "java.io.StringWriter")
+                            $i;DUP
+                            ($i;INVOKESPECIAL "java.io.StringWriter" "<init>" ($t;method (list) #;None (list)) false))
+        print-writerI (|>. ($i;NEW "java.io.PrintWriter")
+                           $i;SWAP
+                           $i;DUP2
+                           $i;POP
+                           $i;SWAP
+                           ($i;boolean true)
+                           ($i;INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t;method (list ($t;class "java.io.Writer" (list)) $t;boolean) #;None (list)) false)
+                           )]
+    (|>. ($d;method #$;Public $;staticM "try" ($t;method (list $Function) (#;Some $Variant) (list))
+                    (<| $i;with-label (function [@from])
+                        $i;with-label (function [@to])
+                        $i;with-label (function [@handler])
+                        (|>. ($i;try @from @to @handler "java.lang.Throwable")
+                             ($i;label @from)
+                             ($i;ALOAD +0)
+                             $i;NULL
+                             ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
+                             rightI
+                             $i;ARETURN
+                             ($i;label @to)
+                             ($i;label @handler)
+                             string-writerI ## TW
+                             $i;DUP2 ## TWTW
+                             print-writerI ## TWTP
+                             ($i;INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t;method (list ($t;class "java.io.PrintWriter" (list))) #;None (list)) false) ## TW
+                             ($i;INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t;method (list) (#;Some $String) (list)) false) ## TS
+                             $i;SWAP $i;POP leftI
+                             $i;ARETURN)))
+         )))
+
+(def: generate-runtime
+  (Meta commonT;Bytecode)
+  (do meta;Monad<Meta>
+    [_ (wrap [])
+     #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC hostL;runtime-class (list) ["java.lang.Object" (list)] (list)
+                              (|>. adt-methods
+                                   nat-methods
+                                   frac-methods
+                                   deg-methods
+                                   pm-methods
+                                   io-methods))]
+     _ (commonT;store-class hostL;runtime-class bytecode)]
+    (wrap bytecode)))
+
+(def: generate-function
+  (Meta commonT;Bytecode)
+  (do meta;Monad<Meta>
+    [_ (wrap [])
+     #let [applyI (|> (list;n.range +2 num-apply-variants)
+                      (list/map (function [arity]
+                                  ($d;method #$;Public $;noneM apply-method (apply-signature arity)
+                                             (let [preI (|> (list;n.range +0 (n.dec arity))
+                                                            (list/map $i;ALOAD)
+                                                            $i;fuse)]
+                                               (|>. preI
+                                                    ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature (n.dec arity)) false)
+                                                    ($i;CHECKCAST hostL;function-class)
+                                                    ($i;ALOAD arity)
+                                                    ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false)
+                                                    $i;ARETURN)))))
+                      (list& ($d;abstract-method #$;Public $;noneM apply-method (apply-signature +1)))
+                      $d;fuse)
+           bytecode ($d;abstract #$;V1.6 #$;Public $;noneC hostL;function-class (list) ["java.lang.Object" (list)] (list)
+                                 (|>. ($d;field #$;Public $;finalF partials-field $t;int)
+                                      ($d;method #$;Public $;noneM "<init>" ($t;method (list $t;int) #;None (list))
+                                                 (|>. ($i;ALOAD +0)
+                                                      ($i;INVOKESPECIAL "java.lang.Object" "<init>" ($t;method (list) #;None (list)) false)
+                                                      ($i;ALOAD +0)
+                                                      ($i;ILOAD +1)
+                                                      ($i;PUTFIELD hostL;function-class partials-field $t;int)
+                                                      $i;RETURN))
+                                      applyI))]
+     _ (commonT;store-class hostL;function-class bytecode)]
+    (wrap bytecode)))
+
+(def: #export generate
+  (Meta [commonT;Bytecode commonT;Bytecode])
+  (do meta;Monad<Meta>
+    [runtime-bc generate-runtime
+     function-bc generate-function]
+    (wrap [runtime-bc function-bc])))
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
new file mode 100644
index 000000000..0234d738c
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -0,0 +1,82 @@
+(;module:
+  lux
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [maybe]
+             [text "text/" Monoid<Text>]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [meta]
+       [host])
+  (luxc ["&" base]
+        ["&;" scope]
+        ["&;" module]
+        ["&;" io]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang (translation [";T" eval]
+                           [";T" common]))))
+
+(exception: #export Invalid-Definition-Value)
+
+(host;import java.lang.Object
+  (toString [] String))
+
+(host;import java.lang.reflect.Field
+  (get [#? Object] #try #? Object))
+
+(host;import (java.lang.Class c)
+  (getField [String] #try Field))
+
+(def: #export (generate-def def-name valueT valueI metaI metaV)
+  (-> Text Type $;Inst $;Inst Code (Meta Unit))
+  (do meta;Monad<Meta>
+    [current-module meta;current-module-name
+     #let [def-ident [current-module def-name]
+           normal-name (&;normalize-name def-name)
+           bytecode-name (format current-module "/" normal-name)
+           class-name (format current-module "." normal-name)
+           bytecode ($d;class #$;V1.6
+                              #$;Public $;finalC
+                              bytecode-name
+                              (list) ["java.lang.Object" (list)]
+                              (list)
+                              (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) commonT;value-field commonT;$Object)
+                                   ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
+                                              (|>. valueI
+                                                   ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object)
+                                                   $i;RETURN))))]
+     _ (commonT;store-class class-name bytecode)
+     class (commonT;load-class class-name)
+     valueV (: (Meta Top)
+               (case (do e;Monad<Error>
+                       [field (Class.getField [commonT;value-field] class)]
+                       (Field.get [#;None] field))
+                 (#e;Success #;None)
+                 (&;throw Invalid-Definition-Value (format current-module ";" def-name))
+                 
+                 (#e;Success (#;Some valueV))
+                 (wrap valueV)
+                 
+                 (#e;Error error)
+                 (&;fail error)))
+     _ (&module;define [current-module def-name] [valueT metaV valueV])
+     _ (if (meta;type? metaV)
+         (case (meta;declared-tags metaV)
+           #;Nil
+           (wrap [])
+
+           tags
+           (&module;declare-tags tags (meta;export? metaV) (:! Type valueV)))
+         (wrap []))
+     #let [_ (log! (format "DEF " current-module ";" def-name))]]
+    (commonT;record-artifact bytecode-name bytecode)))
+
+(def: #export (generate-program program-args programI)
+  (-> Text $;Inst (Meta Unit))
+  (do meta;Monad<Meta>
+    []
+    (&;fail "'lux program' is unimplemented.")))
diff --git a/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
new file mode 100644
index 000000000..c3e07fd55
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -0,0 +1,59 @@
+(;module:
+  lux
+  (lux (control [monad #+ do])
+       (data text/format
+             (coll [list]))
+       [meta]
+       [host #+ do-to])
+  (luxc ["&" base]
+        [";L" host]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang ["la" analysis]
+              ["ls" synthesis]
+              (translation [";T" common])))
+  [../runtime])
+
+(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+
+(def: #export (generate-tuple generate members)
+  (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [#let [size (list;size members)]
+     _ (&;assert "Cannot generate tuples with less than 2 elements."
+                 (n.>= +2 size))
+     membersI (|> members
+                  list;enumerate
+                  (monad;map @ (function [[idx member]]
+                                 (do @
+                                   [memberI (generate member)]
+                                   (wrap (|>. $i;DUP
+                                              ($i;int (nat-to-int idx))
+                                              memberI
+                                              $i;AASTORE)))))
+                  (:: @ map $i;fuse))]
+    (wrap (|>. ($i;int (nat-to-int size))
+               ($i;array $Object)
+               membersI))))
+
+(def: (flagI tail?)
+  (-> Bool $;Inst)
+  (if tail?
+    ($i;string "")
+    $i;NULL))
+
+(def: #export (generate-variant generate tag tail? member)
+  (-> (-> ls;Synthesis (Meta $;Inst)) Nat Bool ls;Synthesis (Meta $;Inst))
+  (do meta;Monad<Meta>
+    [memberI (generate member)]
+    (wrap (|>. ($i;int (nat-to-int tag))
+               (flagI tail?)
+               memberI
+               ($i;INVOKESTATIC hostL;runtime-class
+                                "variant_make"
+                                ($t;method (list $t;int $Object $Object)
+                                           (#;Some ($t;array +1 $Object))
+                                           (list))
+                                false)))))
author	Eduardo Julian	2017-11-01 00:51:45 -0400
committer	Eduardo Julian	2017-11-01 00:51:45 -0400
commit	012f6bd41e527479dddbccbdab10daa78fd9a0fd (patch)
tree	621f344a09acd52736f343d94582b3f1a2f0c5f9 /new-luxc/source/luxc/lang
parent	71d7a4c7206155e09f3e1e1d8699561ea6967382 (diff)