Including runtime machinery in the cache.

3 files changed, 211 insertions, 154 deletions

diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux
index 388a66ffc..0702f00ef 100644
--- a/stdlib/source/test/lux/abstract/functor.lux
+++ b/stdlib/source/test/lux/abstract/functor.lux
@@ -2,15 +2,19 @@
   [lux #*
    ["_" test (#+ Test)]
    ["%" data/text/format (#+ format)]
-   ["r" math/random]
    [abstract
     [equivalence (#+ Equivalence)]
     [monad (#+ do)]]
    [control
     ["." function]]
    [data
+    ["." maybe]
     [number
-     ["n" nat]]]]
+     ["n" nat]]
+    [collection
+     ["." list]]]
+   [math
+    ["." random]]]
   {1
    ["." / (#+ Functor)]})
 
@@ -24,8 +28,8 @@
 
 (def: (identity injection comparison (^open "/@."))
   (All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
-  (do r.monad
-    [sample (:: @ map injection r.nat)]
+  (do random.monad
+    [sample (:: @ map injection random.nat)]
     (_.test "Identity."
             ((comparison n.=)
              (/@map function.identity sample)
@@ -33,9 +37,9 @@
 
 (def: (homomorphism injection comparison (^open "/@."))
   (All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
-  (do r.monad
-    [sample r.nat
-     increase (:: @ map n.+ r.nat)]
+  (do random.monad
+    [sample random.nat
+     increase (:: @ map n.+ random.nat)]
     (_.test "Homomorphism."
             ((comparison n.=)
              (/@map increase (injection sample))
@@ -43,10 +47,10 @@
 
 (def: (composition injection comparison (^open "/@."))
   (All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
-  (do r.monad
-    [sample (:: @ map injection r.nat)
-     increase (:: @ map n.+ r.nat)
-     decrease (:: @ map n.- r.nat)]
+  (do random.monad
+    [sample (:: @ map injection random.nat)
+     increase (:: @ map n.+ random.nat)
+     decrease (:: @ map n.- random.nat)]
     (_.test "Composition."
             ((comparison n.=)
              (|> sample (/@map increase) (/@map decrease))
@@ -54,9 +58,55 @@
 
 (def: #export (spec injection comparison functor)
   (All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
-  (_.context (%.name (name-of /.Functor))
-             ($_ _.and
-                 (..identity injection comparison functor)
-                 (..homomorphism injection comparison functor)
-                 (..composition injection comparison functor)
-                 )))
+  (<| (_.with-cover [/.Functor])
+      ($_ _.and
+          (..identity injection comparison functor)
+          (..homomorphism injection comparison functor)
+          (..composition injection comparison functor)
+          )))
+
+(def: #export test
+  Test
+  (do random.monad
+    [left random.nat
+     right random.nat
+     shift random.nat]
+    (<| (_.covering /._)
+        ($_ _.and
+            (_.cover [/.Or /.sum]
+                     (and (case (:: (/.sum maybe.functor list.functor) map
+                                    (n.+ shift)
+                                    (#.Left (#.Some left)))
+                            (#.Left (#.Some actual))
+                            (n.= (n.+ shift left) actual)
+
+                            _
+                            false)
+                          (case (:: (/.sum maybe.functor list.functor) map
+                                    (n.+ shift)
+                                    (#.Right (list right)))
+                            (^ (#.Right (list actual)))
+                            (n.= (n.+ shift right) actual)
+
+                            _
+                            false)))
+            (_.cover [/.And /.product]
+                     (case (:: (/.product maybe.functor list.functor) map
+                               (n.+ shift)
+                               [(#.Some left) (list right)])
+                       (^ [(#.Some actualL) (list actualR)])
+                       (and (n.= (n.+ shift left) actualL)
+                            (n.= (n.+ shift right) actualR))
+
+                       _
+                       false))
+            (_.cover [/.Then /.compose]
+                     (case (:: (/.compose maybe.functor list.functor) map
+                               (n.+ shift)
+                               (#.Some (list left)))
+                       (^ (#.Some (list actual)))
+                       (n.= (n.+ shift left) actual)
+
+                       _
+                       false))
+            ))))
diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux
index c649128b0..6701916fc 100644
--- a/stdlib/source/test/lux/control/concatenative.lux
+++ b/stdlib/source/test/lux/control/concatenative.lux
@@ -27,70 +27,70 @@
     [sample random.nat
      dummy random.nat]
     (`` ($_ _.and
-            (_.test (%.name (name-of /.push))
-                    (n.= sample
-                         (||> (/.push sample))))
-            (_.test (%.name (name-of /.drop))
-                    (n.= sample
-                         (||> (/.push sample)
-                              (/.push dummy)
-                              /.drop)))
-            (_.test (%.name (name-of /.nip))
-                    (n.= sample
-                         (||> (/.push dummy)
-                              (/.push sample)
-                              /.nip)))
-            (_.test (%.name (name-of /.dup))
-                    (||> (/.push sample)
-                         /.dup
-                         /.n/=))
-            (_.test (%.name (name-of /.swap))
-                    (n.= sample
-                         (||> (/.push sample)
-                              (/.push dummy)
-                              /.swap)))
-            (_.test (%.name (name-of /.rotL))
-                    (n.= sample
-                         (||> (/.push sample)
-                              (/.push dummy)
-                              (/.push dummy)
-                              /.rotL)))
-            (_.test (%.name (name-of /.rotR))
-                    (n.= sample
-                         (||> (/.push dummy)
-                              (/.push sample)
-                              (/.push dummy)
-                              /.rotR)))
-            (_.test (%.name (name-of /.&&))
-                    (let [[left right] (||> (/.push sample)
-                                            (/.push dummy)
-                                            /.&&)]
-                      (and (n.= sample left)
-                           (n.= dummy right))))
+            (_.cover [/.push]
+                     (n.= sample
+                          (||> (/.push sample))))
+            (_.cover [/.drop]
+                     (n.= sample
+                          (||> (/.push sample)
+                               (/.push dummy)
+                               /.drop)))
+            (_.cover [/.nip]
+                     (n.= sample
+                          (||> (/.push dummy)
+                               (/.push sample)
+                               /.nip)))
+            (_.cover [/.dup]
+                     (||> (/.push sample)
+                          /.dup
+                          /.n/=))
+            (_.cover [/.swap]
+                     (n.= sample
+                          (||> (/.push sample)
+                               (/.push dummy)
+                               /.swap)))
+            (_.cover [/.rotL]
+                     (n.= sample
+                          (||> (/.push sample)
+                               (/.push dummy)
+                               (/.push dummy)
+                               /.rotL)))
+            (_.cover [/.rotR]
+                     (n.= sample
+                          (||> (/.push dummy)
+                               (/.push sample)
+                               (/.push dummy)
+                               /.rotR)))
+            (_.cover [/.&&]
+                     (let [[left right] (||> (/.push sample)
+                                             (/.push dummy)
+                                             /.&&)]
+                       (and (n.= sample left)
+                            (n.= dummy right))))
             (~~ (template [<function> <tag>]
-                  [(_.test (%.name (name-of <function>))
-                           ((sum.equivalence n.= n.=)
-                            (<tag> sample)
-                            (||> (/.push sample)
-                                 <function>)))]
+                  [(_.cover [<function>]
+                            ((sum.equivalence n.= n.=)
+                             (<tag> sample)
+                             (||> (/.push sample)
+                                  <function>)))]
 
                   [/.||L #.Left]
                   [/.||R #.Right]))
-            (_.test (%.name (name-of /.dip))
-                    (n.= (inc sample)
-                         (||> (/.push sample)
-                              (/.push dummy)
-                              (/.push (/.apply/1 inc))
-                              /.dip
-                              /.drop)))
-            (_.test (%.name (name-of /.dip/2))
-                    (n.= (inc sample)
-                         (||> (/.push sample)
-                              (/.push dummy)
-                              (/.push dummy)
-                              (/.push (/.apply/1 inc))
-                              /.dip/2
-                              /.drop /.drop)))
+            (_.cover [/.dip]
+                     (n.= (inc sample)
+                          (||> (/.push sample)
+                               (/.push dummy)
+                               (/.push (/.apply/1 inc))
+                               /.dip
+                               /.drop)))
+            (_.cover [/.dip/2]
+                     (n.= (inc sample)
+                          (||> (/.push sample)
+                               (/.push dummy)
+                               (/.push dummy)
+                               (/.push (/.apply/1 inc))
+                               /.dip/2
+                               /.drop /.drop)))
             ))))
 
 (template: (!numerical <=> <generator> <filter> <arithmetic> <order>)
@@ -102,19 +102,19 @@
           subject <generator>]
          (`` ($_ _.and
                  (~~ (template [<concatenative> <functional>]
-                       [(_.test (%.name (name-of <concatenative>))
-                                (<=> (<functional> parameter subject)
-                                     (||> (/.push subject)
-                                          (/.push parameter)
-                                          <concatenative>)))]
+                       [(_.cover [<concatenative>]
+                                 (<=> (<functional> parameter subject)
+                                      (||> (/.push subject)
+                                           (/.push parameter)
+                                           <concatenative>)))]
 
                        <arithmetic>'))
                  (~~ (template [<concatenative> <functional>]
-                       [(_.test (%.name (name-of <concatenative>))
-                                (bit@= (<functional> parameter subject)
-                                       (||> (/.push subject)
-                                            (/.push parameter)
-                                            <concatenative>)))]
+                       [(_.cover [<concatenative>]
+                                 (bit@= (<functional> parameter subject)
+                                        (||> (/.push subject)
+                                             (/.push parameter)
+                                             <concatenative>)))]
 
                        <order>'))
                  ))))))
@@ -146,67 +146,67 @@
            |inc| (/.apply/1 inc)
            |test| (/.apply/1 (|>> (n.- start) (n.< distance)))]]
     ($_ _.and
-        (_.test (%.name (name-of /.call))
-                (n.= (inc sample)
-                     (||> (/.push sample)
-                          (/.push (/.apply/1 inc))
-                          /.call)))
-        (_.test (%.name (name-of /.if))
-                (n.= (if choice
-                       (inc sample)
-                       (dec sample))
-                     (||> (/.push sample)
-                          (/.push choice)
-                          (/.push (/.apply/1 inc))
-                          (/.push (/.apply/1 dec))
-                          /.if)))
-        (_.test (%.name (name-of /.loop))
-                (n.= (n.+ distance start)
-                     (||> (/.push start)
-                          (/.push (|>> |inc| /.dup |test|))
-                          /.loop)))
-        (_.test (%.name (name-of /.while))
-                (n.= (n.+ distance start)
-                     (||> (/.push start)
-                          (/.push (|>> /.dup |test|))
-                          (/.push |inc|)
-                          /.while)))
-        (_.test (%.name (name-of /.do))
-                (n.= (inc sample)
-                     (||> (/.push sample)
-                          (/.push (|>> (/.push false)))
-                          (/.push |inc|)
-                          /.do /.while)))
-        (_.test (%.name (name-of /.compose))
-                (n.= (inc (inc sample))
-                     (||> (/.push sample)
-                          (/.push |inc|)
-                          (/.push |inc|)
-                          /.compose
-                          /.call)))
-        (_.test (%.name (name-of /.curry))
-                (n.= (n.+ sample sample)
-                     (||> (/.push sample)
-                          (/.push sample)
-                          (/.push (/.apply/2 n.+))
-                          /.curry
-                          /.call)))
-        (_.test (%.name (name-of /.when))
-                (n.= (if choice
-                       (inc sample)
-                       sample)
-                     (||> (/.push sample)
-                          (/.push choice)
-                          (/.push (/.apply/1 inc))
-                          /.when)))
-        (_.test (%.name (name-of /.?))
-                (n.= (if choice
-                       (inc sample)
-                       (dec sample))
-                     (||> (/.push choice)
-                          (/.push (inc sample))
-                          (/.push (dec sample))
-                          /.?)))
+        (_.cover [/.call]
+                 (n.= (inc sample)
+                      (||> (/.push sample)
+                           (/.push (/.apply/1 inc))
+                           /.call)))
+        (_.cover [/.if]
+                 (n.= (if choice
+                        (inc sample)
+                        (dec sample))
+                      (||> (/.push sample)
+                           (/.push choice)
+                           (/.push (/.apply/1 inc))
+                           (/.push (/.apply/1 dec))
+                           /.if)))
+        (_.cover [/.loop]
+                 (n.= (n.+ distance start)
+                      (||> (/.push start)
+                           (/.push (|>> |inc| /.dup |test|))
+                           /.loop)))
+        (_.cover [/.while]
+                 (n.= (n.+ distance start)
+                      (||> (/.push start)
+                           (/.push (|>> /.dup |test|))
+                           (/.push |inc|)
+                           /.while)))
+        (_.cover [/.do]
+                 (n.= (inc sample)
+                      (||> (/.push sample)
+                           (/.push (|>> (/.push false)))
+                           (/.push |inc|)
+                           /.do /.while)))
+        (_.cover [/.compose]
+                 (n.= (inc (inc sample))
+                      (||> (/.push sample)
+                           (/.push |inc|)
+                           (/.push |inc|)
+                           /.compose
+                           /.call)))
+        (_.cover [/.curry]
+                 (n.= (n.+ sample sample)
+                      (||> (/.push sample)
+                           (/.push sample)
+                           (/.push (/.apply/2 n.+))
+                           /.curry
+                           /.call)))
+        (_.cover [/.when]
+                 (n.= (if choice
+                        (inc sample)
+                        sample)
+                      (||> (/.push sample)
+                           (/.push choice)
+                           (/.push (/.apply/1 inc))
+                           /.when)))
+        (_.cover [/.?]
+                 (n.= (if choice
+                        (inc sample)
+                        (dec sample))
+                      (||> (/.push choice)
+                           (/.push (inc sample))
+                           (/.push (dec sample))
+                           /.?)))
         )))
 
 (word: square
@@ -219,14 +219,14 @@
   Test
   (do random.monad
     [sample random.nat]
-    (_.test (%.name (name-of /.word:))
-            (n.= (n.* sample sample)
-                 (||> (/.push sample)
-                      ..square)))))
+    (_.cover [/.word:]
+             (n.= (n.* sample sample)
+                  (||> (/.push sample)
+                       ..square)))))
 
 (def: #export test
   Test
-  (<| (_.context (name.module (name-of /._)))
+  (<| (_.covering /._)
       ($_ _.and
           ..stack-shuffling
           ..numerical
diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux
index ef090c1a9..997a810ba 100644
--- a/stdlib/source/test/lux/control/try.lux
+++ b/stdlib/source/test/lux/control/try.lux
@@ -72,6 +72,14 @@
           (_.cover [/.assume]
                    (n.= expected
                         (/.assume (/.succeed expected))))
+          (_.cover [/.from-maybe]
+                   (case [(/.from-maybe (#.Some expected))
+                          (/.from-maybe #.None)]
+                     [(#/.Success actual) (#/.Failure _)]
+                     (n.= expected actual)
+
+                     _
+                     false))
           (_.cover [/.to-maybe]
                    (case [(/.to-maybe (/.succeed expected))
                           (/.to-maybe (/.fail error))]
@@ -86,7 +94,6 @@
                         (n.= alternative
                              (/.default alternative (: (Try Nat)
                                                        (/.fail error))))))
-          
           (_.cover [/.with /.lift]
                    (let [lift (/.lift io.monad)]
                      (|> (do (/.with io.monad)