- WIP: Added generation for common procedures.

2 files changed, 276 insertions, 21 deletions

diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 1fd87caea..39fab2f2a 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -1,6 +1,8 @@
 (;module:
   lux
-  (lux (data (coll ["a" array]
+  (lux (data [text]
+             text/format
+             (coll ["a" array]
                    [list "L/" Functor<List>]))
        [host #+ jvm-import do-to])
   ["$" ..]
@@ -15,13 +17,26 @@
   (#static ACC_PROTECTED int)
   (#static ACC_PRIVATE int)
 
+  (#static ACC_TRANSIENT int)
+  (#static ACC_VOLATILE int)
+
   (#static ACC_ABSTRACT int)
   (#static ACC_FINAL int)
   (#static ACC_STATIC int)
   (#static ACC_SYNCHRONIZED int)
 
-  (#static ACC_TRANSIENT int)
-  (#static ACC_VOLATILE int))
+  (#static ACC_SUPER int)
+  (#static ACC_INTERFACE int)
+
+  (#static V1_1 int)
+  (#static V1_2 int)
+  (#static V1_3 int)
+  (#static V1_4 int)
+  (#static V1_5 int)
+  (#static V1_6 int)
+  (#static V1_7 int)
+  (#static V1_8 int)
+  )
 
 (jvm-import org.objectweb.asm.FieldVisitor
   (visitEnd [] void))
@@ -41,15 +56,32 @@
   (toByteArray [] Byte-Array))
 
 ## [Defs]
-(def: (exceptions-array type)
-  (-> $;Method (a;Array Text))
-  (let [exs (|> type (get@ #$;exceptions) (L/map (|>. #$;Generic $t;descriptor)))
-        output (host;array String (list;size exs))]
+(def: (string-array values)
+  (-> (List Text) (a;Array Text))
+  (let [output (host;array String (list;size values))]
     (exec (L/map (function [[idx value]]
                    (host;array-store idx value output))
-                 (list;enumerate exs))
+                 (list;enumerate values))
       output)))
 
+(def: exceptions-array
+  (-> $;Method (a;Array Text))
+  (|>. (get@ #$;exceptions)
+       (L/map (|>. #$;Generic $t;descriptor))
+       string-array))
+
+(def: (version-flag version)
+  (-> $;Version Int)
+  (case version
+    #$;V1.1 Opcodes.V1_1
+    #$;V1.2 Opcodes.V1_2
+    #$;V1.3 Opcodes.V1_3
+    #$;V1.4 Opcodes.V1_4
+    #$;V1.5 Opcodes.V1_5
+    #$;V1.6 Opcodes.V1_6
+    #$;V1.7 Opcodes.V1_7
+    #$;V1.8 Opcodes.V1_8))
+
 (def: (visibility-flag visibility)
   (-> $;Visibility Int)
   (case visibility
@@ -58,6 +90,11 @@
     #$;Private   Opcodes.ACC_PRIVATE
     #$;Default   0))
 
+(def: (class-flag config)
+  (-> $;Class-Config Int)
+  ($_ i.+
+      (if (get@ #$;finalC config) Opcodes.ACC_FINAL 0)))
+
 (def: (method-flag config)
   (-> $;Method-Config Int)
   ($_ i.+
@@ -73,6 +110,87 @@
       (if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0)
       (if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0)))
 
+(def: class-to-type
+  (-> $;Class $;Type)
+  (|>. #$;Class #$;Generic))
+
+(def: param-signature
+  (-> $;Class Text)
+  (|>. class-to-type $t;signature (format ":")))
+
+(def: (formal-param [name super interfaces])
+  (-> $;Parameter Text)
+  (format name
+          (param-signature super)
+          (|> interfaces
+              (L/map param-signature)
+              (text;join-with ""))))
+
+(def: (parameters-signature parameters super interfaces)
+  (-> (List $;Parameter) $;Class (List $;Class)
+      Text)
+  (let [formal-params (if (list;empty? parameters)
+                        ""
+                        (format "<"
+                                (|> parameters
+                                    (L/map formal-param)
+                                    (text;join-with ""))
+                                ">"))]
+    (format formal-params
+            (|> super class-to-type $t;signature)
+            (|> interfaces
+                (L/map (|>. class-to-type $t;signature))
+                (text;join-with "")))))
+
+(do-template [<name> <flag>]
+  [(def: #export (<name> version visibility config name parameters super interfaces
+                         definitions)
+     (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def
+         host;Byte-Array)
+     (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+                        (ClassWriter.visit [(version-flag version)
+                                            ($_ i.+
+                                                Opcodes.ACC_SUPER
+                                                <flag>
+                                                (visibility-flag visibility)
+                                                (class-flag config))
+                                            name
+                                            (parameters-signature parameters super interfaces)
+                                            (|> super class-to-type $t;descriptor)
+                                            (|> interfaces
+                                                (L/map (|>. class-to-type $t;descriptor))
+                                                string-array)]))
+                      definitions)
+           _ (ClassWriter.visitEnd [] writer)]
+       (ClassWriter.toByteArray [] writer)))]
+
+  [class     0]
+  [abstract  Opcodes.ACC_ABSTRACT]
+  )
+
+(def: $Object $;Class ["java.lang.Object" (list)])
+
+(def: #export (interface version visibility config name parameters interfaces
+                         definitions)
+  (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def
+      host;Byte-Array)
+  (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+                     (ClassWriter.visit [(version-flag version)
+                                         ($_ i.+
+                                             Opcodes.ACC_SUPER
+                                             Opcodes.ACC_INTERFACE
+                                             (visibility-flag visibility)
+                                             (class-flag config))
+                                         name
+                                         (parameters-signature parameters $Object interfaces)
+                                         (|> $Object class-to-type $t;descriptor)
+                                         (|> interfaces
+                                             (L/map (|>. class-to-type $t;descriptor))
+                                             string-array)]))
+                   definitions)
+        _ (ClassWriter.visitEnd [] writer)]
+    (ClassWriter.toByteArray [] writer)))
+
 (def: #export (method visibility config name type then)
   (-> $;Visibility $;Method-Config Text $;Method $;Inst
       $;Def)
@@ -140,3 +258,15 @@
   [char-field    Char $t;char    id]
   [string-field  Text ($t;class "java.lang.String" (list)) id]
   )
+
+(def: #export (fuse defs)
+  (-> (List $;Def) $;Def)
+  (case defs
+    #;Nil
+    id
+
+    (#;Cons singleton #;Nil)
+    singleton
+
+    (#;Cons head tail)
+    (. head (fuse tail))))
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index f340be055..82b360883 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -18,25 +18,80 @@
   (#static T_INT int)
   (#static T_LONG int)
 
+  (#static CHECKCAST int)
+  (#static NEW int)
+  (#static NEWARRAY int)
+  (#static ANEWARRAY int)
+  
   (#static DUP int)
-  (#static RETURN int)
-  (#static ARETURN 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 NEWARRAY int)
-  (#static ANEWARRAY 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 INVOKEVIRTUAL int)
   (#static INVOKESPECIAL int)
-  (#static CHECKCAST int))
+  (#static INVOKEVIRTUAL int)
+
+  (#static ATHROW int)
+
+  (#static RETURN int)
+  (#static ARETURN int)
+  )
 
 (jvm-import org.objectweb.asm.FieldVisitor
   (visitEnd [] void))
 
+(jvm-import org.objectweb.asm.Label
+  (new []))
+
 (jvm-import org.objectweb.asm.MethodVisitor
   (visitCode [] void)
   (visitMaxs [int int] void)
@@ -47,9 +102,15 @@
   (visitTypeInsn [int String] void)
   (visitVarInsn [int int] void)
   (visitIntInsn [int int] void)
-  (visitMethodInsn [int String String String boolean] void))
+  (visitMethodInsn [int String String String boolean] void)
+  (visitLabel [Label] void)
+  (visitJumpInsn [int Label] void))
 
 ## [Insts]
+(def: #export (with-label action)
+  (-> (-> Label $;Inst) $;Inst)
+  (action (Label.new [])))
+
 (do-template [<name> <type> <prepare>]
   [(def: #export (<name> value)
      (-> <type> $;Inst)
@@ -72,11 +133,50 @@
        (do-to visitor
          (MethodVisitor.visitInsn [<inst>]))))]
 
-  [RETURN  Opcodes.RETURN]
-  [ARETURN Opcodes.ARETURN]
-  [NULL    Opcodes.ACONST_NULL]
-  [DUP     Opcodes.DUP]
-  [AASTORE Opcodes.AASTORE]
+  [DUP         Opcodes.DUP]
+  [DUP2_X1     Opcodes.DUP2_X1]
+  [POP         Opcodes.POP]
+  [POP2        Opcodes.POP2]
+
+  [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]
+
+  [ATHROW      Opcodes.ATHROW]
+
+  [RETURN      Opcodes.RETURN]
+  [ARETURN     Opcodes.ARETURN]
   )
 
 (do-template [<name> <inst>]
@@ -97,7 +197,11 @@
        (do-to visitor
          (MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))]
 
+  [GETSTATIC Opcodes.GETSTATIC]
   [PUTSTATIC Opcodes.PUTSTATIC]
+  
+  [PUTFIELD  Opcodes.PUTFIELD]
+  [GETFIELD  Opcodes.GETFIELD]
   )
 
 (do-template [<name> <inst>]
@@ -107,8 +211,9 @@
        (do-to visitor
          (MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
 
-  [ANEWARRAY Opcodes.ANEWARRAY]
   [CHECKCAST Opcodes.CHECKCAST]
+  [NEW       Opcodes.NEW]
+  [ANEWARRAY Opcodes.ANEWARRAY]
   )
 
 (def: #export (NEWARRAY type)
@@ -134,8 +239,28 @@
 
   [INVOKESTATIC  Opcodes.INVOKESTATIC]
   [INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL]
+  [INVOKESPECIAL Opcodes.INVOKESPECIAL]
   )
 
+(do-template [<name> <inst>]
+  [(def: #export (<name> @where)
+     (-> $;Label $;Inst)
+     (function [visitor]
+       (do-to visitor
+         (MethodVisitor.visitJumpInsn [<inst> @where]))))]
+
+  [IF_ICMPEQ Opcodes.IF_ICMPEQ]
+  [IF_ACMPEQ Opcodes.IF_ACMPEQ]
+  [IFNULL    Opcodes.IFNULL]
+  [GOTO      Opcodes.GOTO]
+  )
+
+(def: #export (label @label)
+  (-> $;Label $;Inst)
+  (function [visitor]
+    (do-to visitor
+      (MethodVisitor.visitLabel [@label]))))
+
 (def: #export (array type size)
   (-> $;Type Nat $;Inst)
   (case type