- Tested the compilation for "nat" procedures.

- Expanded the runtime.
- Some bug-fixes and refactorings.

6 files changed, 303 insertions, 200 deletions

diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux
index e96874960..1976d266d 100644
--- a/new-luxc/source/luxc/analyser/procedure/common.lux
+++ b/new-luxc/source/luxc/analyser/procedure/common.lux
@@ -15,15 +15,15 @@
         (analyser ["&;" common])))
 
 ## [Utils]
-(type: Proc-Analyser
+(type: Proc
   (-> &;Analyser (List Code) (Lux Analysis)))
 
-(type: Proc-Set
-  (D;Dict Text Proc-Analyser))
+(type: Bundle
+  (D;Dict Text Proc))
 
 (def: (install name unnamed)
-  (-> Text (-> Text Proc-Analyser)
-      (-> Proc-Set Proc-Set))
+  (-> Text (-> Text Proc)
+      (-> Bundle Bundle))
   (D;put name (unnamed name)))
 
 (def: (wrong-amount-error proc expected actual)
@@ -33,7 +33,7 @@
           "  Actual: " (|> actual nat-to-int %i)))
 
 (def: (simple-proc proc input-types output-type)
-  (-> Text (List Type) Type Proc-Analyser)
+  (-> Text (List Type) Type Proc)
   (let [num-expected (list;size input-types)]
     (function [analyse args]
       (let [num-actual (list;size args)]
@@ -51,29 +51,29 @@
           (&;fail (wrong-amount-error proc num-expected num-actual)))))))
 
 (def: (binary-operation subjectT paramT outputT proc)
-  (-> Type Type Type Text Proc-Analyser)
+  (-> Type Type Type Text Proc)
   (simple-proc proc (list subjectT paramT) outputT))
 
 (def: (trinary-operation subjectT param0T param1T outputT proc)
-  (-> Type Type Type Type Text Proc-Analyser)
+  (-> Type Type Type Type Text Proc)
   (simple-proc proc (list subjectT param0T param1T) outputT))
 
 (def: (unary-operation inputT outputT proc)
-  (-> Type Type Text Proc-Analyser)
+  (-> Type Type Text Proc)
   (simple-proc proc (list inputT) outputT))
 
 (def: (special-value valueT proc)
-  (-> Type Text Proc-Analyser)
+  (-> Type Text Proc)
   (simple-proc proc (list) valueT))
 
 (def: (converter fromT toT proc)
-  (-> Type Type Text Proc-Analyser)
+  (-> Type Type Text Proc)
   (simple-proc proc (list fromT) toT))
 
 ## [Analysers]
 ## "lux is" represents reference/pointer equality.
 (def: (analyse-lux-is proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -83,7 +83,7 @@
 ## "lux try" provides a simple way to interact with the host platform's
 ## error-handling facilities.
 (def: (analyse-lux-try proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -103,13 +103,13 @@
           (&;fail (wrong-amount-error proc +1 (list;size args))))))))
 
 (def: lux-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "lux is" analyse-lux-is)
       (install "lux try" analyse-lux-try)))
 
 (def: io-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "io log" (converter Text Unit))
       (install "io error" (converter Text Bottom))
@@ -117,7 +117,7 @@
       (install "io current-time" (special-value Int))))
 
 (def: bit-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "bit count" (unary-operation Nat Nat))
       (install "bit and" (binary-operation Nat Nat Nat))
@@ -129,7 +129,7 @@
       ))
 
 (def: nat-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "nat +" (binary-operation Nat Nat Nat))
       (install "nat -" (binary-operation Nat Nat Nat))
@@ -144,7 +144,7 @@
       (install "nat to-text" (converter Nat Text))))
 
 (def: int-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "int +" (binary-operation Int Int Int))
       (install "int -" (binary-operation Int Int Int))
@@ -159,7 +159,7 @@
       (install "int to-real" (converter Int Real))))
 
 (def: deg-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "deg +" (binary-operation Deg Deg Deg))
       (install "deg -" (binary-operation Deg Deg Deg))
@@ -175,7 +175,7 @@
       (install "deg to-real" (converter Deg Real))))
 
 (def: real-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "real +" (binary-operation Real Real Real))
       (install "real -" (binary-operation Real Real Real))
@@ -196,7 +196,7 @@
       (install "real from-text" (converter Text (type (Maybe Real))))))
 
 (def: text-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "text =" (binary-operation Text Text Bool))
       (install "text <" (binary-operation Text Text Bool))
@@ -210,7 +210,7 @@
       ))
 
 (def: (analyse-array-get proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -218,7 +218,7 @@
          analyse args)))))
 
 (def: (analyse-array-put proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -226,7 +226,7 @@
          analyse args)))))
 
 (def: (analyse-array-remove proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -234,7 +234,7 @@
          analyse args)))))
 
 (def: array-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "array new" (unary-operation Nat Array))
       (install "array get" analyse-array-get)
@@ -244,7 +244,7 @@
       ))
 
 (def: math-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "math cos" (unary-operation Real Real))
       (install "math sin" (unary-operation Real Real))
@@ -267,7 +267,7 @@
       ))
 
 (def: (analyse-atom-new proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -287,7 +287,7 @@
           (&;fail (wrong-amount-error proc +1 (list;size args))))))))
 
 (def: (analyse-atom-read proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -295,7 +295,7 @@
          analyse args)))))
 
 (def: (analyse-atom-compare-and-swap proc)
-  (-> Text Proc-Analyser)
+  (-> Text Proc)
   (function [analyse args]
     (&common;with-var
       (function [[var-id varT]]
@@ -303,7 +303,7 @@
          analyse args)))))
 
 (def: atom-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "atom new" analyse-atom-new)
       (install "atom read" analyse-atom-read)
@@ -311,7 +311,7 @@
       ))
 
 (def: process-procs
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (install "process concurrency-level" (special-value Nat))
       (install "process future" (unary-operation (type (io;IO Top)) Unit))
@@ -319,7 +319,7 @@
       ))
 
 (def: #export procedures
-  Proc-Set
+  Bundle
   (|> (D;new text;Hash<Text>)
       (D;merge lux-procs)
       (D;merge bit-procs)
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 6f0f97d9b..42cfa2d68 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -2,6 +2,7 @@
   lux
   (lux (data [text]
              text/format
+             [product]
              (coll ["a" array]
                    [list "L/" Functor<List>]))
        [host #+ jvm-import do-to])
@@ -154,11 +155,11 @@
                                                 <flag>
                                                 (visibility-flag visibility)
                                                 (class-flag config))
-                                            name
+                                            ($t;binary-name name)
                                             (parameters-signature parameters super interfaces)
-                                            (|> super class-to-type $t;descriptor)
+                                            (|> super product;left $t;binary-name)
                                             (|> interfaces
-                                                (L/map (|>. class-to-type $t;descriptor))
+                                                (L/map (|>. product;left $t;binary-name))
                                                 string-array)]))
                       definitions)
            _ (ClassWriter.visitEnd [] writer)]
@@ -181,11 +182,11 @@
                                              Opcodes.ACC_INTERFACE
                                              (visibility-flag visibility)
                                              (class-flag config))
-                                         name
+                                         ($t;binary-name name)
                                          (parameters-signature parameters $Object interfaces)
-                                         (|> $Object class-to-type $t;descriptor)
+                                         (|> $Object product;left $t;binary-name)
                                          (|> interfaces
-                                             (L/map (|>. class-to-type $t;descriptor))
+                                             (L/map (|>. product;left $t;binary-name))
                                              string-array)]))
                    definitions)
         _ (ClassWriter.visitEnd [] writer)]
@@ -198,7 +199,7 @@
     (let [=method (ClassWriter.visitMethod [($_ i.+
                                                 (visibility-flag visibility)
                                                 (method-flag config))
-                                            name
+                                            ($t;binary-name name)
                                             ($t;method-descriptor type)
                                             ($t;method-signature type)
                                             (exceptions-array type)]
@@ -217,7 +218,7 @@
                                                 (visibility-flag visibility)
                                                 (method-flag config)
                                                 Opcodes.ACC_ABSTRACT)
-                                            name
+                                            ($t;binary-name name)
                                             ($t;method-descriptor type)
                                             ($t;method-signature type)
                                             (exceptions-array type)]
@@ -231,7 +232,10 @@
     (let [=field (do-to (ClassWriter.visitField [($_ i.+
                                                      (visibility-flag visibility)
                                                      (field-flag config))
-                                                 name ($t;descriptor type) ($t;signature type) (host;null)] writer)
+                                                 ($t;binary-name name)
+                                                 ($t;descriptor type)
+                                                 ($t;signature type)
+                                                 (host;null)] writer)
                    (FieldVisitor.visitEnd []))]
       writer)))
 
@@ -242,7 +246,9 @@
        (let [=field (do-to (ClassWriter.visitField [($_ i.+
                                                         (visibility-flag visibility)
                                                         (field-flag config))
-                                                    name ($t;descriptor <jvm-type>) ($t;signature <jvm-type>)
+                                                    ($t;binary-name name)
+                                                    ($t;descriptor <jvm-type>)
+                                                    ($t;signature <jvm-type>)
                                                     (<prepare> value)]
                                                    writer)
                       (FieldVisitor.visitEnd []))]
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 824598ab8..30148c4e5 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -1,6 +1,13 @@
 (;module:
   [lux #- char]
-  (lux [host #+ jvm-import do-to])
+  (lux (control monad
+                ["p" parser])
+       (data text/format
+             (coll [list "L/" Functor<List>]))
+       [host #+ jvm-import do-to]
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:]))
   ["$" ..]
   (.. ["$t" type]))
 
@@ -8,83 +15,85 @@
 (jvm-import #long java.lang.Object)
 (jvm-import #long java.lang.String)
 
-(jvm-import org.objectweb.asm.Opcodes
-  (#static T_BOOLEAN int)
-  (#static T_CHAR int)
-  (#static T_FLOAT int)
-  (#static T_DOUBLE int)
-  (#static T_BYTE int)
-  (#static T_SHORT int)
-  (#static T_INT int)
-  (#static T_LONG int)
-
-  (#static CHECKCAST int)
-  (#static NEW int)
-  (#static NEWARRAY int)
-  (#static ANEWARRAY int)
-  
-  (#static DUP int)
-  (#static DUP2_X1 int)
-  (#static POP int)
-  (#static POP2 int)
-
-  (#static IF_ICMPEQ int)
-  (#static IF_ACMPEQ int)
-  (#static IFNULL int)
-  (#static GOTO int)
-
-  (#static ACONST_NULL int)
-  
-  (#static ILOAD int)
-  (#static ALOAD int)
-
-  (#static IADD int)
-  
-  (#static LAND int)
-  (#static LOR int)
-  (#static LXOR int)
-  (#static LSHL int)
-  (#static LSHR int)
-  (#static LUSHR int)
-
-  (#static LADD int)
-  (#static LSUB int)
-  (#static LMUL int)
-  (#static LDIV int)
-  (#static LREM int)
-  (#static LCMP int)
-  
-  (#static DADD int)
-  (#static DSUB int)
-  (#static DMUL int)
-  (#static DDIV int)
-  (#static DREM int)
-  (#static DCMPG int)
-
-  (#static I2L int)
-  (#static L2I int)
-  (#static L2D int)
-  (#static D2L int)
-  (#static I2C int)
-
-  (#static AALOAD int)
-  (#static AASTORE int)
-  (#static ARRAYLENGTH int)
-  
-  (#static GETSTATIC int)
-  (#static PUTSTATIC int)
-  (#static GETFIELD int)
-  (#static PUTFIELD int)
-  
-  (#static INVOKESTATIC int)
-  (#static INVOKESPECIAL int)
-  (#static INVOKEVIRTUAL int)
-
-  (#static ATHROW int)
-
-  (#static RETURN int)
-  (#static ARETURN int)
-  )
+(syntax: (declare [codes (p;many s;local-symbol)])
+  (|> codes
+      (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
+      wrap))
+
+(with-expansions [<primitive> (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
+                                       T_BYTE T_SHORT T_INT T_LONG)
+                  <stack> (declare DUP DUP2_X1
+                                   POP POP2
+                                   SWAP)
+                  <jump> (declare IF_ICMPEQ IF_ACMPEQ IFNULL
+                                  IFLT IFLE IFGT IFGE
+                                  GOTO)]
+  (jvm-import org.objectweb.asm.Opcodes
+    <primitive>
+
+    (#static CHECKCAST int)
+    (#static NEW int)
+    (#static NEWARRAY int)
+    (#static ANEWARRAY int)
+    
+    <stack>
+    <jump>
+
+    (#static ACONST_NULL int)
+    
+    (#static ILOAD int)
+    (#static LLOAD int)
+    (#static ALOAD int)
+
+    (#static IADD int)
+    
+    (#static LAND int)
+    (#static LOR int)
+    (#static LXOR int)
+    (#static LSHL int)
+    (#static LSHR int)
+    (#static LUSHR int)
+
+    (#static LADD int)
+    (#static LSUB int)
+    (#static LMUL int)
+    (#static LDIV int)
+    (#static LREM int)
+    (#static LCMP int)
+    
+    (#static DADD int)
+    (#static DSUB int)
+    (#static DMUL int)
+    (#static DDIV int)
+    (#static DREM int)
+    (#static DCMPG int)
+
+    (#static I2L int)
+    (#static L2I int)
+    (#static L2D int)
+    (#static D2L int)
+    (#static I2C int)
+
+    (#static AALOAD int)
+    (#static AASTORE int)
+    (#static ARRAYLENGTH int)
+    
+    (#static GETSTATIC int)
+    (#static PUTSTATIC int)
+    (#static GETFIELD int)
+    (#static PUTFIELD int)
+    
+    (#static INVOKESTATIC int)
+    (#static INVOKESPECIAL int)
+    (#static INVOKEVIRTUAL int)
+
+    (#static ATHROW int)
+
+    (#static RETURN int)
+    (#static IRETURN int)
+    (#static LRETURN int)
+    (#static ARETURN int)
+    ))
 
 (jvm-import org.objectweb.asm.FieldVisitor
   (visitEnd [] void))
@@ -126,57 +135,48 @@
   [string  Text id]
   )
 
-(do-template [<name> <inst>]
+(syntax: (prefix [base s;local-symbol])
+  (wrap (list (code;local-symbol (format "Opcodes." base)))))
+
+(def: #export NULL
+  $;Inst
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
+
+(do-template [<name>]
   [(def: #export <name>
      $;Inst
      (function [visitor]
        (do-to visitor
-         (MethodVisitor.visitInsn [<inst>]))))]
+         (MethodVisitor.visitInsn [(prefix <name>)]))))]
 
-  [DUP         Opcodes.DUP]
-  [DUP2_X1     Opcodes.DUP2_X1]
-  [POP         Opcodes.POP]
-  [POP2        Opcodes.POP2]
+  ## Stack
+  [DUP] [DUP2_X1] [POP] [POP2] [SWAP]
 
-  [NULL        Opcodes.ACONST_NULL]
-  
-  [IADD        Opcodes.IADD]
-  
-  [LAND        Opcodes.LAND]
-  [LOR         Opcodes.LOR]
-  [LXOR        Opcodes.LXOR]
-  [LSHL        Opcodes.LSHL]
-  [LSHR        Opcodes.LSHR]
-  [LUSHR       Opcodes.LUSHR]
-
-  [LADD        Opcodes.LADD]
-  [LSUB        Opcodes.LSUB]
-  [LMUL        Opcodes.LMUL]
-  [LDIV        Opcodes.LDIV]
-  [LREM        Opcodes.LREM]
-  [LCMP        Opcodes.LCMP]
-  
-  [DADD        Opcodes.DADD]
-  [DSUB        Opcodes.DSUB]
-  [DMUL        Opcodes.DMUL]
-  [DDIV        Opcodes.DDIV]
-  [DREM        Opcodes.DREM]
-  [DCMPG       Opcodes.DCMPG]
-
-  [I2L         Opcodes.I2L]
-  [L2I         Opcodes.L2I]
-  [L2D         Opcodes.L2D]
-  [D2L         Opcodes.D2L]
-  [I2C         Opcodes.I2C]
-  
-  [AALOAD      Opcodes.AALOAD]
-  [AASTORE     Opcodes.AASTORE]
-  [ARRAYLENGTH Opcodes.ARRAYLENGTH]
+  ## Integer arithmetic
+  [IADD]
+
+  ## Long bitwise
+  [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
 
-  [ATHROW      Opcodes.ATHROW]
+  ## Long arithmethic
+  [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP]
 
-  [RETURN      Opcodes.RETURN]
-  [ARETURN     Opcodes.ARETURN]
+  ## Double arithmetic
+  [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DCMPG]
+
+  ## Conversions
+  [I2L] [L2I] [L2D] [D2L] [I2C]
+
+  ## Array
+  [AALOAD] [AASTORE] [ARRAYLENGTH]
+
+  ## Exceptions
+  [ATHROW]
+
+  ## Return
+  [RETURN] [IRETURN] [LRETURN] [ARETURN]
   )
 
 (do-template [<name> <inst>]
@@ -186,8 +186,9 @@
        (do-to visitor
          (MethodVisitor.visitVarInsn [<inst> (nat-to-int register)]))))]
 
-  [ALOAD Opcodes.ALOAD]
   [ILOAD Opcodes.ILOAD]
+  [LLOAD Opcodes.LLOAD]
+  [ALOAD Opcodes.ALOAD]
   )
 
 (do-template [<name> <inst>]
@@ -242,17 +243,16 @@
   [INVOKESPECIAL Opcodes.INVOKESPECIAL]
   )
 
-(do-template [<name> <inst>]
+(do-template [<name>]
   [(def: #export (<name> @where)
      (-> $;Label $;Inst)
      (function [visitor]
        (do-to visitor
-         (MethodVisitor.visitJumpInsn [<inst> @where]))))]
+         (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
 
-  [IF_ICMPEQ Opcodes.IF_ICMPEQ]
-  [IF_ACMPEQ Opcodes.IF_ACMPEQ]
-  [IFNULL    Opcodes.IFNULL]
-  [GOTO      Opcodes.GOTO]
+  [IF_ICMPEQ] [IF_ACMPEQ] [IFNULL]
+  [IFLT] [IFLE] [IFGT] [IFGE]
+  [GOTO]
   )
 
 (def: #export (label @label)
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index 957a2efa4..fcfba7682 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -172,7 +172,7 @@
 
 (def: (bit//count inputI)
   Unary
-  (|>. inputI
+  (|>. inputI $i;unwrap-long
        ($i;INVOKESTATIC "java.lang.Long" "bitCount" ($t;method (list $t;long) (#;Some $t;int) (list)) false)
        lux-intI))
 
@@ -231,7 +231,7 @@
 
 (def: deg-method $;Method nat-method)
 
-(def: compare-unsigned-method
+(def: compare-nat-method
   $;Method
   ($t;method (list $t;long $t;long) (#;Some $t;int) (list)))
 
@@ -305,8 +305,8 @@
           ($i;int <reference>)
           (predicateI $i;IF_ICMPEQ)))]
 
-  [nat//eq   0 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compareUnsigned" compare-unsigned-method false)]
-  [nat//lt  -1 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compareUnsigned" compare-unsigned-method false)]
+  [nat//eq   0 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compare_nat" compare-nat-method false)]
+  [nat//lt  -1 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compare_nat" compare-nat-method false)]
   
   [int//eq   0 $i;unwrap-long   $i;LCMP]
   [int//lt  -1 $i;unwrap-long   $i;LCMP]
@@ -314,8 +314,8 @@
   [real//eq  0 $i;unwrap-double $i;DCMPG]
   [real//lt -1 $i;unwrap-double $i;DCMPG]
 
-  [deg//eq   0 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compareUnsigned" compare-unsigned-method false)]
-  [deg//lt  -1 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compareUnsigned" compare-unsigned-method false)]
+  [deg//eq   0 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compare_nat" compare-nat-method false)]
+  [deg//lt  -1 $i;unwrap-long   ($i;INVOKESTATIC &runtime;runtime-name "compare_nat" compare-nat-method false)]
   )
 
 (do-template [<name> <prepare> <transform>]
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index 8c0b294c1..e6a12d6fa 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -39,20 +39,25 @@
   (visitEnd [] void)
   (toByteArray [] Byte-Array))
 
-(def: #export runtime-name Text "LuxRT")
+(def: #export runtime-name Text "LuxRuntime")
 (def: #export function-name Text "LuxFunction")
 (def: #export unit Text "\u0000")
 
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
 
+(def: 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: add-adt-methods
   $;Def
   (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) $i;wrap-int $i;AASTORE)
         store-flag (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
         store-value (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)]
-    (|>. ($d;method #$;Public
-                    {#$;staticM true #$;finalM false #$;synchronizedM false}
-                    "sum_make"
+    (|>. ($d;method #$;Public $;staticM "sum_make"
                     ($t;method (list $t;int $Object $Object)
                                (#;Some ($t;array +1 $Object))
                                (list))
@@ -62,16 +67,107 @@
                          store-value
                          $i;ARETURN)))))
 
+(def: add-nat-methods
+  $;Def
+  (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
+        less-thanI (function [@where] (|>. ($i;INVOKESTATIC runtime-name "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 runtime-name "_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: init-method $;Method ($t;method (list) #;None (list)))
+
 (def: #export generate
   (Lux &common;Bytecode)
   (do Monad<Lux>
     [_ (wrap [])
-     #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
-                        (ClassWriter.visit [&common;bytecode-version
-                                            ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_FINAL Opcodes.ACC_SUPER)
-                                            runtime-name (host;null)
-                                            "java/lang/Object" (host;null)]))
-                      add-adt-methods)
-           bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+     #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list)
+                              (|>. add-adt-methods
+                                   add-nat-methods
+                                   ))]
      _ (&common;store-class runtime-name bytecode)]
     (wrap bytecode)))
diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
index 37b62b30d..d5b4e89b0 100644
--- a/new-luxc/source/luxc/host.jvm.lux
+++ b/new-luxc/source/luxc/host.jvm.lux
@@ -57,25 +57,26 @@
                  ClassLoader::defineClass))
 
 (def: (fetch-byte-code class-name store)
-  (-> Text &&common;Class-Store &&common;Bytecode)
-  (|> store A;get io;run (d;get class-name) assume))
-
-(def: (assume!! input)
-  (All [a] (-> (R;Result a) a))
-  (case input
-    (#R;Success output)
-    output
-    
-    (#R;Error error)
-    (error! error)))
+  (-> Text &&common;Class-Store (Maybe &&common;Bytecode))
+  (|> store A;get io;run (d;get class-name)))
 
 (def: (memory-class-loader store)
   (-> &&common;Class-Store ClassLoader)
   (object ClassLoader []
     []
     (ClassLoader (findClass [class-name String]) Class
-                 (:!! (assume!! (define-class class-name (fetch-byte-code class-name store) (:! ClassLoader _jvm_this))))
-                 )))
+                 (case (fetch-byte-code class-name store)
+                   (#;Some bytecode)
+                   (case (define-class class-name bytecode (:! ClassLoader _jvm_this))
+                     (#R;Success class)
+                     (:!! class)
+
+                     (#R;Error error)
+                     (error! (format "Class definiton error: " class-name "\n"
+                                     error)))
+
+                   #;None
+                   (error! (format "Class not found: " class-name))))))
 
 (def: #export (init-host _)
   (-> Top &&common;Host)