WIP: Method compilation.

10 files changed, 138 insertions, 39 deletions

diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index d7abd617c..5e35829c8 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -33,12 +33,16 @@
   (-> [Offset Binary] [Offset Binary]))
 
 (type: #export Specification
-  [Size (-> [Offset Binary] [Offset Binary])])
+  [Size Mutation])
 
 (def: #export no-op
   Specification
   [0 function.identity])
 
+(def: #export (instance [size mutation])
+  (-> Specification Binary)
+  (|> size binary.create [0] mutation product.right))
+
 (structure: #export monoid (Monoid Specification)
   
   (def: identity
@@ -53,8 +57,7 @@
 
 (def: #export (run writer value)
   (All [a] (-> (Writer a) a Binary))
-  (let [[valueS valueT] (writer value)]
-    (|> valueS binary.create [0] valueT product.right)))
+  (instance (writer value)))
 
 (template [<name> <size> <write>]
   [(def: #export <name>
diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux
index 516dec1fc..a99637dcd 100644
--- a/stdlib/source/lux/target/jvm/class.lux
+++ b/stdlib/source/lux/target/jvm/class.lux
@@ -74,12 +74,12 @@
   (-> Internal Internal (List Internal)
       (State Pool [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))]))
   (do state.monad
-    [@this (//constant/pool.class (//name.read this))
-     @super (//constant/pool.class (//name.read super))
+    [@this (//constant/pool.class this)
+     @super (//constant/pool.class super)
      @interfaces (: (State Pool (Row (Index //constant.Class)))
                     (monad.fold @ (function (_ interface @interfaces)
                                     (do @
-                                      [@interface (//constant/pool.class (//name.read interface))]
+                                      [@interface (//constant/pool.class interface)]
                                       (wrap (row.add @interface @interfaces))))
                                 row.empty
                                 interfaces))]
@@ -91,15 +91,16 @@
   (-> Major (Modifier Class)
       Internal Internal (List Internal)
       (List (State Pool Field))
-      (Row Method)
+      (List (State Pool Method))
       (Row Attribute)
       Class)
-  (let [[pool [@this @super @interfaces] =fields]
+  (let [[pool [@this @super @interfaces] =fields =methods]
         (state.run //constant/pool.empty
                    (do state.monad
                      [classes (install-classes this super interfaces)
-                      =fields (monad.seq state.monad fields)]
-                     (wrap [classes =fields])))]
+                      =fields (monad.seq state.monad fields)
+                      =methods (monad.seq state.monad methods)]
+                     (wrap [classes =fields =methods])))]
     {#magic //magic.code
      #minor-version //version.default-minor
      #major-version version
@@ -109,7 +110,7 @@
      #super @super
      #interfaces @interfaces
      #fields (row.from-list =fields)
-     #methods methods
+     #methods (row.from-list =methods)
      #attributes attributes}))
 
 (def: #export parser
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index 31dfe3bbb..36c131b00 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -114,7 +114,7 @@
    #name-and-type (Index (Name-And-Type of))})
 
 (template [<type> <equivalence> <parser> <writer>]
-  [(def: <equivalence>
+  [(def: #export <equivalence>
      (Equivalence (<type> Any))
      ($_ equivalence.product
          //index.equivalence
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index dc500c885..5d8636deb 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -24,12 +24,13 @@
     abstract]
    [macro
     ["." template]]]
-  ["." // (#+ UTF8 Class Long Double Constant)
+  ["." // (#+ UTF8 Class Long Double Constant Name-And-Type Reference)
    [//
     [encoding
-     ["." unsigned]]
-    ["." index (#+ Index)]
-    ["." descriptor (#+ Descriptor)]]])
+     ["#." name (#+ Internal External)]
+     ["#." unsigned]]
+    ["#." index (#+ Index)]
+    ["#." descriptor (#+ Field Method Descriptor)]]])
 
 (def: offset 1)
 
@@ -41,7 +42,7 @@
 
 (template: (!add <tag> <=> <value>)
   (function (_ pool)
-    (with-expansions [<index> (as-is (index.index (unsigned.u2 (n/+ offset idx))))
+    (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
                       <try-again> (as-is (recur (.inc idx)))]
       (loop [idx 0]
         (case (row.nth idx pool)
@@ -61,7 +62,7 @@
            <index>])))))
 
 (template: (!raw-index <index>)
-  (|> <index> index.number unsigned.nat .nat))
+  (|> <index> //index.number //unsigned.nat .nat))
 
 (exception: #export (invalid-index {index (Index Any)}
                                    {maximum Nat})
@@ -97,7 +98,7 @@
 
 (template: (!find <tag> <=> <%> <expected>)
   (function (_ pool)
-    (with-expansions [<index> (as-is (index.index (unsigned.u2 (n/+ offset idx))))
+    (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
                       <try-again> (as-is (recur (.inc idx)))]
       (loop [idx 0]
         (case (row.nth idx pool)
@@ -143,23 +144,49 @@
   [utf8 UTF8 #//.UTF8 text.equivalence %.text]
   )
 
-(def: (class' value)
-  (Adder Class)
-  (!add #//.Class //.class-equivalence value))
-
 (def: #export (class name)
-  (-> UTF8 (State Pool (Index Class)))
+  (-> Internal (State Pool (Index Class)))
   (do state.monad
-    [@name (utf8 name)]
-    (class' (//.class @name))))
+    [@name (utf8 (//name.read name))
+     #let [value (//.class @name)]]
+    (!add #//.Class //.class-equivalence value)))
 
 (def: #export (descriptor value)
   (All [kind]
     (-> (Descriptor kind)
         (State Pool (Index (Descriptor kind)))))
-  (let [value (descriptor.descriptor value)]
+  (let [value (//descriptor.descriptor value)]
     (!add #//.UTF8 text.equivalence value)))
 
+(type: #export (Member of)
+  {#name UTF8
+   #descriptor (Descriptor of)})
+
+(def: #export (name-and-type [name descriptor])
+  (All [of]
+    (-> (Member of) (State Pool (Index (Name-And-Type of)))))
+  (do state.monad
+    [@name (utf8 name)
+     @descriptor (..descriptor descriptor)]
+    (!add #//.Name-And-Type //.name-and-type-equivalence
+          {#//.name @name
+           #//.descriptor @descriptor})))
+
+(template [<name> <tag> <of>]
+  [(def: #export (<name> class member)
+     (-> External (Member <of>) (State Pool (Index (Reference <of>))))
+     (do state.monad
+       [@class (..class (//name.internal class))
+        @name-and-type (name-and-type member)]
+       (!add <tag> //.reference-equivalence
+             {#//.class @class
+              #//.name-and-type @name-and-type})))]
+
+  [field #//.Field Field]
+  [method #//.Method Method]
+  [interface-method #//.Interface-Method Method]
+  )
+
 (def: #export parser
   (Parser Pool)
   (<2>.row/16' ..offset //.parser))
diff --git a/stdlib/source/lux/target/jvm/descriptor.lux b/stdlib/source/lux/target/jvm/descriptor.lux
index c0cb20a61..1ca625bd6 100644
--- a/stdlib/source/lux/target/jvm/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/descriptor.lux
@@ -4,14 +4,14 @@
     ["." text
      ["%" format (#+ format)]]
     [collection
-     ["." list ("#;." functor)]]]
+     ["." list ("#@." functor)]]]
    [macro
     ["." template]]
    [type
     abstract]]
   ["." // #_
    [encoding
-    ["#." name (#+ Internal)]]])
+    ["#." name (#+ External)]]])
 
 (abstract: #export Void' {} Any)
 
@@ -57,8 +57,9 @@
     )
 
   (def: #export object
-    (-> Internal (Descriptor Object))
-    (|>> //name.read
+    (-> External (Descriptor Object))
+    (|>> //name.internal
+         //name.read
          (text.enclose ["L" ";"])
          :abstraction))
 
@@ -75,7 +76,7 @@
         (Descriptor Method))
     (:abstraction
      (format (|> inputs
-                 (list;map (|>> :representation))
+                 (list@map (|>> :representation))
                  (text.join-with "")
                  (text.enclose ["(" ")"]))
              (:representation output))))
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index e6ee82617..d081d1c81 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -1,13 +1,13 @@
 (.module:
   [lux (#- static)
    [abstract
-    ["." equivalence (#+ Equivalence)]
     [monoid (#+)]
+    ["." equivalence (#+ Equivalence)]
     ["." monad (#+ do)]]
    [control
+    ["." state (#+ State)]
     ["<>" parser
-     ["<2>" binary (#+ Parser)]]
-    ["." state (#+ State)]]
+     ["<2>" binary (#+ Parser)]]]
    [data
     [number (#+)
      [i64 (#+)]]
@@ -23,7 +23,7 @@
    ["#." attribute (#+ Attribute)]
    ["#." descriptor (#+ Descriptor)]
    ["#." constant (#+ UTF8)
-    [pool (#+ Pool)]]])
+    ["#/." pool (#+ Pool)]]])
 
 (type: #export #rec Method
   {#modifier (Modifier Method)
@@ -46,6 +46,18 @@
   ["1000" synthetic]
   )
 
+(def: #export (method modifier name descriptor attributes)
+  (-> (Modifier Method) UTF8 (Descriptor //descriptor.Method) (List (State Pool Attribute))
+      (State Pool Method))
+  (do state.monad
+    [@name (//constant/pool.utf8 name)
+     @descriptor (//constant/pool.descriptor descriptor)
+     attributes (monad.seq @ attributes)]
+    (wrap {#modifier modifier
+           #name @name
+           #descriptor @descriptor
+           #attributes (row.from-list attributes)})))
+
 (def: #export equivalence
   (Equivalence Method)
   ($_ equivalence.product
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index 61e5a9046..fd786d619 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -15,6 +15,7 @@
     [number
      ["." nat]]
     [collection
+     ["." list ("#@." functor fold)]
      ["." dictionary (#+ Dictionary)]]]]
   ["." / #_
    ["#." condition (#+ Local)]
@@ -22,7 +23,9 @@
    ["#." instruction (#+ Primitive-Array-Type Instruction) ("#@." monoid)]
    ["/#" // #_
     ["#." index]
+    ["#." descriptor (#+ Descriptor Value Return)]
     [encoding
+     ["#." name (#+ External)]
      ["#." unsigned (#+ U1 U2)]
      ["#." signed]]
     ["#." constant (#+ UTF8)
@@ -428,7 +431,7 @@
      (-> UTF8 (Program Any))
      (do ..monad
        ## TODO: Make sure it"s impossible to have indexes greater than U2.
-       [index (..lift (//constant/pool.class class))]
+       [index (..lift (//constant/pool.class (//name.internal class)))]
        (..nullary (<instruction> index))))]
 
   [new /instruction.new]
@@ -442,7 +445,44 @@
   (..nullary (/instruction.iinc register increase)))
 
 (def: #export (multianewarray class count)
-  (-> UTF8 U1 (Program Any))
+  (-> External U1 (Program Any))
   (do ..monad
-    [index (..lift (//constant/pool.class class))]
+    [index (..lift (//constant/pool.class (//name.internal class)))]
     (..nullary (/instruction.multianewarray index count))))
+
+(def: (descriptor-size descriptor)
+  (-> (Descriptor (Return Any)) U1)
+  (//unsigned.u1
+   (cond (is? //descriptor.void descriptor)
+         0
+
+         (is? //descriptor.long descriptor)
+         2
+
+         (is? //descriptor.double descriptor)
+         2
+         
+         ## else
+         1)))
+
+(template [<static?> <name> <instruction>]
+  [(def: #export (<name> class method inputs output)
+     (-> External Text (List (Descriptor (Value Any))) (Descriptor (Return Any)) (Program Any))
+     (do ..monad
+       [index (<| ..lift
+                  (//constant/pool.method class)
+                  {#//constant/pool.name method
+                   #//constant/pool.descriptor (//descriptor.method inputs output)})]
+       (wrap (/instruction.invokestatic
+              index
+              (|> inputs
+                  (list@map descriptor-size)
+                  (list@fold //unsigned.u1/+ (//unsigned.u1 0))
+                  (//unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
+              (descriptor-size output)))))]
+
+  [#1 invokestatic /instruction.invokestatic]
+  [#0 invokevirtual /instruction.invokevirtual]
+  [#0 invokespecial /instruction.invokespecial]
+  [#0 invokeinterface /instruction.invokeinterface]
+  )
diff --git a/stdlib/source/lux/target/jvm/program/condition.lux b/stdlib/source/lux/target/jvm/program/condition.lux
index e0b778c07..04bb8c60b 100644
--- a/stdlib/source/lux/target/jvm/program/condition.lux
+++ b/stdlib/source/lux/target/jvm/program/condition.lux
@@ -23,6 +23,11 @@
   {#resources Resources
    #stack U2})
 
+(def: #export start
+  Environment
+  {#resources //resources.start
+   #stack (///unsigned.u2 0)})
+
 (type: #export Condition
   (-> Environment (Try Environment)))
 
diff --git a/stdlib/source/lux/target/jvm/program/instruction.lux b/stdlib/source/lux/target/jvm/program/instruction.lux
index 375204cc8..3d0397a14 100644
--- a/stdlib/source/lux/target/jvm/program/instruction.lux
+++ b/stdlib/source/lux/target/jvm/program/instruction.lux
@@ -34,6 +34,11 @@
 (type: #export Instruction
   [Size (-> [Environment Specification] (Try [Environment Specification]))])
 
+(def: #export (run instruction)
+  (-> Instruction (Try [Environment Specification]))
+  (let [[_ instruction'] instruction]
+    (instruction' [/.start binaryF.no-op])))
+
 (def: (instruction size condition transform)
   (-> Size Condition (-> Specification Specification) Instruction)
   [size
diff --git a/stdlib/source/lux/target/jvm/program/resources.lux b/stdlib/source/lux/target/jvm/program/resources.lux
index fed6d4ce7..980104e72 100644
--- a/stdlib/source/lux/target/jvm/program/resources.lux
+++ b/stdlib/source/lux/target/jvm/program/resources.lux
@@ -16,6 +16,11 @@
   {#max-stack U2
    #max-locals U2})
 
+(def: #export start
+  Resources
+  {#max-stack (///unsigned.u2 0)
+   #max-locals (///unsigned.u2 0)})
+
 (def: #export length
   ($_ n/+
       ## u2 max_stack;