- Added custom equalities for a variety of collections.

2 files changed, 55 insertions, 18 deletions

diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 24e9c0be9..ecf5e2019 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -1,5 +1,5 @@
 (;module:
-  [lux #- list function]
+  [lux #- function]
   (lux (control monad
                 [eq])
        (data [text]
@@ -10,7 +10,8 @@
              [product]
              [bool]
              [char]
-             [maybe])
+             [maybe]
+             [ident "Ident/" Eq<Ident>])
        [macro #+ Monad<Lux> with-gensyms]
        (macro [code]
               ["s" syntax #+ syntax: Syntax]
@@ -209,21 +210,29 @@
         _
         (wrap [:func: (list;reverse :args:)])))))
 
-(do-template [<combinator> <name>]
-  [(def: #export <combinator>
-     (Matcher Type)
-     (;function [:type:]
-       (case (type;un-name :type:)
-         (^=> (#;App :quant: :arg:)
-              [(type;un-alias :quant:) (#;Named ["lux" <name>] _)])
-         (:: macro;Monad<Lux> wrap :arg:)
+(def: #export (apply-1 name)
+  (-> Ident (Matcher Type))
+  (;function [:type:]
+    (case (type;un-name :type:)
+      (^=> (#;App :quant: :arg:)
+           [(type;un-alias :quant:) (#;Named actual _)]
+           (Ident/= name actual))
+      (:: macro;Monad<Lux> wrap :arg:)
 
-         _
-         (macro;fail (format "Not " <name> " type: " (%type :type:))))))]
+      _
+      (macro;fail (format "Not " (%ident name) " type: " (%type :type:))))))
 
-  [maybe "Maybe"]
-  [list  "List"]
-  )
+(def: #export (apply-2 name)
+  (-> Ident (Matcher [Type Type]))
+  (;function [:type:]
+    (case (type;un-name :type:)
+      (^=> (#;App (#;App :quant: :arg0:) :arg1:)
+           [(type;un-alias :quant:) (#;Named actual _)]
+           (Ident/= name actual))
+      (:: macro;Monad<Lux> wrap [:arg0: :arg1:])
+
+      _
+      (macro;fail (format "Not " (%ident name) " type: " (%type :type:))))))
 
 (def: (adjusted-idx env idx)
   (-> Env Nat Nat)
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index f1a184c85..953891e1c 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -5,7 +5,13 @@
        (data [text]
              text/format
              (coll [list "List/" Monad<List>]
-                   [dict #+ Dict])
+                   [vector]
+                   [array]
+                   [queue]
+                   [set]
+                   [seq]
+                   [dict #+ Dict]
+                   (tree [rose]))
              [number]
              [product]
              [bool]
@@ -46,13 +52,35 @@
                  [Bool poly;bool bool;Eq<Bool>]
                  [Nat  poly;nat  number;Eq<Nat>]
                  [Int  poly;int  number;Eq<Int>]
-                 [Deg poly;deg number;Eq<Deg>]
+                 [Deg  poly;deg  number;Eq<Deg>]
                  [Real poly;real number;Eq<Real>]
                  [Char poly;char char;Eq<Char>]
-                 [Text poly;text text;Eq<Text>])]
+                 [Text poly;text text;Eq<Text>])
+       <composites> (do-template [<name> <eq>]
+                      [(do @
+                         [:arg: (poly;apply-1 (ident-for <name>) :x:)
+                          g!arg (Eq<?> env :arg:)]
+                         (wrap (` (: (~ (->Eq (type;to-ast :x:)))
+                                     (<eq> (~ g!arg))))))]
+
+                      [list;List     list;Eq<List>]
+                      [vector;Vector vector;Eq<Vector>]
+                      [array;Array   array;Eq<Array>]
+                      [queue;Queue   queue;Eq<Queue>]
+                      [set;Set       set;Eq<Set>]
+                      [seq;Seq       seq;Eq<Seq>]
+                      [rose;Tree     rose;Eq<Tree>]
+                      )]
       ($_ macro;either
           ## Primitive types
           <basic>
+          ## Composite types
+          <composites>
+          (do @
+            [[:key: :val:] (poly;apply-2 (ident-for dict;Dict) :x:)
+             g!val (Eq<?> env :val:)]
+            (wrap (` (: (~ (->Eq (type;to-ast :x:)))
+                        (dict;Eq<Dict> (~ g!val))))))
           ## Variants
           (with-gensyms [g!type-fun g!left g!right]
             (do @