Updates for Lua compiler.

5 files changed, 162 insertions, 38 deletions

diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux
index c0704440e..ab0e94236 100644
--- a/stdlib/source/test/aedifex/artifact/versioning.lux
+++ b/stdlib/source/test/aedifex/artifact/versioning.lux
@@ -13,14 +13,17 @@
    [math
     ["." random (#+ Random)]]]
   {#program
-   ["." /]})
+   ["." /]}
+  ["$." // #_
+   ["#." snapshot
+    ["#/." version]]])
 
 (def: #export random
   (Random /.Versioning)
   ($_ random.and
+      $//snapshot.random
       random.instant
-      random.nat
-      (random.list 5 (random.ascii/lower_alpha 3))
+      (random.list 5 $//snapshot/version.random)
       ))
 
 (def: #export test
@@ -32,12 +35,19 @@
                  ($equivalence.spec /.equivalence ..random))
           
           (do random.monad
-            [expected ..random
-             version (random.ascii/upper_alpha 3)]
+            [expected ..random]
             (_.cover [/.format /.parser]
                      (|> expected
-                         (/.format version)
-                         (<xml>.run (/.parser version))
+                         /.format
+                         list
+                         (<xml>.run /.parser)
                          (try\map (\ /.equivalence = expected))
                          (try.default false))))
+          (_.cover [/.init]
+                   (|> /.init
+                       /.format
+                       list
+                       (<xml>.run /.parser)
+                       (try\map (\ /.equivalence = /.init))
+                       (try.default false)))
           )))
diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux
index c8496c210..ab86747e5 100644
--- a/stdlib/source/test/lux/control/concurrency/atom.lux
+++ b/stdlib/source/test/lux/control/concurrency/atom.lux
@@ -15,25 +15,49 @@
 (def: #export test
   Test
   (<| (_.covering /._)
-      (do random.monad
-        [value random.nat
-         swap_value random.nat
-         set_value random.nat
-         #let [box (/.atom value)]]
-        ($_ _.and
+      ($_ _.and
+          (do random.monad
+            [expected random.nat
+             #let [box (/.atom expected)]]
             (_.cover [/.Atom /.atom /.read]
-                     (n.= value
-                          (io.run (/.read box))))
+                     (io.run
+                      (do io.monad
+                        [actual (/.read box)]
+                        (wrap (is? expected actual))))))
+          (do random.monad
+            [target random.nat
+             unknown (random.filter (|>> (is? target) not) random.nat)
+             expected random.nat
+             #let [box (/.atom target)]]
             (_.cover [/.compare_and_swap]
-                     (and (io.run (/.compare_and_swap value swap_value box))
-                          (n.= swap_value
-                               (io.run (/.read box)))))
+                     (io.run
+                      (do io.monad
+                        [swapped_unknown? (/.compare_and_swap unknown expected box)
+                         swapped_target? (/.compare_and_swap target expected box)
+                         actual (/.read box)]
+                        (wrap (and (not swapped_unknown?)
+                                   swapped_target?
+                                   (is? expected actual)))))))
+          (do random.monad
+            [init random.nat
+             shift random.nat
+             #let [box (/.atom init)]]
             (_.cover [/.update]
-                     (exec (io.run (/.update inc box))
-                       (n.= (inc swap_value)
-                            (io.run (/.read box)))))
+                     (io.run
+                      (do io.monad
+                        [[pre post] (/.update (n.+ shift) box)]
+                        (wrap (and (is? init pre)
+                                   (n.= (n.+ shift init)
+                                        post)))))))
+          (do random.monad
+            [pre random.nat
+             post random.nat
+             #let [box (/.atom pre)]]
             (_.cover [/.write]
-                     (exec (io.run (/.write set_value box))
-                       (n.= set_value
-                            (io.run (/.read box)))))
-            ))))
+                     (io.run
+                      (do io.monad
+                        [old (/.write post box)
+                         new (/.read box)]
+                        (wrap (and (is? pre old)
+                                   (is? post new)))))))
+          )))
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 729e986c2..a8e64124c 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -154,26 +154,26 @@
                           _
                           false)))
              (do {! random.monad}
-               [limit (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+               [limit (\ ! map (|>> (n.% 9) inc) random.nat)
                 #let [barrier (/.barrier (maybe.assume (/.limit limit)))
                       resource (atom.atom "")]]
                (wrap (do {! promise.monad}
-                       [#let [ending (|> "_"
-                                         (list.repeat limit)
-                                         (text.join_with ""))
-                              ids (enum.range n.enum 0 (dec limit))
-                              waiters (list\map (function (_ id)
-                                                  (exec (io.run (atom.update (|>> (format "_")) resource))
-                                                    (waiter resource barrier id)))
-                                                ids)]
-                        _ (monad.seq ! waiters)
+                       [#let [suffix "_"
+                              expected_ending (|> suffix
+                                                  (list.repeat limit)
+                                                  (text.join_with ""))
+                              expected_ids (enum.range n.enum 0 (dec limit))]
+                        _ (|> expected_ids
+                              (list\map (function (_ id)
+                                          (exec (io.run (atom.update (|>> (format suffix)) resource))
+                                            (waiter resource barrier id))))
+                              (monad.seq !))
                         #let [outcome (io.run (atom.read resource))]]
                        (_.cover' [/.barrier /.block]
-                                 (and (text.ends_with? ending outcome)
+                                 (and (text.ends_with? expected_ending outcome)
                                       (list.every? (function (_ id)
                                                      (text.contains? (%.nat id) outcome))
-                                                   ids)
-                                      )))))
+                                                   expected_ids))))))
              )))
 
 (def: #export test
diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux
index b1d205e4a..0b3f3b4d8 100644
--- a/stdlib/source/test/lux/type.lux
+++ b/stdlib/source/test/lux/type.lux
@@ -22,6 +22,7 @@
    ["#." dynamic]
    ["#." implicit]
    ["#." quotient]
+   ["#." refinement]
    ["#." resource]])
 
 (def: short
@@ -171,5 +172,6 @@
           /dynamic.test
           /implicit.test
           /quotient.test
+          /refinement.test
           /resource.test
           )))
diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux
new file mode 100644
index 000000000..260f5f51f
--- /dev/null
+++ b/stdlib/source/test/lux/type/refinement.lux
@@ -0,0 +1,88 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [predicate (#+ Predicate)]
+    [monad (#+ do)]]
+   [data
+    ["." maybe ("#\." monad)]
+    [collection
+     ["." list ("#\." functor)]]]
+   [math
+    ["." random]
+    [number
+     ["n" nat]]]]
+  {1
+   ["." /]})
+
+(def: _refiner
+  (/.refinement (n.> 123)))
+
+(def: _type
+  (/.type _refiner))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Refined])
+      (do {! random.monad}
+        [raw random.nat
+         modulus (\ ! map (|>> (n.% 10) (n.+ 2)) random.nat)
+         #let [predicate (: (Predicate Nat)
+                            (|>> (n.% modulus) (n.= 0)))]
+         total_raws (\ ! map (|>> (n.% 20) inc) random.nat)
+         raws (random.list total_raws random.nat)]
+        ($_ _.and
+            (_.for [/.Refiner]
+                   ($_ _.and
+                       (_.cover [/.refinement]
+                                (case (/.refinement predicate raw)
+                                  (#.Some refined)
+                                  (predicate raw)
+                                  
+                                  #.None
+                                  (not (predicate raw))))
+                       (_.cover [/.predicate]
+                                (|> (/.refinement predicate modulus)
+                                    (maybe\map (|>> /.predicate (is? predicate)))
+                                    (maybe.default false)))
+                       ))
+            (_.cover [/.un_refine]
+                     (|> (/.refinement predicate modulus)
+                         (maybe\map (|>> /.un_refine (n.= modulus)))
+                         (maybe.default false)))
+            (_.cover [/.lift]
+                     (and (|> (/.refinement predicate modulus)
+                              (maybe\map (/.lift (n.+ modulus)))
+                              maybe\join
+                              (maybe\map (|>> /.un_refine (n.= (n.+ modulus modulus))))
+                              (maybe.default false))
+                          (|> (/.refinement predicate modulus)
+                              (maybe\map (/.lift (n.+ (inc modulus))))
+                              maybe\join
+                              (maybe\map (|>> /.un_refine (n.= (n.+ modulus (inc modulus)))))
+                              (maybe.default false)
+                              not)))
+            (_.cover [/.filter]
+                     (let [expected (list.filter predicate raws)
+                           actual (/.filter (/.refinement predicate) raws)]
+                       (and (n.= (list.size expected)
+                                 (list.size actual))
+                            (\ (list.equivalence n.equivalence) =
+                               expected
+                               (list\map /.un_refine actual)))))
+            (_.cover [/.partition]
+                     (let [expected (list.filter predicate raws)
+                           [actual alternative] (/.partition (/.refinement predicate) raws)]
+                       (and (n.= (list.size expected)
+                                 (list.size actual))
+                            (n.= (n.- (list.size expected) total_raws)
+                                 (list.size alternative))
+                            (\ (list.equivalence n.equivalence) =
+                               expected
+                               (list\map /.un_refine actual)))))
+            (_.cover [/.type]
+                     (exec (: (Maybe .._type)
+                              (.._refiner raw))
+                       true))
+            ))))