Added equivalences.

9 files changed, 130 insertions, 35 deletions

diff --git a/stdlib/source/lux/host/jvm/attribute.lux b/stdlib/source/lux/host/jvm/attribute.lux
index 87891f35c..41928e704 100644
--- a/stdlib/source/lux/host/jvm/attribute.lux
+++ b/stdlib/source/lux/host/jvm/attribute.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux (#- Info Code' Code)
    [control
+    ["." equivalence (#+ Equivalence)]
     [monad (#+ do)]
     ["." state (#+ State)]]
    [data
@@ -21,6 +22,15 @@
    #length U4
    #info about})
 
+(def: #export (Equivalence<Info> Equivalence<about>)
+  (All [about]
+    (-> (Equivalence about)
+        (Equivalence (Info about))))
+  ($_ equivalence.product
+      //index.Equivalence<Index>
+      //encoding.Equivalence<U4>
+      Equivalence<about>))
+
 (def: (info-format about)
   (All [about]
     (-> (Format about)
@@ -33,6 +43,10 @@
 (type: #export Constant
   (Info (Index (Value Any))))
 
+(def: #export Equivalence<Constant>
+  (Equivalence Constant)
+  (..Equivalence<Info> //index.Equivalence<Index>))
+
 (def: constant-format
   (Format Constant)
   (..info-format //index.format))
@@ -62,6 +76,10 @@
   ##   <Code>)
   )
 
+(def: #export Equivalence<Attribute>
+  (Equivalence Attribute)
+  ..Equivalence<Constant>)
+
 (def: #export (constant index)
   (-> (Index (Value Any))
       (State Pool Attribute))
diff --git a/stdlib/source/lux/host/jvm/class.lux b/stdlib/source/lux/host/jvm/class.lux
index ca5e8f61f..30959c8ef 100644
--- a/stdlib/source/lux/host/jvm/class.lux
+++ b/stdlib/source/lux/host/jvm/class.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
    [control
+    ["." equivalence (#+ Equivalence)]
     [monoid (#+)]
     [parser (#+)]
     ["." monad (#+ do)]
@@ -43,7 +44,7 @@
    #minor-version Minor
    #major-version Major
    #constant-pool Pool
-   #access-flags Modifier
+   #modifier Modifier
    #this (Index //constant.Class)
    #super (Index //constant.Class)
    #interfaces (Row (Index //constant.Class))
@@ -51,6 +52,21 @@
    #methods (Row Method)
    #attributes (Row Attribute)})
 
+(def: #export Equivalence<Class>
+  (Equivalence Class)
+  ($_ equivalence.product
+      //encoding.Equivalence<U4>
+      //encoding.Equivalence<U2>
+      //encoding.Equivalence<U2>
+      //pool.Equivalence<Pool>
+      ..Equivalence<Modifier>
+      //index.Equivalence<Index>
+      //index.Equivalence<Index>
+      (row.Equivalence<Row> //index.Equivalence<Index>)
+      (row.Equivalence<Row> //field.Equivalence<Field>)
+      (row.Equivalence<Row> //method.Equivalence<Method>)
+      (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+
 (def: default-minor-version Minor (//version.version 0))
 
 (def: (install-classes this super interfaces)
@@ -68,24 +84,30 @@
                                 interfaces))]
     (wrap [@this @super @interfaces])))
 
-(def: #export (class version access
+(def: #export (class version modifier
                      super this interfaces
                      fields methods attributes)
   (-> Major Modifier
       Internal Internal (List Internal)
-      (Row Field) (Row Method) (Row Attribute)
+      (List (State Pool Field))
+      (Row Method)
+      (Row Attribute)
       Class)
-  (let [[pool [@this @super @interfaces]] (state.run (: Pool row.empty)
-                                                     (install-classes this super interfaces))]
+  (let [[pool [@this @super @interfaces] =fields]
+        (state.run //pool.empty
+                   (do state.Monad<State>
+                     [classes (install-classes this super interfaces)
+                      =fields (monad.seq state.Monad<State> fields)]
+                     (wrap [classes =fields])))]
     {#magic //magic.code
      #minor-version ..default-minor-version
      #major-version version
      #constant-pool pool
-     #access-flags access
+     #modifier modifier
      #this @this
      #super @super
      #interfaces @interfaces
-     #fields fields
+     #fields (row.from-list =fields)
      #methods methods
      #attributes attributes}))
 
diff --git a/stdlib/source/lux/host/jvm/constant.lux b/stdlib/source/lux/host/jvm/constant.lux
index 913c9043b..184c3a5a8 100644
--- a/stdlib/source/lux/host/jvm/constant.lux
+++ b/stdlib/source/lux/host/jvm/constant.lux
@@ -5,6 +5,7 @@
     ["." parser]
     ["." equivalence (#+ Equivalence)]]
    [data
+    ["." text]
     [format
      ["." binary (#+ Format) ("mutation/." Monoid<Mutation>)]]
     [collection
@@ -76,6 +77,12 @@
   (#UTF8 UTF8)
   (#Class Class))
 
+(def: #export Equivalence<Constant>
+  (Equivalence Constant)
+  ($_ equivalence.sum
+      text.Equivalence<Text>
+      ..Equivalence<Class>))
+
 (def: #export format
   (Format Constant)
   (with-expansions [<constants> (as-is [#UTF8  /tag.utf8  ..utf8-format]
diff --git a/stdlib/source/lux/host/jvm/constant/pool.lux b/stdlib/source/lux/host/jvm/constant/pool.lux
index 5761fd6fc..d1da6f606 100644
--- a/stdlib/source/lux/host/jvm/constant/pool.lux
+++ b/stdlib/source/lux/host/jvm/constant/pool.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
    [control
+    ["." equivalence (#+ Equivalence)]
     [monad (#+ do)]
     ["." state (#+ State)]]
    [data
@@ -22,6 +23,10 @@
 
 (type: #export Pool (Row Constant))
 
+(def: #export Equivalence<Pool>
+  (Equivalence Pool)
+  (row.Equivalence<Row> //.Equivalence<Constant>))
+
 (template: (!add <value> <tag> <=>)
   (function (_ pool)
     (with-expansions [<index> (as-is (index.index (encoding.to-u2 (n/+ offset idx))))
@@ -67,3 +72,7 @@
 (def: #export format
   (Format Pool)
   (binary.row/16' ..offset //.format))
+
+(def: #export empty
+  Pool
+  row.empty)
diff --git a/stdlib/source/lux/host/jvm/field.lux b/stdlib/source/lux/host/jvm/field.lux
index 802670780..3e1de173a 100644
--- a/stdlib/source/lux/host/jvm/field.lux
+++ b/stdlib/source/lux/host/jvm/field.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux (#- static)
    [control
+    ["." equivalence (#+ Equivalence)]
     [monoid (#+)]
     [parser (#+)]
     ["." monad (#+ do)]
@@ -17,7 +18,8 @@
   [//
    [encoding (#+)]
    [modifier (#+ modifiers:)]
-   ["//." constant (#+ UTF8)]
+   ["//." constant (#+ UTF8)
+    ["//." pool (#+ Pool)]]
    ["//." index (#+ Index)]
    ["//." attribute (#+ Attribute)]
    ["//." descriptor (#+ Descriptor Value)]])
@@ -40,6 +42,14 @@
    #descriptor (Index (Descriptor (Value Any)))
    #attributes (Row Attribute)})
 
+(def: #export Equivalence<Field>
+  (Equivalence Field)
+  ($_ equivalence.product
+      ..Equivalence<Modifier>
+      //index.Equivalence<Index>
+      //index.Equivalence<Index>
+      (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+
 (def: #export format
   (Format Field)
   ($_ binary.and
@@ -47,3 +57,14 @@
       //index.format
       //index.format
       (binary.row/16 //attribute.format)))
+
+(def: #export (field modifier name descriptor attributes)
+  (-> Modifier UTF8 (Descriptor (Value Any)) (Row Attribute)
+      (State Pool Field))
+  (do state.Monad<State>
+    [@name (//pool.utf8 name)
+     @descriptor (//pool.descriptor descriptor)]
+    (wrap {#modifier modifier
+           #name @name
+           #descriptor @descriptor
+           #attributes attributes})))
diff --git a/stdlib/source/lux/host/jvm/method.lux b/stdlib/source/lux/host/jvm/method.lux
index d7e8354e8..7bdc147da 100644
--- a/stdlib/source/lux/host/jvm/method.lux
+++ b/stdlib/source/lux/host/jvm/method.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux (#- static)
    [control
+    ["." equivalence (#+ Equivalence)]
     [monoid (#+)]
     [parser (#+)]
     ["." monad (#+ do)]
@@ -43,6 +44,14 @@
    #descriptor (Index (Descriptor //descriptor.Method))
    #attributes (Row Attribute)})
 
+(def: #export Equivalence<Method>
+  (Equivalence Method)
+  ($_ equivalence.product
+      ..Equivalence<Modifier>
+      //index.Equivalence<Index>
+      //index.Equivalence<Index>
+      (row.Equivalence<Row> //attribute.Equivalence<Attribute>)))
+
 (def: #export format
   (Format Method)
   ($_ binary.and
diff --git a/stdlib/source/lux/host/jvm/modifier.lux b/stdlib/source/lux/host/jvm/modifier.lux
index 0263fc1ec..b5bc1fef8 100644
--- a/stdlib/source/lux/host/jvm/modifier.lux
+++ b/stdlib/source/lux/host/jvm/modifier.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
    [control
+    ["." equivalence]
     ["." monoid]
     ["." parser]]
    [data
@@ -61,6 +62,12 @@
                        (~+ (list/map ..code options))
                        )
 
+                     (.structure: (~' #export) (~' _) (equivalence.Equivalence (~ g!name))
+                       (.def: ((~' =) (~' reference) (~' sample))
+                         (.:: //encoding.Equivalence<U2> (~' =)
+                           ((~' :representation) (~' reference))
+                           ((~' :representation) (~' sample)))))
+
                      (.def: (~' #export) (~ g!format)
                        (binary.Format (~ g!name))
                        (.let [(.^open "_/.") //encoding.u2-format]
diff --git a/stdlib/source/lux/host/jvm/modifier/inner.lux b/stdlib/source/lux/host/jvm/modifier/inner.lux
index 3b33ed477..9f57965d0 100644
--- a/stdlib/source/lux/host/jvm/modifier/inner.lux
+++ b/stdlib/source/lux/host/jvm/modifier/inner.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux (#- static)
    [control
+    [equivalence (#+)]
     [monoid (#+)]
     [parser (#+)]]
    [data
diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux
index 309deb800..b293c811f 100644
--- a/stdlib/test/test/lux/host/jvm.jvm.lux
+++ b/stdlib/test/test/lux/host/jvm.jvm.lux
@@ -22,6 +22,7 @@
      ["/." loader (#+ Library)]
      ["/." version]
      ["/." name]
+     ["/." descriptor]
      ["/." field]
      ["/." class]
      [modifier
@@ -43,42 +44,42 @@
               (format "Wrote: " (%t file-path))
               
               (#error.Failure error)
-              error)))))
+              ## TODO: Remove 'log!' call.
+              (exec (log! error)
+                error))))))
 
 (context: "Class"
   (let [package "my.package"
         name "MyClass"
         full-name (format package "." name)
-        class (/class.class /version.v6_0 /class.public
+        input (/class.class /version.v6_0 /class.public
                             (/name.internal "java.lang.Object")
                             (/name.internal full-name)
                             (list (/name.internal "java.io.Serializable")
                                   (/name.internal "java.lang.Runnable"))
-                            (row.row)
+                            (list (/field.field /field.public "foo" /descriptor.long (row.row))
+                                  (/field.field /field.public "bar" /descriptor.double (row.row)))
                             (row.row)
                             (row.row))
-        bytecode (binary.write /class.format class)
+        bytecode (binary.write /class.format input)
         loader (/loader.memory (/loader.new-library []))]
-    (exec
-      ## TODO: Remove 'write-class' call.
-      (io.run (..write-class name))
-      ($_ seq
-          (test "Can read a generated class."
-                (case (binary.read /class.format bytecode)
-                  (#error.Success class)
-                  true
-                  
-                  (#error.Failure error)
-                  ## TODO: Remove 'log!' call.
-                  (exec (log! error)
-                    false)))
-          (test "Can generate a class."
-                (case (/loader.define full-name bytecode loader)
-                  (#error.Success definition)
-                  true
-                  
-                  (#error.Failure error)
-                  ## TODO: Remove 'log!' call.
-                  (exec (log! error)
-                    false)))
-          ))))
+    ($_ seq
+        (test "Can read a generated class."
+              (case (binary.read /class.format bytecode)
+                (#error.Success output)
+                (:: /class.Equivalence<Class> = input output)
+                
+                (#error.Failure error)
+                ## TODO: Remove 'log!' call.
+                (exec (log! error)
+                  false)))
+        (test "Can generate a class."
+              (case (/loader.define full-name bytecode loader)
+                (#error.Success definition)
+                true
+                
+                (#error.Failure error)
+                ## TODO: Remove 'log!' call.
+                (exec (log! error)
+                  false)))
+        )))