Ported JVM primitive generation to the new JVM bytecode machinery.

6 files changed, 158 insertions, 7 deletions

diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index 0f4aca590..ff9847bd6 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux #*
+   [host (#+ import:)]
    [abstract
     [monad (#+ do)]
     ["." equivalence (#+ Equivalence)]]
@@ -48,6 +49,9 @@
     (|>> :representation //index.writer))
   )
 
+(import: #long java/lang/Double
+  (#static doubleToRawLongBits [double] long))
+
 (abstract: #export (Value kind)
 
   {}
@@ -86,7 +90,7 @@
        (|>> :representation <write> <writer>))]
 
     [long-writer Long (<|) binaryF.bits/64]
-    [double-writer Double frac.frac-to-bits binaryF.bits/64]
+    [double-writer Double java/lang/Double::doubleToRawLongBits binaryF.bits/64]
     [string-writer String (<|) //index.writer]
     )
   )
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index aeb3e0b0a..abfe6f5bb 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -23,7 +23,7 @@
    ["#." instruction (#+ Primitive-Array-Type Instruction) ("#@." monoid)]
    ["/#" // #_
     ["#." index]
-    ["#." descriptor (#+ Descriptor Value Return)]
+    ["#." descriptor (#+ Descriptor Value Return Field)]
     [encoding
      ["#." name (#+ External)]
      ["#." unsigned (#+ U1 U2)]
@@ -496,3 +496,26 @@
   [#0 invokespecial /instruction.invokespecial]
   [#0 invokeinterface /instruction.invokeinterface]
   )
+
+(template [<name> <1> <2>]
+  [(def: #export (<name> class field type)
+     (-> External Text (Descriptor Field) (Program Any))
+     (do ..monad
+       [index (<| ..lift
+                  (//constant/pool.field class)
+                  {#//constant/pool.name field
+                   #//constant/pool.descriptor type})]
+       (..nullary (cond (is? //descriptor.long type)
+                        (<2> index)
+
+                        (is? //descriptor.double type)
+                        (<2> index)
+                        
+                        ## else
+                        (<1> index)))))]
+
+  [getstatic /instruction.getstatic/1 /instruction.getstatic/2]
+  [putstatic /instruction.putstatic/1 /instruction.putstatic/2]
+  [getfield /instruction.getfield/1 /instruction.getfield/2]
+  [putfield /instruction.putfield/1 /instruction.putfield/2]
+  )
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
index da1052d28..09341fd59 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
@@ -1,10 +1,5 @@
 (.module:
   [lux (#- i64)
-   [control
-    [pipe (#+ cond> new>)]]
-   [data
-    [number
-     ["." frac]]]
    [target
     ["_" js (#+ Computation)]]]
   ["." // #_
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
new file mode 100644
index 000000000..e9ece420f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
@@ -0,0 +1,65 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]]
+  ["." / #_
+   [runtime (#+ Phase)]
+   ["#." primitive]
+   ## ["." structure]
+   ## ["." reference ("#@." system)]
+   ## ["." function]
+   ## ["." case]
+   ## ["." loop]
+   ["//#" ///
+    ## ["." extension]
+    [//
+     [analysis (#+)]
+     ["." synthesis]]]])
+
+(def: #export (generate synthesis)
+  Phase
+  (case synthesis
+    (^template [<tag> <generator>]
+      (^ (<tag> value))
+      (:: ///.monad wrap (<generator> value)))
+    ([synthesis.bit  /primitive.bit]
+     [synthesis.i64  /primitive.i64]
+     [synthesis.f64  /primitive.f64]
+     [synthesis.text /primitive.text])
+
+    ## (^ (synthesis.variant variantS))
+    ## (/structure.variant generate variantS)
+
+    ## (^ (synthesis.tuple members))
+    ## (/structure.tuple generate members)
+
+    ## (#synthesis.Reference value)
+    ## (/reference@reference value)
+
+    ## (^ (synthesis.branch/case case))
+    ## (/case.case generate case)
+
+    ## (^ (synthesis.branch/let let))
+    ## (/case.let generate let)
+
+    ## (^ (synthesis.branch/if if))
+    ## (/case.if generate if)
+
+    ## (^ (synthesis.loop/scope scope))
+    ## (/loop.scope generate scope)
+
+    ## (^ (synthesis.loop/recur updates))
+    ## (/loop.recur generate updates)
+
+    ## (^ (synthesis.function/abstraction abstraction))
+    ## (/function.function generate abstraction)
+
+    ## (^ (synthesis.function/apply application))
+    ## (/function.apply generate application)
+
+    ## (#synthesis.Extension extension)
+    ## (/extension.apply generate extension)
+
+    _
+    (undefined)
+    ))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
new file mode 100644
index 000000000..d0d819925
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
@@ -0,0 +1,34 @@
+(.module:
+  [lux (#- i64)
+   [abstract
+    [monad (#+ do)]]
+   [target
+    [jvm
+     ["|" descriptor]
+     ["." constant]
+     ["_" program (#+ Program)]]]
+   [macro
+    ["." template]]]
+  ["." // #_
+   ["#." runtime]])
+
+(def: #export (bit value)
+  (-> Bit (Program Any))
+  (_.getstatic "java.lang.Boolean"
+               (if value "TRUE" "FALSE")
+               (|.object "java.lang.Boolean")))
+
+(template [<name> <inputT> <ldc> <class> <inputD>]
+  [(def: #export (<name> value)
+     (-> <inputT> (Program Any))
+     (do _.monad
+       [_ (`` (|> value (~~ (template.splice <ldc>))))]
+       (_.invokestatic <class> "valueOf"
+                       (list <inputD>)
+                       (|.object <class>))))]
+
+  [i64 (I64 Any) [.int constant.long _.ldc/long] "java.lang.Long"   |.long]
+  [f64 Frac      [constant.double _.ldc/double]    "java.lang.Double" |.double]
+  )
+
+(def: #export text _.ldc/string)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
new file mode 100644
index 000000000..5a84c4990
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -0,0 +1,30 @@
+(.module:
+  [lux (#- Definition)
+   [data
+    [binary (#+ Binary)]]
+   [target
+    [jvm
+     ["_" program (#+ Label Program)]]]]
+  ["." ///
+   [///
+    [reference (#+ Register)]]]
+  )
+
+(type: #export Byte-Code Binary)
+
+(type: #export Definition [Text Byte-Code])
+
+(type: #export Anchor [Label Register])
+
+(template [<name> <base>]
+  [(type: #export <name>
+     (<base> Anchor (Program Any) Definition))]
+
+  [Operation ///.Operation]
+  [Phase ///.Phase]
+  [Handler ///.Handler]
+  [Bundle ///.Bundle]
+  )
+
+(type: #export (Generator i)
+  (-> i Phase (Operation (Program Any))))