Type-checking macros via the Macro' type from the standard library.

6 files changed, 301 insertions, 106 deletions

diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 1ba27d0b6..72715fdef 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -9,6 +9,8 @@
       ["$." equivalence]]}]
    [math
     ["." random (#+ Random)]]]
+  ["." / #_
+   ["#." type]]
   {#program
    ["." /]})
 
@@ -27,4 +29,6 @@
         ($_ _.and
             (_.with-cover [/.equivalence]
               ($equivalence.spec /.equivalence ..random))
+
+            /type.test
             ))))
diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux
new file mode 100644
index 000000000..fd815f19e
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/type.lux
@@ -0,0 +1,28 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [data
+    ["." text]
+    [number
+     ["n" nat]]
+    [collection
+     ["." set]
+     ["." list]]]
+   [math
+    ["." random (#+ Random)]]]
+  {#program
+   ["." /]})
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Type]
+        ($_ _.and
+            (_.cover [/.lux-library /.jvm-library /.pom]
+                     (let [options (list /.lux-library /.jvm-library /.pom)
+                           uniques (set.from-list text.hash options)]
+                       (n.= (list.size options)
+                            (set.size uniques))))
+            ))))
diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux
index 20e62ef86..74057ad63 100644
--- a/stdlib/source/test/lux/data/product.lux
+++ b/stdlib/source/test/lux/data/product.lux
@@ -18,6 +18,7 @@
 (def: #export test
   Test
   (<| (_.covering /._)
+      (_.with-cover [.&])
       (do random.monad
         [expected random.nat
          shift random.nat
diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux
index 972677361..3bbf65bc9 100644
--- a/stdlib/source/test/lux/data/sum.lux
+++ b/stdlib/source/test/lux/data/sum.lux
@@ -22,6 +22,7 @@
 (def: #export test
   Test
   (<| (_.covering /._)
+      (_.with-cover [.|])
       (do {@ random.monad}
         [expected random.nat
          shift random.nat])
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index a1a0ec7b1..6fbee6ec5 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -1,137 +1,295 @@
 (.module:
-  [lux #*
-   ["%" data/text/format (#+ format)]
+  [lux (#- char)
    ["_" test (#+ Test)]
    [abstract
-    [monad (#+ do Monad)]
+    [monad (#+ do)]
     {[0 #spec]
      [/
       ["$." equivalence]
-      ["$." order]]}]
+      ["$." order]
+      ["$." monoid]]}]
    [control
     pipe]
    [data
+    ["." maybe]
     [number
      ["n" nat]]
     [collection
-     ["." list]]]
+     ["." list]
+     ["." set]]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
    ["." /]})
 
 (def: bounded-size
-  (r.Random Nat)
-  (|> r.nat
-      (:: r.monad map (|>> (n.% 20) (n.+ 1)))))
+  (random.Random Nat)
+  (|> random.nat
+      (:: random.monad map (|>> (n.% 20) (n.+ 1)))))
 
-(def: #export test
+(def: size
   Test
-  (<| (_.context (%.name (name-of .Text)))
-      ($_ _.and
-          ($equivalence.spec /.equivalence (r.ascii 2))
-          ($order.spec /.order (r.ascii 2))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 10) random.nat)
+     sample (random.unicode size)]
+    ($_ _.and
+        (_.cover [/.size]
+                 (n.= size (/.size sample)))
+        (_.cover [/.empty?]
+                 (or (/.empty? sample)
+                     (not (n.= 0 size)))))))
 
-          (do {@ r.monad}
-            [size (:: @ map (n.% 10) r.nat)
-             sample (r.unicode size)]
-            ($_ _.and
-                (_.test "Can get the size of text."
-                        (n.= size (/.size sample)))
-                (_.test "Text with size 0 is considered 'empty'."
-                        (or (not (n.= 0 size))
-                            (/.empty? sample)))))
-          (do {@ r.monad}
-            [size bounded-size
-             idx (:: @ map (n.% size) r.nat)
-             sample (r.unicode size)]
-            (_.test "Character locations."
-                    (|> sample
-                        (/.nth idx)
-                        (case> (^multi (#.Some char)
-                                       [(/.from-code char) char]
-                                       [[(/.index-of char sample)
-                                         (/.last-index-of char sample)
-                                         (/.index-of' char idx sample)
-                                         (/.last-index-of' char idx sample)]
-                                        [(#.Some io) (#.Some lio)
-                                         (#.Some io') (#.Some lio')]])
-                               (and (n.<= idx io)
-                                    (n.>= idx lio)
+(def: affix
+  Test
+  (do {@ random.monad}
+    [inner (random.unicode 1)
+     outer (random.filter (|>> (:: /.equivalence = inner) not)
+                          (random.unicode 1))
+     left (random.unicode 1)
+     right (random.unicode 1)
+     #let [full (:: /.monoid compose inner outer)
+           fake-index (.nat -1)]]
+    (`` ($_ _.and
+            (~~ (template [<affix> <predicate>]
+                  [(_.cover [<affix> <predicate>]
+                            (<predicate> outer (<affix> outer inner)))]
+
+                  [/.prefix /.starts-with?]
+                  [/.suffix /.ends-with?]
+                  [/.enclose' /.encloses?]
+                  ))
+            (_.cover [/.enclose]
+                     (let [value (/.enclose [left right] inner)]
+                       (and (/.starts-with? left value)
+                            (/.ends-with? right value))))
+            (_.cover [/.encode]
+                     (let [sample (/.encode inner)]
+                       (and (/.encloses? /.double-quote sample)
+                            (/.contains? inner sample))))
+            ))))
+
+(def: index
+  Test
+  (do {@ random.monad}
+    [inner (random.unicode 1)
+     outer (random.filter (|>> (:: /.equivalence = inner) not)
+                          (random.unicode 1))
+     #let [fake-index (.nat -1)]]
+    ($_ _.and
+        (_.cover [/.contains?]
+                 (let [full (:: /.monoid compose inner outer)]
+                   (and (/.contains? inner full)
+                        (/.contains? outer full))))
+        (_.cover [/.index-of]
+                 (and (|> (/.index-of inner (:: /.monoid compose inner outer))
+                          (maybe.default fake-index)
+                          (n.= 0))
+                      (|> (/.index-of outer (:: /.monoid compose inner outer))
+                          (maybe.default fake-index)
+                          (n.= 1))))
+        (_.cover [/.index-of']
+                 (let [full (:: /.monoid compose inner outer)]
+                   (and (|> (/.index-of' inner 0 full)
+                            (maybe.default fake-index)
+                            (n.= 0))
+                        (|> (/.index-of' inner 1 full)
+                            (maybe.default fake-index)
+                            (n.= fake-index))
+                        
+                        (|> (/.index-of' outer 0 full)
+                            (maybe.default fake-index)
+                            (n.= 1))
+                        (|> (/.index-of' outer 1 full)
+                            (maybe.default fake-index)
+                            (n.= 1))
+                        (|> (/.index-of' outer 2 full)
+                            (maybe.default fake-index)
+                            (n.= fake-index)))))
+        (_.cover [/.last-index-of]
+                 (let [full ($_ (:: /.monoid compose) outer inner outer)]
+                   (and (|> (/.last-index-of inner full)
+                            (maybe.default fake-index)
+                            (n.= 1))
+                        (|> (/.last-index-of outer full)
+                            (maybe.default fake-index)
+                            (n.= 2)))))
+        (_.cover [/.last-index-of']
+                 (let [full ($_ (:: /.monoid compose) outer inner outer)]
+                   (and (|> (/.last-index-of' inner 0 full)
+                            (maybe.default fake-index)
+                            (n.= 1))
+                        (|> (/.last-index-of' inner 2 full)
+                            (maybe.default fake-index)
+                            (n.= fake-index))
+                        
+                        (|> (/.last-index-of' outer 0 full)
+                            (maybe.default fake-index)
+                            (n.= 2))
+                        (|> (/.last-index-of' outer 2 full)
+                            (maybe.default fake-index)
+                            (n.= 2))
+                        (|> (/.last-index-of' outer 3 full)
+                            (maybe.default fake-index)
+                            (n.= fake-index)))))
+        )))
+
+(def: char
+  Test
+  ($_ _.and
+      (_.with-cover [/.Char /.from-code]
+        (`` ($_ _.and
+                (~~ (template [<short> <long>]
+                      [(_.cover [<short> <long>]
+                                (:: /.equivalence = <short> <long>))]
 
-                                    (n.= idx io')
-                                    (n.>= idx lio')
+                      [/.\0  /.null]
+                      [/.\a  /.alarm]
+                      [/.\b  /.back-space]
+                      [/.\t  /.tab]
+                      [/.\n  /.new-line]
+                      [/.\v  /.vertical-tab]
+                      [/.\f  /.form-feed]
+                      [/.\r  /.carriage-return]
+                      [/.\'' /.double-quote]))
+                (_.cover [/.line-feed]
+                         (:: /.equivalence = /.new-line /.line-feed))
+                )))
+      (do {@ random.monad}
+        [size (:: @ map (|>> (n.% 10) inc) random.nat)
+         characters (random.set /.hash size (random.ascii/alpha 1))
+         #let [sample (|> characters set.to-list /.concat)]
+         expected (:: @ map (n.% size) random.nat)]
+        (_.cover [/.nth]
+                 (case (/.nth expected sample)
+                   (#.Some char)
+                   (case (/.index-of (/.from-code char) sample)
+                     (#.Some actual)
+                     (n.= expected actual)
 
-                                    (/.contains? char sample))
+                     _
+                     false)
+                   
+                   #.None
+                   false)))
+      (_.cover [/.space /.space?]
+               (`` (and (~~ (template [<char>]
+                              [(/.space? (`` (.char (~~ (static <char>)))))]
+                              
+                              [/.tab]
+                              [/.vertical-tab]
+                              [/.space]
+                              [/.new-line]
+                              [/.carriage-return]
+                              [/.form-feed]
+                              )))))
+      ))
 
-                               _
-                               #0
-                               ))
-                    ))
-          (do r.monad
+(def: manipulation
+  Test
+  (do {@ random.monad}
+    [size (:: @ map (|>> (n.% 10) (n.+ 2)) random.nat)
+     characters (random.set /.hash size (random.ascii/alpha 1))
+     separator (random.filter (|>> (set.member? characters) not)
+                              (random.ascii/alpha 1))
+     #let [with-no-separator (|> characters set.to-list /.concat)]
+     static (random.ascii/alpha 1)
+     #let [dynamic (random.filter (|>> (:: /.equivalence = static) not)
+                                  (random.ascii/alpha 1))]
+     pre dynamic
+     post dynamic]
+    ($_ _.and
+        (_.cover [/.concat]
+                 (n.= (set.size characters)
+                      (/.size (/.concat (set.to-list characters)))))
+        (_.cover [/.join-with /.split-all-with]
+                 (and (|> (set.to-list characters)
+                          (/.join-with separator)
+                          (/.split-all-with separator)
+                          (set.from-list /.hash)
+                          (:: set.equivalence = characters))
+                      (:: /.equivalence =
+                          (/.concat (set.to-list characters))
+                          (/.join-with "" (set.to-list characters)))))
+        (_.cover [/.replace-once]
+                 (:: /.equivalence =
+                     (:: /.monoid compose post static)
+                     (/.replace-once pre post (:: /.monoid compose pre static))))
+        (_.cover [/.split-with]
+                 (case (/.split-with static ($_ (:: /.monoid compose) pre static post))
+                   (#.Some [left right])
+                   (and (:: /.equivalence = pre left)
+                        (:: /.equivalence = post right))
+                   
+                   #.None
+                   false))
+        )))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [.Text])
+      ($_ _.and
+          (_.with-cover [/.equivalence]
+            ($equivalence.spec /.equivalence (random.ascii 2)))
+          (_.with-cover [/.order]
+            ($order.spec /.order (random.ascii 2)))
+          (_.with-cover [/.monoid]
+            ($monoid.spec /.equivalence /.monoid (random.ascii 2)))
+
+          ..size
+          ..affix
+          ..index
+          ..char
+          ..manipulation
+          
+          (do random.monad
             [sizeL bounded-size
              sizeR bounded-size
-             sampleL (r.unicode sizeL)
-             sampleR (r.unicode sizeR)
+             sampleL (random.unicode sizeL)
+             sampleR (random.unicode sizeR)
+             middle (random.unicode 1)
              #let [sample (/.concat (list sampleL sampleR))
                    (^open "/@.") /.equivalence]]
             ($_ _.and
-                (_.test "Can join text snippets."
-                        (and (not (/@= sample
-                                       (/.join-with " " (list sampleL sampleR))))
-                             (/@= sample
-                                  (/.join-with "" (list sampleL sampleR)))))
-                (_.test "Can check sub-texts at the borders."
-                        (and (/.starts-with? sampleL sample)
-                             (/.ends-with? sampleR sample)))
-                (_.test "Can enclose text in another texts."
-                        (/@= (/.enclose [sampleR sampleR] sampleL)
-                             (/.enclose' sampleR sampleL)))
-                (_.test "Can split text."
-                        (|> (/.split sizeL sample)
-                            (case> (#.Right [_l _r])
-                                   (and (/@= sampleL _l)
-                                        (/@= sampleR _r)
-                                        (/@= sample (/.concat (list _l _r))))
+                (_.cover [/.split]
+                         (|> (/.split sizeL sample)
+                             (case> (#.Right [_l _r])
+                                    (and (/@= sampleL _l)
+                                         (/@= sampleR _r)
+                                         (/@= sample (/.concat (list _l _r))))
 
-                                   _
-                                   #0)))
-                (_.test "Can clip text."
-                        (|> [(/.clip 0 sizeL sample)
-                             (/.clip sizeL (/.size sample) sample)
-                             (/.clip' sizeL sample)
-                             (/.clip' 0 sample)]
-                            (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
-                                   (and (/@= sampleL _l)
-                                        (/@= sampleR _r)
-                                        (/@= _r _r')
-                                        (/@= sample _f))
+                                    _
+                                    #0)))
+                (_.cover [/.clip /.clip']
+                         (|> [(/.clip 0 sizeL sample)
+                              (/.clip sizeL (/.size sample) sample)
+                              (/.clip' sizeL sample)
+                              (/.clip' 0 sample)]
+                             (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
+                                    (and (/@= sampleL _l)
+                                         (/@= sampleR _r)
+                                         (/@= _r _r')
+                                         (/@= sample _f))
 
-                                   _
-                                   #0)))
+                                    _
+                                    #0)))
                 ))
-          (do {@ r.monad}
+          (do {@ random.monad}
             [sizeP bounded-size
              sizeL bounded-size
              #let [## The wider unicode charset includes control characters that
                    ## can make text replacement work improperly.
                    ## Because of that, I restrict the charset.
-                   normal-char-gen (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))]
-             sep1 (r.text normal-char-gen 1)
-             sep2 (r.text normal-char-gen 1)
-             #let [part-gen (|> (r.text normal-char-gen sizeP)
-                                (r.filter (|>> (/.contains? sep1) not)))]
-             parts (r.list sizeL part-gen)
+                   normal-char-gen (|> random.nat (:: @ map (|>> (n.% 128) (n.max 1))))]
+             sep1 (random.text normal-char-gen 1)
+             sep2 (random.text normal-char-gen 1)
+             #let [part-gen (|> (random.text normal-char-gen sizeP)
+                                (random.filter (|>> (/.contains? sep1) not)))]
+             parts (random.list sizeL part-gen)
              #let [sample1 (/.concat (list.interpose sep1 parts))
                    sample2 (/.concat (list.interpose sep2 parts))
                    (^open "/@.") /.equivalence]]
-            ($_ _.and
-                (_.test "Can split text multiple times through a separator."
-                        (n.= (list.size parts)
-                             (list.size (/.split-all-with sep1 sample1))))
-
-                (_.test "Can replace occurrences of a piece of text inside a larger text."
-                        (/@= sample2
-                             (/.replace-all sep1 sep2 sample1)))
-                ))
+            (_.cover [/.replace-all]
+                     (/@= sample2
+                          (/.replace-all sep1 sep2 sample1))))
           )))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index b9639a82f..e1c4dbfe3 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -237,6 +237,11 @@
    #random ..$Float::random
    #literal ..$Float::literal})
 
+(def: valid-float
+  (Random java/lang/Float)
+  (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not)
+                 ..$Float::random))
+
 (def: $Double (/type.class "java.lang.Double" (list)))
 (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)])))
 (def: $Double::random (:coerce (Random java/lang/Double) random.frac))
@@ -678,10 +683,8 @@
         comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit))
                       (function (_ instruction standard)
                         (do random.monad
-                          [#let [valid-double (random.filter (|>> (:coerce Frac) f.not-a-number? not)
-                                                             ..$Double::random)]
-                           reference valid-double
-                           subject valid-double
+                          [reference ..valid-double
+                           subject ..valid-double
                            #let [expected (if (for {@.old
                                                     ("jvm deq" reference subject)
                                                     
@@ -1184,15 +1187,15 @@
             (let [test (!::= java/lang/Float "jvm feq" "jvm float =")]
               ($_ _.and
                   (_.lift "FSTORE_0/FLOAD_0"
-                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test))
+                          (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test))
                   (_.lift "FSTORE_1/FLOAD_1"
-                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test))
+                          (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test))
                   (_.lift "FSTORE_2/FLOAD_2"
-                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test))
+                          (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test))
                   (_.lift "FSTORE_3/FLOAD_3"
-                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test))
+                          (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test))
                   (_.lift "FSTORE/FLOAD"
-                          (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload] test)))))
+                          (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test)))))
         (<| (_.context "double")
             (let [test (!::= java/lang/Double "jvm deq" "jvm double =")]
               ($_ _.and