From 6cb445ad8bd6c4d3db62250d9626a9a4e228d84d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 28 Dec 2018 23:37:36 -0400
Subject: Added equivalences.

---
 stdlib/source/lux/host/jvm/attribute.lux      | 18 ++++++++++++++
 stdlib/source/lux/host/jvm/class.lux          | 36 +++++++++++++++++++++------
 stdlib/source/lux/host/jvm/constant.lux       |  7 ++++++
 stdlib/source/lux/host/jvm/constant/pool.lux  |  9 +++++++
 stdlib/source/lux/host/jvm/field.lux          | 23 ++++++++++++++++-
 stdlib/source/lux/host/jvm/method.lux         |  9 +++++++
 stdlib/source/lux/host/jvm/modifier.lux       |  7 ++++++
 stdlib/source/lux/host/jvm/modifier/inner.lux |  1 +
 8 files changed, 102 insertions(+), 8 deletions(-)

(limited to 'stdlib/source')

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
-- 
cgit v1.2.3