Ported JVM reference generation to the new JVM bytecode machinery.

22 files changed, 141 insertions, 43 deletions

diff --git a/stdlib/source/lux/data/number/i16.lux b/stdlib/source/lux/data/number/i16.lux
index 23f64afc5..44fe0e988 100644
--- a/stdlib/source/lux/data/number/i16.lux
+++ b/stdlib/source/lux/data/number/i16.lux
@@ -12,9 +12,9 @@
 
 (def: #export I16 (:by-example [size]
                                {(Sub size)
-                                sub}
+                                ..sub}
                                (I64 size)))
 
-(def: #export i16 (-> I64 I16) (get@ #i64.narrow sub))
-(def: #export i64 (-> I16 I64) (get@ #i64.wide sub))
-(def: #export equivalence (Equivalence I16) (get@ #i64.equivalence sub))
+(def: #export i16 (-> I64 I16) (get@ #i64.narrow ..sub))
+(def: #export i64 (-> I16 I64) (get@ #i64.wide ..sub))
+(def: #export equivalence (Equivalence I16) (get@ #i64.equivalence ..sub))
diff --git a/stdlib/source/lux/data/number/i32.lux b/stdlib/source/lux/data/number/i32.lux
index 7f4452880..560168f6f 100644
--- a/stdlib/source/lux/data/number/i32.lux
+++ b/stdlib/source/lux/data/number/i32.lux
@@ -12,9 +12,9 @@
 
 (def: #export I32 (:by-example [size]
                                {(Sub size)
-                                sub}
+                                ..sub}
                                (I64 size)))
 
-(def: #export i32 (-> I64 I32) (get@ #i64.narrow sub))
-(def: #export i64 (-> I32 I64) (get@ #i64.wide sub))
-(def: #export equivalence (Equivalence I32) (get@ #i64.equivalence sub))
+(def: #export i32 (-> I64 I32) (get@ #i64.narrow ..sub))
+(def: #export i64 (-> I32 I64) (get@ #i64.wide ..sub))
+(def: #export equivalence (Equivalence I32) (get@ #i64.equivalence ..sub))
diff --git a/stdlib/source/lux/data/number/i8.lux b/stdlib/source/lux/data/number/i8.lux
index 483f6a6a1..a6475eb15 100644
--- a/stdlib/source/lux/data/number/i8.lux
+++ b/stdlib/source/lux/data/number/i8.lux
@@ -12,9 +12,9 @@
 
 (def: #export I8 (:by-example [size]
                               {(Sub size)
-                               sub}
+                               ..sub}
                               (I64 size)))
 
-(def: #export i8 (-> I64 I8) (get@ #i64.narrow sub))
-(def: #export i64 (-> I8 I64) (get@ #i64.wide sub))
-(def: #export equivalence (Equivalence I8) (get@ #i64.equivalence sub))
+(def: #export i8 (-> I64 I8) (get@ #i64.narrow ..sub))
+(def: #export i64 (-> I8 I64) (get@ #i64.wide ..sub))
+(def: #export equivalence (Equivalence I8) (get@ #i64.equivalence ..sub))
diff --git a/stdlib/source/lux/target/jvm/descriptor.lux b/stdlib/source/lux/target/jvm/descriptor.lux
index 1ca625bd6..267835e1b 100644
--- a/stdlib/source/lux/target/jvm/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/descriptor.lux
@@ -70,9 +70,9 @@
          (format "[")
          :abstraction))
 
-  (def: #export (method inputs output)
-    (-> (List (Descriptor (Value Any)))
-        (Descriptor (Return Any))
+  (def: #export (method [inputs output])
+    (-> [(List (Descriptor (Value Any)))
+         (Descriptor (Return Any))]
         (Descriptor Method))
     (:abstraction
      (format (|> inputs
diff --git a/stdlib/source/lux/target/jvm/instruction.lux b/stdlib/source/lux/target/jvm/instruction.lux
index 02057202b..25b10cc9e 100644
--- a/stdlib/source/lux/target/jvm/instruction.lux
+++ b/stdlib/source/lux/target/jvm/instruction.lux
@@ -36,9 +36,9 @@
 
 (type: #export Address Nat)
 
-(type: Resolver (Dictionary Label Address))
+(type: #export Resolver (Dictionary Label Address))
 
-(type: Tracker
+(type: #export Tracker
   {#program-counter Address
    #next-label Label
    #known-labels Resolver})
@@ -470,23 +470,21 @@
    (cond (is? //descriptor.void descriptor)
          0
 
-         (is? //descriptor.long descriptor)
+         (or (is? //descriptor.long descriptor)
+             (is? //descriptor.double descriptor))
          2
 
-         (is? //descriptor.double descriptor)
-         2
-         
          ## else
          1)))
 
 (template [<static?> <name> <bytecode>]
-  [(def: #export (<name> class method inputs output)
-     (-> External Text (List (Descriptor (Value Any))) (Descriptor (Return Any)) (Instruction Any))
+  [(def: #export (<name> class method [inputs output])
+     (-> External Text [(List (Descriptor (Value Any))) (Descriptor (Return Any))] (Instruction Any))
      (do ..monad
        [index (<| ..lift
                   (//constant/pool.method class)
                   {#//constant/pool.name method
-                   #//constant/pool.descriptor (//descriptor.method inputs output)})]
+                   #//constant/pool.descriptor (//descriptor.method [inputs output])})]
        (..nullary (<bytecode>
                    index
                    (|> inputs
@@ -522,3 +520,10 @@
   [getfield /bytecode.getfield/1 /bytecode.getfield/2]
   [putfield /bytecode.putfield/1 /bytecode.putfield/2]
   )
+
+(def: #export (compose pre post)
+  (All [pre post]
+    (-> (Instruction pre) (Instruction post) (Instruction post)))
+  (do ..monad
+    [_ pre]
+    post))
diff --git a/stdlib/source/lux/tool/compiler/analysis.lux b/stdlib/source/lux/tool/compiler/analysis.lux
index 33973f979..ffefb48f7 100644
--- a/stdlib/source/lux/tool/compiler/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/analysis.lux
@@ -16,6 +16,7 @@
     [collection
      ["." list ("#@." functor fold)]]]]
   [//
+   [arity (#+ Arity)]
    ["." reference (#+ Register Variable Reference)]
    ["." phase
     ["." extension (#+ Extension)]]])
@@ -91,8 +92,6 @@
   [text Text #..Text]
   )
 
-(type: #export Arity Nat)
-
 (type: #export (Abstraction c) [Environment Arity c])
 
 (type: #export (Application c) [c (List c)])
diff --git a/stdlib/source/lux/tool/compiler/arity.lux b/stdlib/source/lux/tool/compiler/arity.lux
new file mode 100644
index 000000000..2e6b07490
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/arity.lux
@@ -0,0 +1,14 @@
+(.module:
+  [lux #*
+   [data
+    [number
+     ["n" nat]]]])
+
+(type: #export Arity Nat)
+
+(template [<name> <comparison>]
+  [(def: #export <name> (-> Arity Bit) (<comparison> 1))]
+
+  [mono? n.=]
+  [poly? n.>]
+  )
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/function.lux
index c8edd4e46..3dcc24448 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/function.lux
@@ -19,7 +19,8 @@
     ["#/" //
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
index a0418b839..ec48162c5 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/function.lux
@@ -19,7 +19,8 @@
     ["#/" // ("#@." monad)
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
index 2807487ae..27a02d7b4 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux
@@ -24,11 +24,11 @@
      (do _.monad
        [_ (`` (|> value (~~ (template.splice <ldc>))))]
        (_.invokestatic <class> "valueOf"
-                       (list <inputD>)
-                       (|.object <class>))))]
+                       [(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]
+  [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/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux
new file mode 100644
index 000000000..3e6738df0
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux
@@ -0,0 +1,61 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [data
+    [text
+     ["%" format (#+ format)]]]
+   [tool
+    [compiler
+     ["." reference (#+ Register Variable)]
+     ["." phase ("operation@." monad)
+      ["." generation]]]]
+   [target
+    [jvm
+     ["_" instruction (#+ Instruction)]
+     [encoding
+      ["." unsigned]]]]]
+  ["." // #_
+   [runtime (#+ Operation)]
+   ["#." value]])
+
+(def: #export this
+  (Instruction Any)
+  (_.aload (unsigned.u1 0)))
+
+(template [<name> <prefix>]
+  [(def: #export <name>
+     (-> Register Text)
+     (|>> %.nat (format <prefix>)))]
+
+  [foreign-name "f"]
+  [partial-name "p"]
+  )
+
+(def: (foreign variable)
+  (-> Register (Operation (Instruction Any)))
+  (do phase.monad
+    [function-class generation.context]
+    (wrap ($_ _.compose
+              ..this
+              (_.getfield function-class (..foreign-name variable)
+                          //value.type)))))
+
+(def: local
+  (-> Register (Instruction Any))
+  (|>> unsigned.u1 _.aload))
+
+(def: #export (variable variable)
+  (-> Variable (Operation (Instruction Any)))
+  (case variable
+    (#reference.Local variable)
+    (operation@wrap (..local variable))
+    
+    (#reference.Foreign variable)
+    (..foreign variable)))
+
+(def: #export (constant name)
+  (-> Name (Operation (Instruction Any)))
+  (do phase.monad
+    [bytecode-name (generation.remember name)]
+    (wrap (_.getstatic bytecode-name //value.field //value.type))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
index 1282ac245..8b2c6c270 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux
@@ -70,5 +70,5 @@
              _ (flagG right?)
              _ valueI]
             (_.invokestatic //runtime.class "variant"
-                            (list |.int $Object $Object)
-                            (|.array $Object))))))
+                            [(list |.int $Object $Object)
+                             (|.array $Object)])))))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux
new file mode 100644
index 000000000..a598b9997
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux
@@ -0,0 +1,9 @@
+(.module:
+  [lux (#- type)
+   [target
+    [jvm
+     ["." descriptor (#+ Descriptor Value)]]]])
+
+(def: #export field "_value")
+
+(def: #export type (Descriptor (Value Any)) (descriptor.object "java.lang.Object"))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux
index eb0a5e71b..7bac2e107 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux
@@ -19,7 +19,8 @@
     ["#/" //
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux
index 8dfb9668e..6e75f37bc 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/php/function.lux
@@ -20,7 +20,8 @@
     ["#/" //
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux
index c70ca9c37..ed6e53274 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/function.lux
@@ -19,7 +19,8 @@
     ["#/" //
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux
index ef3920d23..02e221894 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/function.lux
@@ -19,7 +19,8 @@
     ["#/" //
      ["." // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.lux
index 41a2e6b17..797e31e1d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/function.lux
@@ -21,7 +21,8 @@
     ["#/" // ("#;." monad)
      ["#/" // #_
       [reference (#+ Register Variable)]
-      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+      [arity (#+ Arity)]
+      [analysis (#+ Variant Tuple Environment Abstraction Application Analysis)]
       [synthesis (#+ Synthesis)]]]]])
 
 (def: #export (apply generate [functionS argsS+])
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux
index dbcc56e38..4e09f08e9 100644
--- a/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux
+++ b/stdlib/source/lux/tool/compiler/phase/synthesis/function.lux
@@ -15,8 +15,9 @@
    ["#." loop (#+ Transform)]
    ["#/" // ("#;." monad)
     ["#/" // #_
+     [arity (#+ Arity)]
      ["#." reference (#+ Register Variable)]
-     ["#." analysis (#+ Environment Arity Analysis)]
+     ["#." analysis (#+ Environment Analysis)]
      ["/" synthesis (#+ Path Synthesis Operation Phase)]]]])
 
 (exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment})
diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux
index 4c8959b26..e44432bcb 100644
--- a/stdlib/source/lux/tool/compiler/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/synthesis.lux
@@ -17,8 +17,9 @@
      ["." list ("#;." functor)]
      ["." dictionary (#+ Dictionary)]]]]
   ["." // #_
+   [arity (#+ Arity)]
    ["#." reference (#+ Register Variable Reference)]
-   ["#." analysis (#+ Environment Arity Composite Analysis)]
+   ["#." analysis (#+ Environment Composite Analysis)]
    ["#." phase
     ["." extension (#+ Extension)]]])
 
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 47ed621d8..18469e74e 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -136,8 +136,8 @@
                                                                    (do /instruction.monad
                                                                      [_ (/instruction.ldc/long (/constant.long expected))
                                                                       _ (/instruction.invokestatic "java.lang.Long" "valueOf"
-                                                                                                   (list /descriptor.long)
-                                                                                                   (/descriptor.object "java.lang.Long"))]
+                                                                                                   [(list /descriptor.long)
+                                                                                                    (/descriptor.object "java.lang.Long")])]
                                                                      /instruction.areturn)))
                                              (row.row))
                                (binaryF.run /class.writer))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
index db6c38eca..32044f5dc 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
@@ -26,8 +26,9 @@
       [extension
        ["#." bundle]]
       ["/#" //
+       [arity (#+ Arity)]
        ["#." reference (#+ Variable) ("variable@." equivalence)]
-       ["#." analysis (#+ Arity Analysis)]
+       ["#." analysis (#+ Analysis)]
        ["#." synthesis (#+ Synthesis)]]]]]})
 
 (def: constant-function