Implemented an alternative method for extensible JVM bytecode generation.

4 files changed, 346 insertions, 23 deletions

diff --git a/stdlib/source/lux/target/jvm.lux b/stdlib/source/lux/target/jvm.lux
new file mode 100644
index 000000000..4998f0f05
--- /dev/null
+++ b/stdlib/source/lux/target/jvm.lux
@@ -0,0 +1,282 @@
+(.module:
+  [lux (#- Type)
+   [data
+    [collection
+     [row (#+ Row)]]]
+   [target
+    [jvm
+     [type (#+ Type)
+      ["." category (#+ Primitive Class Value Method)]]]]])
+
+(type: #export Literal
+  (#Boolean Bit)
+  (#Int Int)
+  (#Long Int)
+  (#Double Frac)
+  (#Char Nat)
+  (#String Text))
+
+(type: #export Constant
+  (#BIPUSH Int)
+  
+  (#SIPUSH Int)
+
+  #ICONST_M1
+  #ICONST_0
+  #ICONST_1
+  #ICONST_2
+  #ICONST_3
+  #ICONST_4
+  #ICONST_5
+
+  #LCONST_0
+  #LCONST_1
+  
+  #FCONST_0
+  #FCONST_1
+  #FCONST_2
+  
+  #DCONST_0
+  #DCONST_1
+  
+  #ACONST_NULL
+
+  (#LDC Literal))
+
+(type: #export Int-Arithmetic
+  #IADD
+  #ISUB
+  #IMUL
+  #IDIV
+  #IREM
+  #INEG)
+
+(type: #export Long-Arithmetic
+  #LADD
+  #LSUB
+  #LMUL
+  #LDIV
+  #LREM
+  #LNEG)
+
+(type: #export Float-Arithmetic
+  #FADD
+  #FSUB
+  #FMUL
+  #FDIV
+  #FREM
+  #FNEG)
+
+(type: #export Double-Arithmetic
+  #DADD
+  #DSUB
+  #DMUL
+  #DDIV
+  #DREM
+  #DNEG)
+
+(type: #export Arithmetic
+  (#Int-Arithmetic Int-Arithmetic)
+  (#Long-Arithmetic Long-Arithmetic)
+  (#Float-Arithmetic Float-Arithmetic)
+  (#Double-Arithmetic Double-Arithmetic))
+
+(type: #export Int-Bitwise
+  #IOR
+  #IXOR
+  #IAND
+  #ISHL
+  #ISHR
+  #IUSHR)
+
+(type: #export Long-Bitwise
+  #LOR
+  #LXOR
+  #LAND
+  #LSHL
+  #LSHR
+  #LUSHR)
+
+(type: #export Bitwise
+  (#Int-Bitwise Int-Bitwise)
+  (#Long-Bitwise Long-Bitwise))
+
+(type: #export Conversion
+  #I2B
+  #I2S
+  #I2L
+  #I2F
+  #I2D
+  #I2C
+
+  #L2I
+  #L2F
+  #L2D
+
+  #F2I
+  #F2L
+  #F2D
+  
+  #D2I
+  #D2L
+  #D2F)
+
+(type: #export Array
+  #ARRAYLENGTH
+
+  (#NEWARRAY (Type Primitive))
+  (#ANEWARRAY (Type category.Object))
+
+  #BALOAD
+  #BASTORE
+
+  #SALOAD
+  #SASTORE
+
+  #IALOAD
+  #IASTORE
+
+  #LALOAD
+  #LASTORE
+
+  #FALOAD
+  #FASTORE
+
+  #DALOAD
+  #DASTORE
+  
+  #CALOAD
+  #CASTORE
+
+  #AALOAD
+  #AASTORE)
+
+(type: #export Object
+  (#GETSTATIC (Type Class) Text (Type Value))
+  (#PUTSTATIC (Type Class) Text (Type Value))
+
+  (#NEW (Type Class))
+  
+  (#INSTANCEOF (Type Class))
+  (#CHECKCAST (Type category.Object))
+
+  (#GETFIELD (Type Class) Text (Type Value))
+  (#PUTFIELD (Type Class) Text (Type Value))
+  
+  (#INVOKEINTERFACE (Type Class) Text (Type Method))
+  (#INVOKESPECIAL (Type Class) Text (Type Method))
+  (#INVOKESTATIC (Type Class) Text (Type Method))
+  (#INVOKEVIRTUAL (Type Class) Text (Type Method)))
+
+(type: #export Register Nat)
+
+(type: #export Local-Int
+  (#ILOAD Register)
+  (#ISTORE Register))
+
+(type: #export Local-Long
+  (#LLOAD Register)
+  (#LSTORE Register))
+
+(type: #export Local-Float
+  (#FLOAD Register)
+  (#FSTORE Register))
+
+(type: #export Local-Double
+  (#DLOAD Register)
+  (#DSTORE Register))
+
+(type: #export Local-Object
+  (#ALOAD Register)
+  (#ASTORE Register))
+
+(type: #export Local
+  (#Local-Int Local-Int)
+  (#IINC Register)
+  (#Local-Long Local-Long)
+  (#Local-Float Local-Float)
+  (#Local-Double Local-Double)
+  (#Local-Object Local-Object))
+
+(type: #export Stack
+  #DUP
+  #DUP_X1
+  #DUP_X2
+  #DUP2
+  #DUP2_X1
+  #DUP2_X2
+  #SWAP
+  #POP
+  #POP2)
+
+(type: #export Comparison
+  #LCMP
+  
+  #FCMPG
+  #FCMPL
+
+  #DCMPG
+  #DCMPL)
+
+(type: #export Label Nat)
+
+(type: #export (Branching label)
+  (#IF_ICMPEQ label)
+  (#IF_ICMPGE label)
+  (#IF_ICMPGT label)
+  (#IF_ICMPLE label)
+  (#IF_ICMPLT label)
+  (#IF_ICMPNE label)
+  (#IFEQ label)
+  (#IFNE label)
+  (#IFGE label)
+  (#IFGT label)
+  (#IFLE label)
+  (#IFLT label)
+
+  (#TABLESWITCH Int Int label (List label))
+  (#LOOKUPSWITCH label (List [Int label]))
+
+  (#IF_ACMPEQ label)
+  (#IF_ACMPNE label)
+  (#IFNONNULL label)
+  (#IFNULL label))
+
+(type: #export (Exception label)
+  (#Try label label label (Type Class))
+  #ATHROW)
+
+(type: #export Concurrency
+  #MONITORENTER
+  #MONITOREXIT)
+
+(type: #export Return
+  #RETURN
+  #IRETURN
+  #LRETURN
+  #FRETURN
+  #DRETURN
+  #ARETURN)
+
+(type: #export (Control label)
+  (#GOTO label)
+  (#Branching (Branching label))
+  (#Exception (Exception label))
+  (#Concurrency Concurrency)
+  (#Return Return))
+
+(type: #export (Instruction label)
+  #NOP
+  (#Constant Constant)
+  (#Arithmetic Arithmetic)
+  (#Bitwise Bitwise)
+  (#Conversion Conversion)
+  (#Array Array)
+  (#Object Object)
+  (#Local Local)
+  (#Stack Stack)
+  (#Comparison Comparison)
+  (#Control (Control label)))
+
+(type: #export (Bytecode label)
+  (Row (Instruction label)))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
index ccf8c8d96..856648097 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
@@ -65,7 +65,7 @@
       codeV (////generation.evaluate! (format "evaluate" (%.nat id)) codeT)]
      (wrap [code//type codeT codeV]))))
 
-(def: (evaluate! type codeC)
+(def: #export (evaluate! type codeC)
   (All [anchor expression directive]
     (-> Type Code (Operation anchor expression directive [Type expression Any])))
   (do ////.monad
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux
index 05fbe7fc2..df351c008 100644
--- a/stdlib/source/spec/compositor/common.lux
+++ b/stdlib/source/spec/compositor/common.lux
@@ -8,12 +8,13 @@
    [tool
     [compiler
      ["." reference]
+     ["." analysis]
      ["." synthesis (#+ Synthesis)]
      ["." directive]
      ["." phase
       ["." macro (#+ Expander)]
-      ["." generation (#+ Operation Bundle)]
-      [extension
+      ["." generation (#+ Operation)]
+      [extension (#+ Extender)
        ["." bundle]]]
      [default
       ["." platform (#+ Platform)]]]]])
@@ -53,17 +54,20 @@
                          (phase (synthesis.constant lux-name))))]
       (:: host evaluate! "definer" definitionG))))
 
-(def: #export (executors platform bundle expander program)
+(def: #export (executors target expander platform
+                         analysis-bundle generation-bundle directive-bundle
+                         program extender)
   (All [anchor expression directive]
-    (-> (Platform IO anchor expression directive)
-        (Bundle anchor expression directive)
-        Expander
-        (-> expression directive)
+    (-> Text Expander (Platform IO anchor expression directive)
+        analysis.Bundle
+        (generation.Bundle anchor expression directive)
+        (directive.Bundle anchor expression directive)
+        (-> expression directive) Extender
         (IO (Try [(directive.State+ anchor expression directive)
                   Runner
                   Definer]))))
   (do io.monad
-    [?state (platform.initialize expander platform bundle program)]
+    [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)]
     (wrap (do try.monad
             [[directive-bundle directive-state] ?state
              #let [generation-state (get@ [#directive.generation
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 7b2d9ffd5..23c33c620 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,9 +1,11 @@
 (.module:
   [lux #*
-   ["@" target]
+   ["@" target
+    ["." jvm]]
    [abstract
     [monad (#+ do)]]
    [control
+    ["." try]
     ["<>" parser
      ["<c>" code]
      ["<a>" analysis]]]
@@ -20,33 +22,68 @@
        ["." type]]]]]
    ["_" test (#+ Test)]]
   {1
-   ["." / (#+ analysis: synthesis: directive:)]})
+   ["." / (#+ analysis: synthesis: generation: directive:)]})
 
-(def: my-extension "example YOLO")
+(def: my-analysis "my analysis")
+(def: my-synthesis "my synthesis")
+(def: my-generation "my generation")
+(def: my-directive "my directive")
 
 (`` (for {(~~ (static @.old))
-          (as-is)}
-         (as-is (analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
+          (as-is)
+
+          (~~ (static @.jvm))
+          (as-is (generation: (..my-generation self phase {parameters (<>.some <a>.any)})
+                   (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))}
+         (as-is (analysis: (..my-analysis self phase {parameters (<>.some <c>.any)})
+                  (do @
+                    [_ (type.infer .Text)]
+                    (wrap (#analysis.Text self))))
+
+                ## Synthesis
+                (analysis: (..my-synthesis self phase {parameters (<>.some <c>.any)})
                   (do @
                     [_ (type.infer .Text)]
                     (wrap (#analysis.Extension self (list)))))
 
-                (synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
+                (synthesis: (..my-synthesis self phase {parameters (<>.some <a>.any)})
                   (wrap (synthesis.text self)))
+                
+                ## Generation
+                (analysis: (..my-generation self phase {parameters (<>.some <c>.any)})
+                  (do @
+                    [_ (type.infer .Text)]
+                    (wrap (#analysis.Extension self (list)))))
+
+                (synthesis: (..my-generation self phase {parameters (<>.some <a>.any)})
+                  (wrap (#synthesis.Extension self (list))))
 
-                (directive: (..my-extension self phase {parameters (<>.some <c>.any)})
+                ## Directive
+                (directive: (..my-directive self phase {parameters (<>.some <c>.any)})
                   (do @
-                    [#let [_ (log! (format "directive: " (%.text self)))]]
+                    [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]]
                     (wrap directive.no-requirements)))
 
-                ("example YOLO")
+                (`` ((~~ (static ..my-directive))))
                 )))
 
 (def: #export test
   Test
   (<| (_.context (%.name (name-of /._)))
-      (_.test "Can define and use analysis & synthesis extensions."
-              (`` (for {(~~ (static @.old))
-                        false}
-                       (text@= ("example YOLO")
-                               "example YOLO"))))))
+      ($_ _.and
+          (_.test "Can define and use analysis extensions."
+                  (`` (for {(~~ (static @.old))
+                            false}
+                           (text@= ((~~ (static ..my-analysis)))
+                                   ..my-analysis))))
+          (_.test "Can define and use synthesis extensions."
+                  (`` (for {(~~ (static @.old))
+                            false}
+                           (text@= ((~~ (static ..my-synthesis)))
+                                   ..my-synthesis))))
+          (_.test "Can define and use generation extensions."
+                  (`` (for {(~~ (static @.old))
+                            false}
+                           (text@= ((~~ (static ..my-generation)))
+                                   ..my-generation))))
+          )))