Fixed some tests.

12 files changed, 196 insertions, 167 deletions

diff --git a/stdlib/source/test/lux/control/order.lux b/stdlib/source/test/lux/control/order.lux
index b57489b0f..f18d110c2 100644
--- a/stdlib/source/test/lux/control/order.lux
+++ b/stdlib/source/test/lux/control/order.lux
@@ -11,7 +11,7 @@
   {1
    ["." / (#+ Order)]})
 
-(def: #export (spec (^open "_@.") generator)
+(def: #export (spec (^open ",@.") generator)
   (All [a] (-> (Order a) (Random a) Test))
   (do r.monad
     [left generator
@@ -19,9 +19,9 @@
     (<| (_.context (%name (name-of /.Order)))
         ($_ _.and
             (_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
-                    (if (_@= left right)
-                      (not (or (_@< left right)
-                               (_@> left right)))
-                      (if (_@< left right)
-                        (not (_@> left right))
-                        (_@> left right))))))))
+                    (if (,@= left right)
+                      (not (or (,@< left right)
+                               (,@> left right)))
+                      (if (,@< left right)
+                        (not (,@> left right))
+                        (,@> left right))))))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux
index 383e250b5..987a72f45 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose.lux
@@ -28,20 +28,28 @@
       
       1
       singleton
+
+      2
+      (do r.monad
+        [value gen-value
+         single (tree 1 gen-value)]
+        (wrap (/.branch value (list single))))
       
       _
       (do r.monad
         [value gen-value
-         children (r.list (n/+ 2 (n/% 2 size))
-                          (tree (n// 2 size) gen-value))]
-        (wrap (/.branch value children)))
+         #let [size (dec size)]
+         left (tree (n// 2 size) gen-value)
+         right (tree (n/+ (n/% 2 size) (n// 2 size))
+                     gen-value)]
+        (wrap (/.branch value (list left right))))
       )))
 
 (def: #export test
   Test
   (<| (_.context (%name (name-of /.Tree)))
       (do r.monad
-        [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)]
+        [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)]
         ($_ _.and
             ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat))
             ($fold.spec /.leaf /.equivalence /.fold)
diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
index 379b17c16..3a3bd296c 100644
--- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
@@ -21,19 +21,13 @@
    ["." / (#+ Zipper)]}
   )
 
-(def: (to-end zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (loop [zipper zipper]
-    (if (/.end? zipper)
-      zipper
-      (recur (/.next zipper)))))
-
 (def: #export test
   Test
   (<| (_.context (%name (name-of /.Zipper)))
       (do r.monad
-        [size (:: @ map (|>> (n/% 100) (n/max 10)) r.nat)
+        [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat)
          sample (//.tree size r.nat)
+         mid-val r.nat
          new-val r.nat
          pre-val r.nat
          post-val r.nat
@@ -44,74 +38,79 @@
                     (|> sample
                         /.zip /.unzip
                         (tree@= sample)))
-            (_.test "Creating a zipper gives you a root node."
-                    (|> sample /.zip /.root?))
+            (_.test "Creating a zipper gives you a start node."
+                    (|> sample /.zip /.start?))
             (_.test "Can move down inside branches. Can move up from lower nodes."
                     (let [zipper (/.zip sample)]
                       (if (/.branch? zipper)
                         (let [child (|> zipper /.down)]
                           (and (not (tree@= sample (/.unzip child)))
                                (|> child /.up (is? zipper) not)
-                               (|> child /.root (is? zipper) not)))
+                               (|> child /.start (is? zipper) not)))
                         (and (/.leaf? zipper)
                              (|> zipper (/.prepend-child new-val) /.branch?)))))
-            (_.test "Can prepend and append children."
-                    (let [zipper (/.zip sample)]
-                      (if (/.branch? zipper)
-                        (let [mid-val (|> zipper /.down /.value)
-                              zipper (|> zipper
-                                         (/.prepend-child pre-val)
-                                         (/.append-child post-val))]
-                          (and (|> zipper /.down /.value (is? pre-val))
-                               (|> zipper /.down /.right /.value (is? mid-val))
-                               (|> zipper /.down /.right /.right /.value (is? post-val))
-                               (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
-                               (|> zipper /.down /.right /.left /.value (is? pre-val))
-                               (|> zipper /.down /.rightmost /.value (is? post-val))))
-                        true)))
-            (_.test "Can insert children around a node (unless it's root)."
-                    (let [zipper (/.zip sample)]
-                      (if (/.branch? zipper)
-                        (let [mid-val (|> zipper /.down /.value)
-                              zipper (|> zipper
-                                         /.down
-                                         (/.insert-left pre-val)
-                                         maybe.assume
-                                         (/.insert-right post-val)
-                                         maybe.assume
-                                         /.up)]
-                          (and (|> zipper /.down /.value (is? pre-val))
-                               (|> zipper /.down /.right /.value (is? mid-val))
-                               (|> zipper /.down /.right /.right /.value (is? post-val))
-                               (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
-                               (|> zipper /.down /.right /.left /.value (is? pre-val))
-                               (|> zipper /.down /.rightmost /.value (is? post-val))))
-                        (and (|> zipper (/.insert-left pre-val) (case> (#.Some _) false
-                                                                       #.None     true))
-                             (|> zipper (/.insert-right post-val) (case> (#.Some _) false
-                                                                         #.None     true))))))
+            (do @
+              [branch-value r.nat
+               #let [zipper (|> (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))
+                                (/.prepend-child pre-val)
+                                (/.append-child post-val))]]
+              (_.test "Can prepend and append children."
+                      (and (and (|> zipper /.down /.value (is? pre-val))
+                                (|> zipper /.down /.right /.left /.value (is? pre-val))
+                                (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)))
+                           (|> zipper /.down /.right /.value (is? mid-val))
+                           (and (|> zipper /.down /.right /.right /.value (is? post-val))
+                                (|> zipper /.down /.rightmost /.value (is? post-val))))))
+            (do @
+              [branch-value r.nat
+               #let [zipper (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))]]
+              (_.test "Can insert children around a node (unless it's start)."
+                      (and (let [zipper (|> zipper
+                                            /.down
+                                            (/.insert-left pre-val)
+                                            maybe.assume
+                                            (/.insert-right post-val)
+                                            maybe.assume
+                                            /.up)]
+                             (and (|> zipper /.down /.value (is? pre-val))
+                                  (|> zipper /.down /.right /.value (is? mid-val))
+                                  (|> zipper /.down /.right /.right /.value (is? post-val))
+                                  (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
+                                  (|> zipper /.down /.right /.left /.value (is? pre-val))
+                                  (|> zipper /.down /.rightmost /.value (is? post-val))))
+                           (and (|> zipper
+                                    (/.insert-left pre-val)
+                                    (case> (#.Some _) false
+                                           #.None     true))
+                                (|> zipper
+                                    (/.insert-right post-val)
+                                    (case> (#.Some _) false
+                                           #.None     true))))))
             (_.test "Can set and update the value of a node."
                     (|> sample /.zip (/.set new-val) /.value (n/= new-val)))
             (_.test "Zipper traversal follows the outline of the tree depth-first."
-                    (list@= (rose.flatten sample)
-                            (loop [zipper (/.zip sample)]
-                              (if (/.end? zipper)
-                                (list (/.value zipper))
-                                (#.Cons (/.value zipper)
-                                        (recur (/.next zipper)))))))
+                    (let [root (/.zip sample)]
+                      (list@= (rose.flatten sample)
+                              (loop [zipper (/.start root)]
+                                (let [zipper' (/.next zipper)]
+                                  (#.Cons (/.value zipper)
+                                          (if (:: (/.equivalence nat.equivalence) = root zipper')
+                                            (list)
+                                            (recur zipper'))))))))
             (_.test "Backwards zipper traversal yield reverse tree flatten."
-                    (list@= (list.reverse (rose.flatten sample))
-                            (loop [zipper (to-end (/.zip sample))]
-                              (if (/.root? zipper)
-                                (list (/.value zipper))
+                    (let [root (/.zip sample)]
+                      (list@= (list.reverse (rose.flatten sample))
+                              (loop [zipper (/.end root)]
                                 (#.Cons (/.value zipper)
-                                        (recur (/.prev zipper)))))))
-            (_.test "Can remove nodes (except root nodes)."
+                                        (if (:: (/.equivalence nat.equivalence) = root zipper)
+                                          (list)
+                                          (recur (/.prev zipper))))))))
+            (_.test "Can remove nodes (except start nodes)."
                     (let [zipper (/.zip sample)]
                       (if (/.branch? zipper)
-                        (and (|> zipper /.down /.root? not)
+                        (and (|> zipper /.down /.start? not)
                              (|> zipper /.down /.remove (case> #.None false
-                                                               (#.Some node) (/.root? node))))
+                                                               (#.Some node) (/.start? node))))
                         (|> zipper /.remove (case> #.None     true
                                                    (#.Some _) false)))))
             ))))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 3dc7ec7d4..5ec12e6e2 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -11,23 +11,41 @@
 
 (def: #export test
   Test
-  (`` ($_ _.and
-          (~~ (do-template [<expr> <text>]
-                [(_.test (format "Can produce Code node: " <text>)
-                         (and (text@= <text> (/.to-text <expr>))
-                              (:: /.equivalence = <expr> <expr>)))]
+  (<| (_.context (%name (name-of /._)))
+      (do r.monad
+        [bit r.bit
+         nat r.nat
+         int r.int
+         rev r.rev
+         above (:: @ map (i/% +100) r.int)
+         below (:: @ map (i/% +100) r.int)
+         #let [frac (|> below
+                        (i// +100)
+                        .int-to-frac
+                        (f/+ (.int-to-frac above))
+                        (f/* -1.0))]
+         text (r.ascii 10)
+         short (r.ascii/alpha 10)
+         module (r.ascii/alpha 10)
+         #let [name [module short]]]
+        (`` ($_ _.and
+                (~~ (do-template [<desc> <code> <text>]
+                      [(let [code <code>]
+                         (_.test (format "Can produce " <desc> " code node.")
+                                 (and (text@= <text> (/.to-text code))
+                                      (:: /.equivalence = code code))))]
 
-                [(/.bit #1)                                  "#1"]
-                [(/.bit #0)                                  "#0"]
-                [(/.nat 123)                                 "123"]
-                [(/.int +123)                                "+123"]
-                [(/.frac +123.0)                             "+123.0"]
-                [(/.text "1234")                             (format text.double-quote "1234" text.double-quote)]
-                [(/.local-tag "lol")                         "#lol"]
-                [(/.tag ["yolo" "lol"])                      "#yolo.lol"]
-                [(/.local-identifier "lol")                  "lol"]
-                [(/.identifier ["yolo" "lol"])               "yolo.lol"]
-                [(/.form (list (/.bit #1) (/.int +123)))     "(#1 +123)"]
-                [(/.tuple (list (/.bit #1) (/.int +123)))    "[#1 +123]"]
-                [(/.record (list [(/.bit #1) (/.int +123)])) "{#1 +123}"]
-                )))))
+                      ["bit"              (/.bit bit)                                 (%b bit)]
+                      ["nat"              (/.nat nat)                                 (%n nat)]
+                      ["int"              (/.int int)                                 (%i int)]
+                      ["rev"              (/.rev rev)                                 (%r rev)]
+                      ["frac"             (/.frac frac)                               (%f frac)]
+                      ["text"             (/.text text)                               (%t text)]
+                      ["local-ltag"       (/.local-tag short)                         (format "#" short)]
+                      ["lag"              (/.tag [module short])                      (format "#" (%name name))]
+                      ["local-identifier" (/.local-identifier short)                  short]
+                      ["identifier"       (/.identifier [module short])               (%name name)]
+                      ["form"             (/.form (list (/.bit bit) (/.int int)))     (format "(" (%b bit) " " (%i int) ")")]
+                      ["tuple"            (/.tuple (list (/.bit bit) (/.int int)))    (format "[" (%b bit) " " (%i int) "]")]
+                      ["record"           (/.record (list [(/.bit bit) (/.int int)])) (format "{" (%b bit) " " (%i int) "}")]
+                      )))))))
diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux
index afe5f208e..e9f0428a1 100644
--- a/stdlib/source/test/lux/macro/syntax.lux
+++ b/stdlib/source/test/lux/macro/syntax.lux
@@ -152,5 +152,4 @@
                                          /.end!))
                            (fails? (p.run (list (code.bit #1))
                                           /.end!))))
-              )
-          )))
+              ))))
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux
index 242b08503..97655ee9b 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/modular.lux
@@ -106,7 +106,7 @@
                           (/.m/= (/.mod normalM +1)))
                       
                       #.None
-                      #1))
+                      true))
             (_.test "Can encode/decode to text."
                     (let [(^open "mod/.") (/.codec normalM)]
                       (case (|> subject mod/encode mod/decode)
@@ -114,7 +114,7 @@
                         (/.m/= subject output)
 
                         (#error.Failure error)
-                        #0)))
+                        false)))
             (_.test "Can equalize 2 moduli if they are equal."
                     (case (/.equalize (/.mod normalM _subject)
                                       (/.mod copyM _param))
@@ -122,15 +122,15 @@
                       (/.m/= param paramC)
 
                       (#error.Failure error)
-                      #0))
+                      false))
             (_.test "Cannot equalize 2 moduli if they are the different."
                     (case (/.equalize (/.mod normalM _subject)
                                       (/.mod alternativeM _param))
                       (#error.Success paramA)
-                      #0
+                      false
 
                       (#error.Failure error)
-                      #1))
+                      true))
             (_.test "All numbers are congruent to themselves."
                     (/.congruent? normalM _subject _subject))
             (_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus."
diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux
index 935e59c51..ffd055e35 100644
--- a/stdlib/source/test/lux/time/date.lux
+++ b/stdlib/source/test/lux/time/date.lux
@@ -1,15 +1,14 @@
 (.module:
   [lux #*
    data/text/format
+   ["r" math/random (#+ Random)]
    ["_" test (#+ Test)]
-   [control
+   [control ["." monad (#+ do)]
     {[0 #test]
      [/
       ["$." equivalence]
       ["$." order]
       ["$." codec]]}]
-   [math
-    ["r" random (#+ Random)]]
    [time
     ["@." instant]]]
   [//
@@ -23,9 +22,9 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ($equivalence.spec /.equivalence ..date)
-      ($order.spec /.order ..date)
-      (<| (_.seed 6623983470548808292)
-          ($codec.spec /.equivalence /.codec ..date))
-      ))
+  (<| (_.context (%name (name-of /._)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..date)
+          ($order.spec /.order ..date)
+          ($codec.spec /.equivalence /.codec ..date)
+          )))
diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux
index e0142d1b4..84d404a21 100644
--- a/stdlib/source/test/lux/time/day.lux
+++ b/stdlib/source/test/lux/time/day.lux
@@ -25,8 +25,9 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ($equivalence.spec /.equivalence ..day)
-      ($order.spec /.order ..day)
-      ($enum.spec /.enum ..day)
-      ))
+  (<| (_.context (%name (name-of /._)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..day)
+          ($order.spec /.order ..day)
+          ($enum.spec /.enum ..day)
+          )))
diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux
index ba0e35cf1..a7265f62f 100644
--- a/stdlib/source/test/lux/time/duration.lux
+++ b/stdlib/source/test/lux/time/duration.lux
@@ -23,27 +23,28 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ($equivalence.spec /.equivalence ..duration)
-      ($order.spec /.order ..duration)
-      ($monoid.spec /.equivalence /.monoid ..duration)
-      ## TODO; Uncomment ASAP
-      ## ($codec.spec /.equivalence /.codec ..duration)
+  (<| (_.context (%name (name-of /._)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..duration)
+          ($order.spec /.order ..duration)
+          ($monoid.spec /.equivalence /.monoid ..duration)
+          ## TODO; Uncomment ASAP
+          ## ($codec.spec /.equivalence /.codec ..duration)
 
-      (do r.monad
-        [millis r.int]
-        (_.test "Can convert from/to milliseconds."
-                (|> millis /.from-millis /.to-millis (i/= millis))))
-      (do r.monad
-        [sample (|> duration (:: @ map (/.frame /.day)))
-         frame duration
-         factor (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
-         #let [(^open "/@.") /.order]]
-        ($_ _.and
-            (_.test "Can scale a duration."
-                    (|> sample (/.scale-up factor) (/.query sample) (i/= (.int factor))))
-            (_.test "Scaling a duration by one does not change it."
-                    (|> sample (/.scale-up 1) (/@= sample)))
-            (_.test "Merging a duration with it's opposite yields an empty duration."
-                    (|> sample (/.merge (/.inverse sample)) (/@= /.empty)))))
-      ))
+          (do r.monad
+            [millis r.int]
+            (_.test "Can convert from/to milliseconds."
+                    (|> millis /.from-millis /.to-millis (i/= millis))))
+          (do r.monad
+            [sample (|> duration (:: @ map (/.frame /.day)))
+             frame duration
+             factor (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+             #let [(^open "/@.") /.order]]
+            ($_ _.and
+                (_.test "Can scale a duration."
+                        (|> sample (/.scale-up factor) (/.query sample) (i/= (.int factor))))
+                (_.test "Scaling a duration by one does not change it."
+                        (|> sample (/.scale-up 1) (/@= sample)))
+                (_.test "Merging a duration with it's opposite yields an empty duration."
+                        (|> sample (/.merge (/.inverse sample)) (/@= /.empty)))))
+          )))
diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux
index ec4a9456c..9b903d993 100644
--- a/stdlib/source/test/lux/time/instant.lux
+++ b/stdlib/source/test/lux/time/instant.lux
@@ -31,29 +31,30 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ($equivalence.spec /.equivalence ..instant)
-      ($order.spec /.order ..instant)
-      ($enum.spec /.enum ..instant)
-      ## TODO; Uncomment ASAP
-      ## ($codec.spec /.equivalence /.codec ..instant)
+  (<| (_.context (%name (name-of /._)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..instant)
+          ($order.spec /.order ..instant)
+          ($enum.spec /.enum ..instant)
+          ## TODO; Uncomment ASAP
+          ## ($codec.spec /.equivalence /.codec ..instant)
 
-      (do r.monad
-        [millis r.int]
-        (_.test "Can convert from/to milliseconds."
-                (|> millis /.from-millis /.to-millis (i/= millis))))
-      (do r.monad
-        [sample instant
-         span _duration.duration
-         #let [(^open "@/.") /.equivalence
-               (^open "@d/.") @d.equivalence]]
-        ($_ _.and
-            (_.test "The span of a instant and itself has an empty duration."
-                    (|> sample (/.span sample) (@d/= @d.empty)))
-            (_.test "Can shift a instant by a duration."
-                    (|> sample (/.shift span) (/.span sample) (@d/= span)))
-            (_.test "Can obtain the time-span between the epoch and an instant."
-                    (|> sample /.relative /.absolute (@/= sample)))
-            (_.test "All instants are relative to the epoch."
-                    (|> /.epoch (/.shift (/.relative sample)) (@/= sample)))))
-      ))
+          (do r.monad
+            [millis r.int]
+            (_.test "Can convert from/to milliseconds."
+                    (|> millis /.from-millis /.to-millis (i/= millis))))
+          (do r.monad
+            [sample instant
+             span _duration.duration
+             #let [(^open "@/.") /.equivalence
+                   (^open "@d/.") @d.equivalence]]
+            ($_ _.and
+                (_.test "The span of a instant and itself has an empty duration."
+                        (|> sample (/.span sample) (@d/= @d.empty)))
+                (_.test "Can shift a instant by a duration."
+                        (|> sample (/.shift span) (/.span sample) (@d/= span)))
+                (_.test "Can obtain the time-span between the epoch and an instant."
+                        (|> sample /.relative /.absolute (@/= sample)))
+                (_.test "All instants are relative to the epoch."
+                        (|> /.epoch (/.shift (/.relative sample)) (@/= sample)))))
+          )))
diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux
index 4c9365bb6..f0722af0b 100644
--- a/stdlib/source/test/lux/time/month.lux
+++ b/stdlib/source/test/lux/time/month.lux
@@ -30,8 +30,9 @@
 
 (def: #export test
   Test
-  ($_ _.and
-      ($equivalence.spec /.equivalence ..month)
-      ($order.spec /.order ..month)
-      ($enum.spec /.enum ..month)
-      ))
+  (<| (_.context (%name (name-of /._)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..month)
+          ($order.spec /.order ..month)
+          ($enum.spec /.enum ..month)
+          )))
diff --git a/stdlib/source/test/lux/world/binary.lux b/stdlib/source/test/lux/world/binary.lux
index 2f347c50d..2e463ea4b 100644
--- a/stdlib/source/test/lux/world/binary.lux
+++ b/stdlib/source/test/lux/world/binary.lux
@@ -39,9 +39,11 @@
 
 (def: (bits-io bytes read write value)
   (-> Nat (-> Nat Binary (Error Nat)) (-> Nat Nat Binary (Error Any)) Nat Bit)
-  (let [binary (/.create 8)
-        bits (n/* 8 bytes)
-        capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))]
+  (let [binary (/.create bytes)
+        cap (case bytes
+              8 (dec 0)
+              _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec))
+        capped-value (i64.and cap value)]
     (succeed
      (do error.monad
        [_ (write 0 value binary)