From 3f010de748ffccf304c4be09863f77d4020d610d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 25 Aug 2022 21:31:54 -0400
Subject: Added support for type-based polymorphism.

---
 stdlib/source/test/lux/control/function.lux        |  5 ++-
 .../lux/control/function/polymorphism/type.lux     | 41 ++++++++++++++++++
 stdlib/source/test/lux/meta/type.lux               |  4 +-
 stdlib/source/test/lux/meta/type/poly.lux          | 48 ++++++++++++++++++++++
 4 files changed, 96 insertions(+), 2 deletions(-)
 create mode 100644 stdlib/source/test/lux/control/function/polymorphism/type.lux
 create mode 100644 stdlib/source/test/lux/meta/type/poly.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index aad5f2ebf..d87f6f3cd 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -23,7 +23,9 @@
   ["[1][0]" predicate]
   ["[1][0]" variadic]
   ["[1][0]" named]
-  ["[1][0]" trampoline]])
+  ["[1][0]" trampoline]
+  ["[1][0]" polymorphism
+   ["[1]/[0]" type]]])
 
 (def .public test
   Test
@@ -73,4 +75,5 @@
              /variadic.test
              /named.test
              /trampoline.test
+             /polymorphism/type.test
              ))))
diff --git a/stdlib/source/test/lux/control/function/polymorphism/type.lux b/stdlib/source/test/lux/control/function/polymorphism/type.lux
new file mode 100644
index 000000000..a5ed74cca
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/polymorphism/type.lux
@@ -0,0 +1,41 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [data
+    ["[0]" text (.use "[1]#[0]" equivalence)
+     ["%" \\format]]]
+   [math
+    ["[0]" random]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(/.def .public format
+  [a]
+  (-> a Text)
+
+  (/.method format
+    [Bit]
+    %.bit)
+
+  (/.method (format it)
+    [Nat]
+    (%.nat it))
+  )
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [bit random.bit
+         nat random.nat])
+      (all _.and
+           (_.coverage [/.def /.method]
+             (and (text#= (%.bit bit)
+                          (format bit))
+                  (text#= (%.nat nat)
+                          (format nat))))
+           )))
diff --git a/stdlib/source/test/lux/meta/type.lux b/stdlib/source/test/lux/meta/type.lux
index 3c6872d26..67119dd60 100644
--- a/stdlib/source/test/lux/meta/type.lux
+++ b/stdlib/source/test/lux/meta/type.lux
@@ -41,7 +41,8 @@
   ["[1][0]" refinement]
   ["[1][0]" resource]
   ["[1][0]" unit]
-  ["[1][0]" variance]])
+  ["[1][0]" variance]
+  ["[1][0]" poly]])
 
 (def !expect
   (template (_ <pattern> <value>)
@@ -570,4 +571,5 @@
            /resource.test
            /unit.test
            /variance.test
+           /poly.test
            )))
diff --git a/stdlib/source/test/lux/meta/type/poly.lux b/stdlib/source/test/lux/meta/type/poly.lux
new file mode 100644
index 000000000..e2aa7d03e
--- /dev/null
+++ b/stdlib/source/test/lux/meta/type/poly.lux
@@ -0,0 +1,48 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["?" parser]]
+   [data
+    ["[0]" bit (.use "[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random]
+    [number
+     ["[0]" nat (.use "[1]#[0]" equivalence)]]]
+   [meta
+    ["[0]" static]
+    ["[0]" type
+     ["?[1]" \\parser]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(with_expansions [<bit> (static.random_bit)
+                  <nat> (static.random_nat)]
+  (def constant
+    (/.polytypic constant
+      (`` (all ?.either
+               (,, (with_template [<type> <constant>]
+                     [(do ?.monad
+                        [_ (?type.sub <type>)]
+                        (in (` (is <type>
+                                   <constant>))))]
+
+                     [Bit <bit>]
+                     [Nat <nat>]))
+               ))))
+
+  (def .public test
+    Test
+    (<| (_.covering /._)
+        (do [! random.monad]
+          [])
+        (all _.and
+             (_.coverage [/.polytypic]
+               (and (bit#= <bit> (constant Bit))
+                    (nat#= <nat> (constant Nat))))
+             )))
+  )
-- 
cgit v1.2.3