From 0f996f63bad02778d6dd3de767151f524a79df22 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 19 Mar 2020 21:20:08 -0400
Subject: Test for predicates + adjustments to code-generation code.

---
 stdlib/source/lux/abstract/predicate.lux           |  3 +-
 .../compiler/language/lux/phase/generation/js.lux  |  2 +-
 .../language/lux/phase/generation/js/function.lux  |  9 ++--
 .../language/lux/phase/generation/js/runtime.lux   | 33 ++++++------
 .../compiler/language/lux/phase/generation/lua.lux |  2 +-
 .../language/lux/phase/generation/lua/function.lux |  8 +--
 .../language/lux/phase/generation/lua/runtime.lux  | 23 +++++----
 .../language/lux/phase/generation/python.lux       |  2 +-
 .../lux/phase/generation/python/function.lux       |  8 +--
 .../lux/phase/generation/python/runtime.lux        | 23 +++++----
 .../language/lux/phase/generation/reference.lux    | 43 +++++++++++-----
 .../language/lux/phase/generation/ruby.lux         |  2 +-
 .../lux/phase/generation/ruby/function.lux         |  8 +--
 .../language/lux/phase/generation/ruby/runtime.lux | 23 +++++----
 stdlib/source/test/lux/abstract.lux                |  7 ++-
 stdlib/source/test/lux/abstract/order.lux          |  2 +-
 stdlib/source/test/lux/abstract/predicate.lux      | 59 ++++++++++++++++++++++
 17 files changed, 174 insertions(+), 83 deletions(-)
 create mode 100644 stdlib/source/test/lux/abstract/predicate.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/abstract/predicate.lux b/stdlib/source/lux/abstract/predicate.lux
index de3fc087d..b69b43415 100644
--- a/stdlib/source/lux/abstract/predicate.lux
+++ b/stdlib/source/lux/abstract/predicate.lux
@@ -49,7 +49,8 @@
   (All [a]
     (-> (-> (Predicate a) (Predicate a))
         (Predicate a)))
-  (|>> (predicate (rec predicate))))
+  (function (recur input)
+    (predicate recur input)))
 
 (structure: #export contravariant
   (Contravariant Predicate)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
index c1970c013..e7cebfdbf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux
@@ -36,7 +36,7 @@
     (/structure.tuple generate archive members)
 
     (#synthesis.Reference value)
-    (/reference@reference value)
+    (/reference@reference archive value)
 
     (^ (synthesis.branch/case case))
     (/case.case generate archive case)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
index cf2f4db68..81b9752a3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/function.lux
@@ -11,7 +11,7 @@
    [target
     ["_" js (#+ Expression Computation Var)]]]
   ["." // #_
-   [runtime (#+ Operation Phase Generator)]
+   ["#." runtime (#+ Operation Phase Generator)]
    ["#." reference]
    ["#." case]
    ["/#" // #_
@@ -56,9 +56,10 @@
 (def: #export (function generate archive [environment arity bodyS])
   (Generator (Abstraction Synthesis))
   (do ///////phase.monad
-    [[function-name bodyO] (/////generation.with-context
+    [[function-name bodyO] (/////generation.with-new-context
                              (do @
-                               [function-name /////generation.context]
+                               [function-name (:: @ map ///reference.artifact-name
+                                                  /////generation.context)]
                                (/////generation.with-anchor (_.var function-name)
                                  (generate archive bodyS))))
      #let [capture (:: //reference.system variable)]
@@ -66,7 +67,7 @@
                   (monad.map @ capture environment))
      #let [arityO (|> arity .int _.i32)
            @num-args (_.var "num_args")
-           @self (_.var function-name)
+           @self (_.var (///reference.artifact-name function-name))
            apply-poly (.function (_ args func)
                         (|> func (_.do "apply" (list _.null args))))
            initialize-self! (_.define (//case.register 0) @self)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
index fb197118a..ddcc765a2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux
@@ -12,20 +12,21 @@
     ["." text
      ["%" format (#+ format)]]
     [collection
-     ["." list ("#;." functor)]]]
+     ["." list ("#@." functor)]]]
    ["." macro
     ["." code]
     [syntax (#+ syntax:)]]
    [target
     ["_" js (#+ Expression Var Computation Statement)]]]
-  ["." ///// #_
-   ["#." synthesis]
-   ["#." generation]
+  ["." /// #_
+   ["#." reference]
    ["//#" /// #_
-    ["#." phase]
-    ["#." name]
-    [meta
-     [archive (#+ Archive)]]]]
+    ["#." synthesis]
+    ["#." generation (#+ Buffer)]
+    ["//#" /// #_
+     ["#." phase]
+     [meta
+      [archive (#+ Archive)]]]]]
   )
 
 (template [<name> <base>]
@@ -88,12 +89,12 @@
 
 (def: variable
   (-> Text Var)
-  (|>> ///////name.normalize
+  (|>> ///reference.sanitize
        _.var))
 
 (def: runtime-name
   (-> Text Var)
-  (|>> ///////name.normalize
+  (|>> ///reference.sanitize
        (format ..prefix "$")
        _.var))
 
@@ -104,9 +105,9 @@
 (syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))}
                    body)
   (wrap (list (` (let [(~+ (|> vars
-                               (list;map (function (_ var)
+                               (list@map (function (_ var)
                                            (list (code.local-identifier var)
-                                                 (` (_.var (~ (code.text (///////name.normalize var))))))))
+                                                 (` (_.var (~ (code.text (///reference.sanitize var))))))))
                                list.concat))]
                    (~ body))))))
 
@@ -132,8 +133,8 @@
       (let [nameC (code.local-identifier name)
             code-nameC (code.local-identifier (format "@" name))
             runtime-nameC (` (runtime-name (~ (code.text name))))
-            inputsC (list;map code.local-identifier inputs)
-            inputs-typesC (list;map (function.constant (` _.Expression)) inputs)]
+            inputsC (list@map code.local-identifier inputs)
+            inputs-typesC (list@map (function.constant (` _.Expression)) inputs)]
         (wrap (list (` (def: #export ((~ nameC) (~+ inputsC))
                          (-> (~+ inputs-typesC) Computation)
                          (_.apply/* (~ runtime-nameC) (list (~+ inputsC)))))
@@ -736,11 +737,11 @@
 (def: #export artifact Text prefix)
 
 (def: #export generate
-  (Operation Any)
+  (Operation (Buffer Statement))
   (/////generation.with-buffer
     (do ///////phase.monad
       [_ (/////generation.save! true ["" ..prefix]
                                 ($_ _.then
                                     _.use-strict
                                     ..runtime))]
-      (/////generation.save-buffer! ..artifact))))
+      /////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
index 3a041f594..a455b13b9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua.lux
@@ -36,7 +36,7 @@
     (/structure.tuple generate archive members)
 
     (#synthesis.Reference value)
-    (/reference@reference value)
+    (/reference@reference archive value)
 
     (^ (synthesis.branch/case case))
     (/case.case generate archive case)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
index 556f8d169..23697cfcb 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/function.lux
@@ -62,14 +62,16 @@
 (def: #export (function generate archive [environment arity bodyS])
   (Generator (Abstraction Synthesis))
   (do ///////phase.monad
-    [[function-name bodyO] (/////generation.with-context
+    [[function-name bodyO] (/////generation.with-new-context
                              (do @
-                               [function-name /////generation.context]
+                               [function-name (:: @ map ///reference.artifact-name
+                                                  /////generation.context)]
                                (/////generation.with-anchor (_.var function-name)
                                  (generate archive bodyS))))
      closureO+ (: (Operation (List (Expression Any)))
                   (monad.map @ (:: //reference.system variable) environment))
-     #let [@curried (_.var "curried")
+     #let [function-name (///reference.artifact-name function-name)
+           @curried (_.var "curried")
            arityO (|> arity .int _.int)
            @num-args (_.var "num_args")
            @self (_.var function-name)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
index ad3745dff..e5011d01a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux
@@ -18,14 +18,15 @@
     [syntax (#+ syntax:)]]
    [target
     ["_" lua (#+ Expression Location Var Computation Literal Statement)]]]
-  ["." ///// #_
-   ["#." synthesis]
-   ["#." generation]
+  ["." /// #_
+   ["#." reference]
    ["//#" /// #_
-    ["#." phase]
-    ["#." name]
-    [meta
-     [archive (#+ Archive)]]]])
+    ["#." synthesis]
+    ["#." generation (#+ Buffer)]
+    ["//#" /// #_
+     ["#." phase]
+     [meta
+      [archive (#+ Archive)]]]]])
 
 (template [<name> <base>]
   [(type: #export <name>
@@ -84,7 +85,7 @@
 
 (def: runtime-name
   (-> Text Var)
-  (|>> ///////name.normalize
+  (|>> ///reference.sanitize
        (format ..prefix "_")
        _.var))
 
@@ -97,7 +98,7 @@
   (wrap (list (` (let [(~+ (|> vars
                                (list@map (function (_ var)
                                            (list (code.local-identifier var)
-                                                 (` (_.var (~ (code.text (///////name.normalize var))))))))
+                                                 (` (_.var (~ (code.text (///reference.sanitize var))))))))
                                list.concat))]
                    (~ body))))))
 
@@ -360,9 +361,9 @@
 (def: #export artifact ..prefix)
 
 (def: #export generate
-  (Operation Any)
+  (Operation (Buffer Statement))
   (/////generation.with-buffer
     (do ///////phase.monad
       [_ (/////generation.save! true ["" ..prefix]
                                 ..runtime)]
-      (/////generation.save-buffer! ..artifact))))
+      /////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
index f6e14de75..19013715b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python.lux
@@ -36,7 +36,7 @@
     (/structure.tuple generate archive members)
 
     (#////synthesis.Reference value)
-    (/reference@reference value)
+    (/reference@reference archive value)
 
     (^ (////synthesis.branch/case case))
     (/case.case generate archive case)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index eb815a2c8..ded751c2e 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -62,14 +62,16 @@
 (def: #export (function generate archive [environment arity bodyS])
   (Generator (Abstraction Synthesis))
   (do ///////phase.monad
-    [[function-name bodyO] (/////generation.with-context
+    [[function-name bodyO] (/////generation.with-new-context
                              (do @
-                               [function-name /////generation.context]
+                               [function-name (:: @ map ///reference.artifact-name
+                                                  /////generation.context)]
                                (/////generation.with-anchor (_.var function-name)
                                  (generate archive bodyS))))
      closureO+ (: (Operation (List (Expression Any)))
                   (monad.map @ (:: //reference.system variable) environment))
-     #let [@curried (_.var "curried")
+     #let [function-name (///reference.artifact-name function-name)
+           @curried (_.var "curried")
            arityO (|> arity .int _.int)
            @num-args (_.var "num_args")
            @self (_.var function-name)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index 8916ad6d8..d3d1d532a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -18,14 +18,15 @@
     [syntax (#+ syntax:)]]
    [target
     ["_" python (#+ Expression SVar Computation Literal Statement)]]]
-  ["." ///// #_
-   ["#." synthesis]
-   ["#." generation]
+  ["." /// #_
+   ["#." reference]
    ["//#" /// #_
-    ["#." phase]
-    ["#." name]
-    [meta
-     [archive (#+ Archive)]]]])
+    ["#." synthesis]
+    ["#." generation (#+ Buffer)]
+    ["//#" /// #_
+     ["#." phase]
+     [meta
+      [archive (#+ Archive)]]]]])
 
 (template [<name> <base>]
   [(type: #export <name>
@@ -78,7 +79,7 @@
 
 (def: runtime-name
   (-> Text SVar)
-  (|>> ///////name.normalize
+  (|>> ///reference.sanitize
        (format ..prefix "_")
        _.var))
 
@@ -91,7 +92,7 @@
   (wrap (list (` (let [(~+ (|> vars
                                (list@map (function (_ var)
                                            (list (code.local-identifier var)
-                                                 (` (_.var (~ (code.text (///////name.normalize var))))))))
+                                                 (` (_.var (~ (code.text (///reference.sanitize var))))))))
                                list.concat))]
                    (~ body))))))
 
@@ -336,10 +337,10 @@
 (def: #export artifact ..prefix)
 
 (def: #export generate
-  (Operation Any)
+  (Operation (Buffer (Statement Any)))
   (/////generation.with-buffer
     (do ///////phase.monad
       [_ (/////generation.save! true ["" ..prefix]
                                 (<| (_.comment "-*- coding: utf-8 -*-")
                                     ..runtime))]
-      (/////generation.save-buffer! ..artifact))))
+      /////generation.buffer)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
index e75c8e41e..86fb57f0a 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/reference.lux
@@ -1,17 +1,21 @@
 (.module:
   [lux #*
+   [abstract
+    [monad (#+ do)]]
    [control
     pipe]
    [data
-    [text
+    ["." text
      ["%" format (#+ format)]]]
    [type (#+ :share)]]
   ["." //// #_
    [synthesis (#+ Synthesis)]
-   ["#." generation]
+   ["#." generation (#+ Context)]
    ["//#" /// #_
     ["#." reference (#+ Register Variable Reference)]
-    ["#." phase ("#@." monad)]]])
+    ["#." phase ("#@." monad)]
+    [meta
+     [archive (#+ Archive)]]]])
 
 (signature: #export (System expression)
   (: (-> Register expression)
@@ -22,10 +26,10 @@
        (-> Variable (////generation.Operation anchor expression directive)))
      variable)
   (: (All [anchor directive]
-       (-> Name (////generation.Operation anchor expression directive)))
+       (-> Archive Name (////generation.Operation anchor expression directive)))
      constant)
   (: (All [anchor directive]
-       (-> Reference (////generation.Operation anchor expression directive)))
+       (-> Archive Reference (////generation.Operation anchor expression directive)))
      reference))
 
 (def: (variable-maker prefix variable)
@@ -45,6 +49,16 @@
   ["l" local]
   )
 
+(def: #export sanitize
+  (-> Text Text)
+  (|>> (text.replace-all "-" "_")
+       (text.replace-all "?" "Q")
+       (text.replace-all "@" "A")))
+
+(def: #export (artifact-name [module id])
+  (-> Context Text)
+  (format "lux_" "m" module "a" (%.nat id)))
+
 (def: #export (system constant variable)
   (All [expression]
     (-> (-> Text expression) (-> Text expression)
@@ -66,16 +80,19 @@
                          {(-> Text expression)
                           constant}
                          {(All [anchor directive]
-                            (-> Name (////generation.Operation anchor expression directive)))
-                          (|>> ////generation.remember (//////phase@map constant))})]
+                            (-> Archive Name (////generation.Operation anchor expression directive)))
+                          (function (_ archive name)
+                            (|> (////generation.remember archive name)
+                                (//////phase@map (|>> ..artifact-name constant))))})]
     (structure
      (def: local local)
      (def: foreign foreign)
      (def: variable variable)
      (def: constant constant)
-     (def: reference
-       (|>> (case> (#//////reference.Constant value)
-                   (constant value)
-                   
-                   (#//////reference.Variable value)
-                   (variable value)))))))
+     (def: (reference archive reference)
+       (case reference
+         (#//////reference.Constant value)
+         (constant archive value)
+         
+         (#//////reference.Variable value)
+         (variable value))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
index f6e14de75..19013715b 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby.lux
@@ -36,7 +36,7 @@
     (/structure.tuple generate archive members)
 
     (#////synthesis.Reference value)
-    (/reference@reference value)
+    (/reference@reference archive value)
 
     (^ (////synthesis.branch/case case))
     (/case.case generate archive case)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux
index 3e63c5a86..b4b89e375 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux
@@ -55,14 +55,16 @@
 (def: #export (function generate archive [environment arity bodyS])
   (Generator (Abstraction Synthesis))
   (do ///////phase.monad
-    [[function-name bodyO] (/////generation.with-context
+    [[function-name bodyO] (/////generation.with-new-context
                              (do @
-                               [function-name /////generation.context]
+                               [function-name (:: @ map ///reference.artifact-name
+                                                  /////generation.context)]
                                (/////generation.with-anchor (_.local function-name)
                                  (generate archive bodyS))))
      closureO+ (: (Operation (List (Expression Any)))
                   (monad.map @ (:: //reference.system variable) environment))
-     #let [@curried (_.local "curried")
+     #let [function-name (///reference.artifact-name function-name)
+           @curried (_.local "curried")
            arityO (|> arity .int _.int)
            limitO (|> arity dec .int _.int)
            @num-args (_.local "num_args")
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
index ab1607c26..8d2e73a9d 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux
@@ -18,14 +18,15 @@
     [syntax (#+ syntax:)]]
    [target
     ["_" ruby (#+ Expression LVar Computation Literal Statement)]]]
-  ["." ///// #_
-   ["#." synthesis]
-   ["#." generation]
+  ["." /// #_
+   ["#." reference]
    ["//#" /// #_
-    ["#." phase]
-    ["#." name]
-    [meta
-     [archive (#+ Archive)]]]])
+    ["#." synthesis]
+    ["#." generation (#+ Buffer)]
+    ["//#" /// #_
+     ["#." phase]
+     [meta
+      [archive (#+ Archive)]]]]])
 
 (template [<name> <base>]
   [(type: #export <name>
@@ -82,7 +83,7 @@
 
 (def: runtime-name
   (-> Text LVar)
-  (|>> ///////name.normalize
+  (|>> ///reference.sanitize
        (format ..prefix "_")
        _.local))
 
@@ -95,7 +96,7 @@
   (wrap (list (` (let [(~+ (|> vars
                                (list@map (function (_ var)
                                            (list (code.local-identifier var)
-                                                 (` (_.local (~ (code.text (///////name.normalize var))))))))
+                                                 (` (_.local (~ (code.text (///reference.sanitize var))))))))
                                list.concat))]
                    (~ body))))))
 
@@ -292,9 +293,9 @@
 (def: #export artifact ..prefix)
 
 (def: #export generate
-  (Operation Any)
+  (Operation (Buffer (Statement Any)))
   (/////generation.with-buffer
     (do ///////phase.monad
       [_ (/////generation.save! true ["" ..prefix]
                                 ..runtime)]
-      (/////generation.save-buffer! ..artifact))))
+      /////generation.buffer)))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index c0ad0b823..d927dcd3e 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -6,7 +6,8 @@
    ["#." enum]
    ["#." equivalence]
    ["#." interval]
-   ["#." order]])
+   ["#." order]
+   ["#." predicate]])
 
 (def: #export test
   Test
@@ -15,4 +16,6 @@
       /enum.test
       /equivalence.test
       /interval.test
-      /order.test))
+      /order.test
+      /predicate.test
+      ))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index a4bff03e9..ed64b5d46 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -14,7 +14,7 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Codec)))
+  (<| (_.context (%.name (name-of /.Order)))
       (do r.monad
         [left r.nat
          right (|> r.nat (r.filter (|>> (n.= left) not)))])
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)))
+            ))))
-- 
cgit v1.2.3