Ported JVM structure generation to the new JVM bytecode machinery.

7 files changed, 137 insertions, 21 deletions

diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index ff9847bd6..80addbcbe 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -1,11 +1,13 @@
 (.module:
   [lux #*
-   [host (#+ import:)]
+   ["." host (#+ import:)]
+   ["@" target]
    [abstract
     [monad (#+ do)]
     ["." equivalence (#+ Equivalence)]]
    [data
     [number
+     ["." i64]
      ["." int]
      ["." frac]]
     ["." text]
@@ -14,14 +16,16 @@
     [collection
      ["." row (#+ Row)]]]
    [type
-    abstract]]
+    abstract]
+   [macro
+    ["." template]]]
   ["." / #_
    ["#." tag ("#;." equivalence)]
-   ["." // #_
+   ["/#" // #_
     ["#." descriptor (#+ Descriptor)]
     ["#." index (#+ Index)]
     [encoding
-     [unsigned (#+ U4)]]]])
+     ["#." unsigned (#+ U4)]]]])
 
 (type: #export UTF8 Text)
 
@@ -49,6 +53,29 @@
     (|>> :representation //index.writer))
   )
 
+(def: sign-mask Int (|> +1 (i64.left-shift 63)))
+(def: number-mask Int (|> +1 (i64.left-shift 31) dec))
+
+(def: #export (i32 i64)
+  (-> Int U4)
+  (|> (i64.or (|> i64 (i64.and sign-mask) (i64.arithmetic-right-shift 32))
+              (|> i64 (i64.and number-mask)))
+      .nat
+      //unsigned.u4))
+
+(import: #long java/lang/Float
+  (#static floatToRawIntBits #manual [float] int))
+
+(structure: #export float-equivalence
+  (Equivalence java/lang/Float)
+
+  (def: (= parameter subject)
+    (`` (for {(~~ (static @.old))
+              ("jvm feq" parameter subject)
+              
+              (~~ (static @.jvm))
+              ("jvm float =" parameter subject)}))))
+
 (import: #long java/lang/Double
   (#static doubleToRawLongBits [double] long))
 
@@ -78,8 +105,8 @@
        (|>> :abstraction))]
 
     [integer Integer U4]
+    [float   Float   java/lang/Float]
     [long    Long    .Int]
-    [float   Float   Nothing]
     [double  Double  Frac]
     [string  String  (Index UTF8)]
     )
@@ -87,11 +114,15 @@
   (template [<writer-name> <type> <write> <writer>]
     [(def: <writer-name>
        (Writer <type>)
-       (|>> :representation <write> <writer>))]
-
-    [long-writer Long (<|) binaryF.bits/64]
-    [double-writer Double java/lang/Double::doubleToRawLongBits binaryF.bits/64]
-    [string-writer String (<|) //index.writer]
+       (`` (|>> :representation
+                (~~ (template.splice <write>))
+                (~~ (template.splice <writer>)))))]
+
+    [integer-writer Integer [//unsigned.nat] [binaryF.bits/32]]
+    [float-writer Float [java/lang/Float::floatToRawIntBits host.int-to-long] [..i32 //unsigned.nat binaryF.bits/32]]
+    [long-writer Long [] [binaryF.bits/64]]
+    [double-writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]]
+    [string-writer String [] [//index.writer]]
     )
   )
 
@@ -122,6 +153,8 @@
 
 (type: #export Constant
   (#UTF8 UTF8)
+  (#Integer Integer)
+  (#Float Float)
   (#Long Long)
   (#Double Double)
   (#Class Class)
@@ -151,7 +184,9 @@
          [(<tag> reference) (<tag> sample)]
          (:: <equivalence> = reference sample))
        ([#UTF8 text.equivalence]
+        [#Integer (..value-equivalence //unsigned.equivalence)]
         [#Long (..value-equivalence int.equivalence)]
+        [#Float (..value-equivalence float-equivalence)]
         [#Double (..value-equivalence frac.equivalence)]
         [#Class ..class-equivalence]
         [#String (..value-equivalence //index.equivalence)]
@@ -187,8 +222,8 @@
 (def: #export writer
   (Writer Constant)
   (with-expansions [<constants> (as-is [#UTF8             /tag.utf8             ..utf8-writer]
-                                       ## TODO: Integer
-                                       ## TODO: Float
+                                       [#Integer          /tag.integer          ..integer-writer]
+                                       [#Float            /tag.float            ..float-writer]
                                        [#Long             /tag.long             ..long-writer]
                                        [#Double           /tag.double           ..double-writer]
                                        [#Class            /tag.class            ..class-writer]
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index a03bba71b..590102a09 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux #*
+   ["." host]
    [abstract
     ["." equivalence (#+ Equivalence)]
     [monad (#+ do)]]
@@ -21,7 +22,7 @@
     abstract]
    [macro
     ["." template]]]
-  ["." // (#+ UTF8 String Class Long Double Constant Name-And-Type Reference)
+  ["." // (#+ UTF8 String Class Integer Float Long Double Constant Name-And-Type Reference)
    [//
     [encoding
      ["#." name (#+ Internal External)]
@@ -148,6 +149,8 @@
          (Finder <type>)
          (!find <tag> <equivalence> <format> reference)))]
 
+  [integer Integer #//.Integer (//.value-equivalence //unsigned.equivalence) (|>> //.value //unsigned.nat %.nat)]
+  [float Float #//.Float (//.value-equivalence //.float-equivalence) (|>> //.value host.float-to-double %.frac)]
   [long Long #//.Long (//.value-equivalence int.equivalence) (|>> //.value %.int)]
   [double Double #//.Double (//.value-equivalence frac.equivalence) (|>> //.value %.frac)]
   [utf8 UTF8 #//.UTF8 text.equivalence %.text]
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index abfe6f5bb..13cd8ae5b 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -320,7 +320,9 @@
        [index (..lift (<constant> value))]
        (..nullary (<ldc> index))))]
 
+  [ldc/integer //constant.Integer //constant/pool.integer /instruction.ldc-w/integer]
   [ldc/long //constant.Long //constant/pool.long /instruction.ldc2-w/long]
+  [ldc/float //constant.Float //constant/pool.float /instruction.ldc-w/float]
   [ldc/double //constant.Double //constant/pool.double /instruction.ldc2-w/double]
   )
 
@@ -439,7 +441,7 @@
 
 (template [<name> <instruction>]
   [(def: #export (<name> class)
-     (-> UTF8 (Program Any))
+     (-> External (Program Any))
      (do ..monad
        ## TODO: Make sure it"s impossible to have indexes greater than U2.
        [index (..lift (//constant/pool.class (//name.internal class)))]
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux
index 5bdbfd1a6..c721c991c 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/structure.lux
@@ -12,11 +12,13 @@
      [analysis (#+ Variant Tuple)]
      ["#." synthesis (#+ Synthesis)]]]])
 
+(def: unit Expression (//primitive.text /////synthesis.unit))
+
 (def: #export (tuple generate elemsS+)
   (-> Phase (Tuple Synthesis) (Operation Expression))
   (case elemsS+
     #.Nil
-    (:: ////.monad wrap (//primitive.text /////synthesis.unit))
+    (:: ////.monad wrap ..unit)
 
     (#.Cons singletonS #.Nil)
     (generate singletonS)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
index e9ece420f..9a4847165 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm.lux
@@ -5,7 +5,7 @@
   ["." / #_
    [runtime (#+ Phase)]
    ["#." primitive]
-   ## ["." structure]
+   ["#." structure]
    ## ["." reference ("#@." system)]
    ## ["." function]
    ## ["." case]
@@ -27,11 +27,11 @@
      [synthesis.f64  /primitive.f64]
      [synthesis.text /primitive.text])
 
-    ## (^ (synthesis.variant variantS))
-    ## (/structure.variant generate variantS)
+    (^ (synthesis.variant variantS))
+    (/structure.variant generate variantS)
 
-    ## (^ (synthesis.tuple members))
-    ## (/structure.tuple generate members)
+    (^ (synthesis.tuple members))
+    (/structure.tuple generate members)
 
     ## (#synthesis.Reference value)
     ## (/reference@reference value)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
index 5a84c4990..f43fc907a 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -27,4 +27,6 @@
   )
 
 (type: #export (Generator i)
-  (-> i Phase (Operation (Program Any))))
+  (-> Phase i (Operation (Program Any))))
+
+(def: #export class "LuxRuntime")
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
new file mode 100644
index 000000000..6c2dfc277
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
@@ -0,0 +1,72 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [data
+    [collection
+     ["." list]]]
+   [target
+    [jvm
+     ["|" descriptor]
+     ["_." constant]
+     ["_" program (#+ Program)]]]]
+  ["." // #_
+   ["#." runtime (#+ Operation Phase Generator)]
+   ["#." primitive]
+   ["#//" ///
+    ["#/" // #_
+     [analysis (#+ Variant Tuple)]
+     ["#." synthesis (#+ Synthesis)]]]])
+
+(def: unitG (Program Any) (//primitive.text /////synthesis.unit))
+
+(template: (!integer <value>)
+  (|> <value> .int _constant.i32 _constant.integer))
+
+(def: #export (tuple generate membersS)
+  (Generator (Tuple Synthesis))
+  (case membersS
+    #.Nil
+    (:: ////.monad wrap ..unitG)
+
+    (#.Cons singletonS #.Nil)
+    (generate singletonS)
+
+    _
+    (do ////.monad
+      [membersI (|> membersS
+                    list.enumerate
+                    (monad.map @ (function (_ [idx member])
+                                   (do @
+                                     [memberI (generate member)]
+                                     (wrap (do _.monad
+                                             [_ _.dup
+                                              _ (_.ldc/integer (!integer idx))
+                                              _ memberI]
+                                             _.aastore))))))]
+      (wrap (do _.monad
+              [_ (_.ldc/integer (!integer (list.size membersS)))
+               _ (_.anewarray "java.lang.Object")]
+              (monad.seq @ membersI))))))
+
+(def: (flagG right?)
+  (-> Bit (Program Any))
+  (if right?
+    ..unitG
+    _.aconst-null))
+
+(def: $Object (|.object "java.lang.Object"))
+
+(def: #export (variant generate [lefts right? valueS])
+  (Generator (Variant Synthesis))
+  (do ////.monad
+    [valueI (generate valueS)]
+    (wrap (do _.monad
+            [_ (_.ldc/integer (!integer (if right?
+                                          (.inc lefts)
+                                          lefts)))
+             _ (flagG right?)
+             _ valueI]
+            (_.invokestatic //runtime.class "variant"
+                            (list |.int $Object $Object)
+                            (|.array $Object))))))