Improved compilation of loops and pattern-matching for Python.

11 files changed, 194 insertions, 61 deletions

diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux
index 371fde55e..192978ebf 100644
--- a/stdlib/source/test/aedifex/artifact/snapshot.lux
+++ b/stdlib/source/test/aedifex/artifact/snapshot.lux
@@ -16,7 +16,8 @@
    ["#." build]
    ["#." time]
    ["#." stamp]
-   ["#." version]]
+   ["#." version
+    ["#/." value]]]
   {#program
    ["." /]})
 
@@ -47,4 +48,5 @@
                  $/time.test
                  $/stamp.test
                  $/version.test
+                 $/version/value.test
                  ))))
diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux
new file mode 100644
index 000000000..dc3f754a2
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux
@@ -0,0 +1,66 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [control
+    ["." try ("#\." functor)]
+    [parser
+     ["<.>" text]]]
+   [data
+    ["." text ("#\." equivalence)
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random) ("#\." monad)]
+    [number
+     ["n" nat]
+     ["i" int]]]
+   [time
+    ["." instant]]]
+  ["$." /// #_
+   ["#." stamp]]
+  {#program
+   ["." /
+    ["//#" ///
+     ["#." stamp]
+     ["#." time]]]})
+
+(def: #export random
+  (Random /.Value)
+  ($_ random.and
+      (random.ascii/alpha 5)
+      (random.or (random\wrap [])
+                 $///stamp.random)
+      ))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Value])
+      ($_ _.and
+          (_.for [/.equivalence]
+                 ($equivalence.spec /.equivalence ..random))
+
+          (do random.monad
+            [sample random
+             stamp $///stamp.random]
+            (let [version (get@ #/.version sample)
+
+                  local!
+                  (text\= version
+                          (/.format (set@ #/.snapshot #///.Local sample)))
+
+                  remote_format (/.format {#/.version (format version /.snapshot)
+                                           #/.snapshot (#///.Remote stamp)})
+                  remote!
+                  (and (text.starts_with? (format version (///time.format (get@ #///stamp.time stamp)))
+                                          remote_format)
+                       (text.ends_with? (%.nat (get@ #///stamp.build stamp))
+                                        remote_format))]
+              (_.cover [/.snapshot /.format]
+                       (and local!
+                            remote!))))
+          )))
diff --git a/stdlib/source/test/aedifex/artifact/value.lux b/stdlib/source/test/aedifex/artifact/value.lux
deleted file mode 100644
index 10e9016b1..000000000
--- a/stdlib/source/test/aedifex/artifact/value.lux
+++ /dev/null
@@ -1,38 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [abstract
-    [monad (#+ do)]
-    {[0 #spec]
-     [/
-      ["$." equivalence]]}]
-   [control
-    ["." try ("#\." functor)]
-    [parser
-     ["<.>" text]]]
-   [math
-    ["." random (#+ Random)]
-    [number
-     ["n" nat]
-     ["i" int]]]
-   [time
-    ["." instant]]]
-  {#program
-   ["." /]})
-
-(def: #export random
-  (Random /.Value)
-  ($_ random.and
-      (random.ascii/alpha 5)
-      random.instant
-      random.nat
-      ))
-
-(def: #export test
-  Test
-  (<| (_.covering /._)
-      (_.for [/.Build /.Value])
-      ($_ _.and
-          (_.for [/.equivalence]
-                 ($equivalence.spec /.equivalence ..random))
-          )))
diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux
index 7fc3196cd..ee6ad2b43 100644
--- a/stdlib/source/test/lux/control/concurrency/promise.lux
+++ b/stdlib/source/test/lux/control/concurrency/promise.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
    ["_" test (#+ Test)]
+   ["@" target]
    [abstract
     [monad (#+ do)]
     {[0 #spec]
@@ -18,7 +19,8 @@
     ["." random]
     [number
      ["n" nat]
-     ["i" int]]]]
+     ["i" int]
+     ["." i64]]]]
   {1
    ["." /
     [//
@@ -43,11 +45,16 @@
                _
                false))))))
 
+(def: delay
+  (for {@.js
+        (i64.left_shift 4 1)}
+       (i64.left_shift 3 1)))
+
 (def: #export test
   Test
   (<| (_.covering /._)
       (do {! random.monad}
-        [to_wait (|> random.nat (\ ! map (|>> (n.% 10) (n.+ 10))))
+        [to_wait (|> random.nat (\ ! map (|>> (n.% ..delay) (n.+ ..delay))))
          expected random.nat
          dummy random.nat
          #let [not_dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))]
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 472e21c7d..729e986c2 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -1,6 +1,7 @@
 (.module:
   [lux #*
    ["_" test (#+ Test)]
+   ["@" target]
    [abstract
     ["." monad (#+ do)]
     ["." enum]]
@@ -20,12 +21,18 @@
    [math
     ["." random]
     [number
-     ["n" nat]]]
+     ["n" nat]
+     ["." i64]]]
    [type
     ["." refinement]]]
   {1
    ["." /]})
 
+(def: delay
+  (for {@.js
+        (i64.left_shift 4 1)}
+       (i64.left_shift 3 1)))
+
 (def: semaphore
   Test
   (_.for [/.Semaphore]
@@ -34,7 +41,7 @@
                [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
                 #let [semaphore (/.semaphore initial_open_positions)]]
                (wrap (do promise.monad
-                       [result (promise.time_out 10 (/.wait semaphore))]
+                       [result (promise.time_out ..delay (/.wait semaphore))]
                        (_.cover' [/.semaphore]
                                  (case result
                                    (#.Some _)
@@ -47,7 +54,7 @@
                 #let [semaphore (/.semaphore initial_open_positions)]]
                (wrap (do {! promise.monad}
                        [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore))
-                        result (promise.time_out 10 (/.wait semaphore))]
+                        result (promise.time_out ..delay (/.wait semaphore))]
                        (_.cover' [/.wait]
                                  (case result
                                    (#.Some _)
@@ -61,9 +68,9 @@
                (wrap (do {! promise.monad}
                        [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore))
                         #let [block (/.wait semaphore)]
-                        result/0 (promise.time_out 10 block)
+                        result/0 (promise.time_out ..delay block)
                         open_positions (/.signal semaphore)
-                        result/1 (promise.time_out 10 block)]
+                        result/1 (promise.time_out ..delay block)]
                        (_.cover' [/.signal]
                                  (case [result/0 result/1 open_positions]
                                    [#.None (#.Some _) (#try.Success +0)]
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux
index 07c02ea09..89237babc 100644
--- a/stdlib/source/test/lux/data/binary.lux
+++ b/stdlib/source/test/lux/data/binary.lux
@@ -51,14 +51,15 @@
     (#try.Success _)
     false))
 
-(def: (binary_io bytes read write value)
+(def: (binary_io power read write value)
   (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit)
-  (let [binary (/.create bytes)
+  (let [bytes (i64.left_shift power 1)
+        binary (/.create bytes)
         cap (case bytes
               8 (dec 0)
               _ (|> 1 (i64.left_shift (n.* 8 bytes)) dec))
         capped_value (i64.and cap value)]
-    (and (succeed
+    (and (..succeed
           (do try.monad
             [pre (read 0 binary)
              _ (write 0 value binary)
@@ -104,23 +105,23 @@
                    (_.for [/.index_out_of_bounds]
                           ($_ _.and
                               (_.cover [/.read/8 /.write/8]
-                                       (..binary_io 1 /.read/8 /.write/8 value))
+                                       (..binary_io 0 /.read/8 /.write/8 value))
                               (_.cover [/.read/16 /.write/16]
-                                       (..binary_io 2 /.read/16 /.write/16 value))
+                                       (..binary_io 1 /.read/16 /.write/16 value))
                               (_.cover [/.read/32 /.write/32]
-                                       (..binary_io 4 /.read/32 /.write/32 value))
+                                       (..binary_io 2 /.read/32 /.write/32 value))
                               (_.cover [/.read/64 /.write/64]
-                                       (..binary_io 8 /.read/64 /.write/64 value))))
+                                       (..binary_io 3 /.read/64 /.write/64 value))))
                    (_.cover [/.slice]
                             (let [slice_size (|> to (n.- from) inc)
                                   random_slice (try.assume (/.slice from to sample))
                                   idxs (enum.range n.enum 0 (dec slice_size))
                                   reader (function (_ binary idx) (/.read/8 idx binary))]
                               (and (n.= slice_size (/.size random_slice))
-                                   (case [(monad.map try.monad (reader random_slice) idxs)
-                                          (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)]
-                                     [(#try.Success slice_vals) (#try.Success binary_vals)]
-                                     (\ (list.equivalence n.equivalence) = slice_vals binary_vals)
+                                   (case [(monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)
+                                          (monad.map try.monad (reader random_slice) idxs)]
+                                     [(#try.Success binary_vals) (#try.Success slice_vals)]
+                                     (\ (list.equivalence n.equivalence) = binary_vals slice_vals)
 
                                      _
                                      #0))))
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 855c6e8bb..d032a47b5 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -3,7 +3,8 @@
    ["." debug]
    ["@" target
     ["." jvm]
-    ["." js]]
+    ["." js]
+    ["." python]]
    [abstract
     [monad (#+ do)]]
    [control
@@ -61,8 +62,8 @@
          (wrap (for {@.jvm
                      (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self))))
 
-                     @.js
-                     (js.string self)})))))
+                     @.js (js.string self)
+                     @.python (python.unicode self)})))))
 
 (for {@.old
       (as_is)}
diff --git a/stdlib/source/test/lux/host.py.lux b/stdlib/source/test/lux/host.py.lux
new file mode 100644
index 000000000..0b6cac81b
--- /dev/null
+++ b/stdlib/source/test/lux/host.py.lux
@@ -0,0 +1,24 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try]]
+   [data
+    ["." text ("#\." equivalence)]]
+   [math
+    ["." random (#+ Random)]
+    [number
+     ["." nat]
+     ["." frac]]]]
+  {1
+   ["." /]})
+
+(def: #export test
+  Test
+  (do {! random.monad}
+    []
+    (<| (_.covering /._)
+        (_.test "TBD"
+                true))))
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index a140a736d..403205dad 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -21,7 +21,8 @@
     ["#/." continuous]
     ["#/." fuzzy]]])
 
-(def: margin Frac +0.0000001)
+(def: margin
+  +0.0000001)
 
 (def: (trigonometric_symmetry forward backward angle)
   (-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux
index 70b13a382..b1d205e4a 100644
--- a/stdlib/source/test/lux/type.lux
+++ b/stdlib/source/test/lux/type.lux
@@ -21,6 +21,7 @@
    ["#." check]
    ["#." dynamic]
    ["#." implicit]
+   ["#." quotient]
    ["#." resource]])
 
 (def: short
@@ -169,5 +170,6 @@
           /check.test
           /dynamic.test
           /implicit.test
+          /quotient.test
           /resource.test
           )))
diff --git a/stdlib/source/test/lux/type/quotient.lux b/stdlib/source/test/lux/type/quotient.lux
new file mode 100644
index 000000000..ef19c6841
--- /dev/null
+++ b/stdlib/source/test/lux/type/quotient.lux
@@ -0,0 +1,60 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    ["." monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [data
+    ["." text ("#\." equivalence)
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random)]
+    [number
+     ["n" nat ("#\." equivalence)]]]]
+  {1
+   ["." /]})
+
+(def: #export (random class super)
+  (All [t c %] (-> (/.Class t c %) (Random t) (Random (/.Quotient t c %))))
+  (\ random.monad map (/.quotient class) super))
+
+(def: mod_10_class
+  (/.class (|>> (n.% 10) %.nat)))
+
+(def: Mod_10
+  (/.type ..mod_10_class))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do random.monad
+        [modulus (random.filter (n.> 0) random.nat)
+         #let [class (: (-> Nat Text)
+                        (|>> (n.% modulus) %.nat))]
+         value random.nat]
+        ($_ _.and
+            (_.for [/.equivalence]
+                   ($equivalence.spec (/.equivalence text.equivalence)
+                                      (..random (/.class class) random.nat)))
+
+            (_.for [/.Class]
+                   (_.cover [/.class]
+                            (is? (: Any class)
+                                 (: Any (/.class class)))))
+            (_.for [/.Quotient]
+                   ($_ _.and
+                       (_.cover [/.quotient /.value /.label]
+                                (let [quotient (/.quotient (/.class class) value)]
+                                  (and (is? value
+                                            (/.value quotient))
+                                       (text\= (class value)
+                                               (/.label quotient)))))
+                       (_.cover [/.type]
+                                (exec
+                                  (: ..Mod_10
+                                     (/.quotient ..mod_10_class value))
+                                  true))
+                       ))
+            ))))