Test for predicates + adjustments to code-generation code.

1 files changed, 59 insertions, 0 deletions

diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux
new file mode 100644
index 000000000..946d8371e
--- /dev/null
+++ b/stdlib/source/test/lux/abstract/predicate.lux
@@ -0,0 +1,59 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [data
+    ["." bit ("#@." equivalence)]
+    [text
+     ["%" format (#+ format)]]
+    [number
+     ["n" nat]]]
+   [math
+    ["r" random (#+ Random)]]]
+  ["." // #_
+   ["#." monoid]]
+  {1
+   ["." / (#+ Predicate)]})
+
+(def: #export test
+  Test
+  (let [/2? (: (/.Predicate Nat)
+               (|>> (n.% 2) (n.= 0)))
+        /3? (: (/.Predicate Nat)
+               (|>> (n.% 3) (n.= 0)))]
+    (<| (_.context (%.name (name-of /.Predicate)))
+        (do r.monad
+          [sample r.nat])
+        ($_ _.and
+            (_.test (%.name (name-of /.none))
+                    (bit@= false (/.none sample)))
+            (_.test (%.name (name-of /.all))
+                    (bit@= true (/.all sample)))
+            (_.test (%.name (name-of /.unite))
+                    (bit@= (/.all sample)
+                           ((/.unite /.none /.all) sample)))
+            (_.test (%.name (name-of /.intersect))
+                    (bit@= (/.none sample)
+                           ((/.intersect /.none /.all) sample)))
+            (_.test (%.name (name-of /.complement))
+                    (and (not (bit@= (/.none sample)
+                                     ((/.complement /.none) sample)))
+                         (not (bit@= (/.all sample)
+                                     ((/.complement /.all) sample)))))
+            (_.test (%.name (name-of /.difference))
+                    (bit@= (and (/2? sample)
+                                (not (/3? sample)))
+                           ((/.difference /3? /2?) sample)))
+            (let [equivalence (: (Equivalence (/.Predicate Nat))
+                                 (structure
+                                  (def: (= left right)
+                                    (bit@= (left sample)
+                                           (right sample)))))
+                  generator (: (Random (/.Predicate Nat))
+                               (wrap /2?))]
+              ($_ _.and
+                  (//monoid.spec equivalence /.union generator)
+                  (//monoid.spec equivalence /.intersection generator)))
+            ))))