From ecd1e053a413c5d7caebc2ae0ac2520d827fcd79 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 25 Dec 2018 16:51:35 -0400
Subject: Added contravariant functors.

---
 stdlib/source/lux/control/equivalence.lux | 40 ++++++++++++++++++++-----------
 stdlib/source/lux/control/functor.lux     |  6 +++++
 stdlib/source/lux/control/order.lux       | 17 ++++++++++++-
 stdlib/source/lux/control/predicate.lux   |  7 +++++-
 stdlib/source/lux/type.lux                |  1 +
 stdlib/source/lux/type/abstract.lux       |  2 ++
 6 files changed, 57 insertions(+), 16 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/control/equivalence.lux b/stdlib/source/lux/control/equivalence.lux
index c10b0c295..1b1cc45d3 100644
--- a/stdlib/source/lux/control/equivalence.lux
+++ b/stdlib/source/lux/control/equivalence.lux
@@ -1,4 +1,7 @@
-(.module: lux)
+(.module:
+  [lux #*
+   [control
+    [functor (#+ Contravariant)]]])
 
 (signature: #export (Equivalence a)
   {#.doc "Equivalence for a type's instances."}
@@ -7,24 +10,33 @@
 
 (def: #export (product left right)
   (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence [l r])))
-  (structure (def: (= [a b] [x y])
-               (and (:: left = a x)
-                    (:: right = b y)))))
+  (structure
+   (def: (= [a b] [x y])
+     (and (:: left = a x)
+          (:: right = b y)))))
 
 (def: #export (sum left right)
   (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence (| l r))))
-  (structure (def: (= a|b x|y)
-               (case [a|b x|y]
-                 [(0 a) (0 x)]
-                 (:: left = a x)
+  (structure
+   (def: (= a|b x|y)
+     (case [a|b x|y]
+       [(0 a) (0 x)]
+       (:: left = a x)
 
-                 [(1 b) (1 y)]
-                 (:: right = b y)
+       [(1 b) (1 y)]
+       (:: right = b y)
 
-                 _
-                 #0))))
+       _
+       #0))))
 
 (def: #export (rec sub)
   (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a)))
-  (structure (def: (= left right)
-               (sub (rec sub) left right))))
+  (structure
+   (def: (= left right)
+     (sub (rec sub) left right))))
+
+(structure: #export _ (Contravariant Equivalence)
+  (def: (map-1 f Equivalence<b>)
+    (structure
+     (def: (= reference sample)
+       (:: Equivalence<b> = (f reference) (f sample))))))
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index b8ad0b159..00a5c776b 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -24,3 +24,9 @@
 
   (def: (map f fga)
     (:: Functor<F> map (:: Functor<G> map f) fga)))
+
+(signature: #export (Contravariant f)
+  (: (All [a b]
+       (-> (-> a b)
+           (-> (f b) (f a))))
+     map-1))
diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux
index 30618b317..4375f4e7c 100644
--- a/stdlib/source/lux/control/order.lux
+++ b/stdlib/source/lux/control/order.lux
@@ -1,7 +1,10 @@
 (.module:
   [lux #*
+   [control
+    [functor (#+ Contravariant)]]
    function]
-  [// [equivalence (#+ Equivalence)]])
+  [//
+   ["." equivalence (#+ Equivalence)]])
 
 ## [Signatures]
 (`` (signature: #export (Order a)
@@ -41,3 +44,15 @@
   [min <]
   [max >]
   )
+
+(`` (structure: #export _ (Contravariant Order)
+      (def: (map-1 f Order<b>)
+        (structure
+         (def: eq (:: equivalence.Contravariant<Equivalence> map-1 f (:: Order<b> eq)))
+         
+         (~~ (do-template [<name>]
+               [(def: (<name> reference sample)
+                  (:: Order<b> <name> (f reference) (f sample)))]
+
+               [<] [<=] [>] [>=]
+               ))))))
diff --git a/stdlib/source/lux/control/predicate.lux b/stdlib/source/lux/control/predicate.lux
index 500395cbf..605426da4 100644
--- a/stdlib/source/lux/control/predicate.lux
+++ b/stdlib/source/lux/control/predicate.lux
@@ -1,7 +1,8 @@
 (.module:
   [lux #*
    [control
-    [monoid (#+ Monoid)]]
+    [monoid (#+ Monoid)]
+    [functor (#+ Contravariant)]]
    ["." function]])
 
 (type: #export (Predicate a)
@@ -46,3 +47,7 @@
     (-> (-> (Predicate a) (Predicate a))
         (Predicate a)))
   (|>> (predicate (rec predicate))))
+
+(structure: #export _ (Contravariant Predicate)
+  (def: (map-1 f fb)
+    (|>> f fb)))
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 6dcc8981d..1312e2a82 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -380,6 +380,7 @@
   (Syntax Typed)
   (s.record (p.and s.any s.any)))
 
+## TODO: Make sure the generated code always gets optimized away.
 (syntax: #export (:share {type-vars type-parameters}
                          {exemplar typed}
                          {computation typed})
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 1ed24af1d..6eb16df4d 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -142,6 +142,8 @@
   (p.either (s.form (p.and s.local-identifier (p.some s.local-identifier)))
             (p.and s.local-identifier (:: p.Monad<Parser> wrap (list)))))
 
+## TODO: Make sure the generated code always gets optimized away.
+## (This applies to uses of ":abstraction" and ":representation")
 (syntax: #export (abstract:
                    {export csr.export}
                    {[name type-vars] declaration}
-- 
cgit v1.2.3