Finishing the meta-compiler [Part 5]

5 files changed, 180 insertions, 4 deletions

diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux
index b68adfedd..8ff0e74a2 100644
--- a/stdlib/source/test/lux/target/python.lux
+++ b/stdlib/source/test/lux/target/python.lux
@@ -579,6 +579,94 @@
                         false)))
         )))
 
+(def: test|loop
+  Test
+  (do [! random.monad]
+    [base (# ! each (n.% 100) random.nat)
+     factor (# ! each (|>> (n.% 10) ++) random.nat)
+     extra (# ! each (|>> (n.% 10) ++) random.nat)
+     .let [expected (n.* factor base)]
+     $iteration (# ! each (|>> %.nat (format "iteration_") /.var) random.nat)
+     $temp (# ! each (|>> %.nat (format "temp_") /.var) random.nat)]
+    ($_ _.and
+        (_.cover [/.while]
+                 (and (|> (..statement
+                           (function (_ $output)
+                             ($_ /.then
+                                 (/.set (list $output) (/.int +0))
+                                 (/.set (list $iteration) (/.int +0))
+                                 (/.while (/.< (/.int (.int factor)) $iteration)
+                                          ($_ /.then
+                                              (/.set (list $output) (/.+ (/.int (.int base))
+                                                                         $output))
+                                              (/.set (list $iteration) (/.+ (/.int +1)
+                                                                            $iteration))
+                                              )
+                                          {.#None}))))
+                          (:as Nat)
+                          (n.= expected))
+                      (|> (..statement
+                           (function (_ $output)
+                             ($_ /.then
+                                 (/.set (list $temp) (/.int +0))
+                                 (/.set (list $iteration) (/.int +0))
+                                 (/.while (/.< (/.int (.int factor)) $iteration)
+                                          ($_ /.then
+                                              (/.set (list $temp) (/.+ (/.int (.int base))
+                                                                       $temp))
+                                              (/.set (list $iteration) (/.+ (/.int +1)
+                                                                            $iteration))
+                                              )
+                                          {.#Some (/.set (list $output) $temp)}))))
+                          (:as Nat)
+                          (n.= expected))))
+        (_.cover [/.for_in]
+                 (|> (..statement
+                      (function (_ $output)
+                        ($_ /.then
+                            (/.set (list $output) (/.int +0))
+                            (/.for_in $iteration
+                                      (/.list (list.repeated factor (/.int (.int base))))
+                                      (/.set (list $output) (/.+ $iteration
+                                                                 $output))))))
+                     (:as Nat)
+                     (n.= expected)))
+        (_.cover [/.pass]
+                 (|> (..statement
+                      (function (_ $output)
+                        ($_ /.then
+                            (/.set (list $output) (/.int +0))
+                            (/.set (list $iteration) (/.int +0))
+                            (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration)
+                                     ($_ /.then
+                                         (/.set (list $iteration) (/.+ (/.int +1)
+                                                                       $iteration))
+                                         (/.if (/.> (/.int (.int extra)) $iteration)
+                                           (/.set (list $output) (/.+ (/.int (.int base))
+                                                                      $output))
+                                           /.pass))
+                                     {.#None}))))
+                     (:as Nat)
+                     (n.= expected)))
+        (_.cover [/.continue]
+                 (|> (..statement
+                      (function (_ $output)
+                        ($_ /.then
+                            (/.set (list $output) (/.int +0))
+                            (/.set (list $iteration) (/.int +0))
+                            (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration)
+                                     ($_ /.then
+                                         (/.set (list $iteration) (/.+ (/.int +1)
+                                                                       $iteration))
+                                         (/.if (/.> (/.int (.int extra)) $iteration)
+                                           (/.set (list $output) (/.+ (/.int (.int base))
+                                                                      $output))
+                                           /.continue))
+                                     {.#None}))))
+                     (:as Nat)
+                     (n.= expected)))
+        )))
+
 (def: test|statement
   Test
   (do [! random.monad]
@@ -636,6 +724,8 @@
         ..test|exception
         (_.for [/.Location]
                ..test|location)
+        (_.for [/.Loop]
+               ..test|loop)
         )))
 
 (def: random_expression
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux
index 62dbff389..3afb5c406 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux
@@ -39,7 +39,7 @@
   ["[1][0]" module]
   ["[1][0]" unit]])
 
-(def: (descriptor module hash)
+(def: .public (descriptor module hash)
   (-> /descriptor.Module Nat /descriptor.Descriptor)
   [/descriptor.#name module
    /descriptor.#file (format module ".lux")
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
index a92a50ea7..c826d030a 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
@@ -15,6 +15,7 @@
  [\\library
   ["[0]" /]]
  ["[0]" / "_"
+  ["[1][0]" archive]
   ["[1][0]" module]
   ["[1][0]" artifact]
   ["$/[1]" // "_"
@@ -45,6 +46,7 @@
                                  post/0
                                  post/1))))
 
+            /archive.test
             /module.test
             /artifact.test
             ))))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux
new file mode 100644
index 000000000..03a0d376b
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux
@@ -0,0 +1,84 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    ["[0]" try ("[1]#[0]" functor)]
+    [concurrency
+     ["[0]" async]]]
+   [data
+    ["[0]" binary ("[1]#[0]" equivalence)]
+    [collection
+     ["[0]" sequence]]]
+   [math
+    ["[0]" random]
+    [number
+     ["n" nat]]]
+   [world
+    ["[0]" file]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" //
+    ["/[1]" //
+     ["[0]" archive
+      ["[0]" signature]
+      ["[0]" key]
+      ["[0]" registry]
+      ["[0]" module
+       ["[0]" document]]]]]]]
+ ["$" // "_"
+  [//
+   ["[1][0]" context]
+   ["[1][0]" archive
+    ["[2][0]" signature]]]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [.let [/ "/"
+               fs (file.mock /)]
+         context $context.random
+         module/0 (random.ascii/lower 1)
+         module/1 (random.ascii/lower 2)
+         content/0 random.nat
+         content/1 (random.only (|>> (n.= content/0) not) random.nat)
+         hash random.nat
+         signature $signature.random
+         .let [key (key.key signature content/0)
+               [archive expected] (|> (do try.monad
+                                        [[@module/0 archive] (archive.reserve module/0 archive.empty)
+                                         [@module/1 archive] (archive.reserve module/1 archive)
+                                         .let [entry/0 [archive.#module [module.#id @module/0
+                                                                         module.#descriptor ($archive.descriptor module/0 hash)
+                                                                         module.#document (document.document key content/0)]
+                                                        archive.#output sequence.empty
+                                                        archive.#registry registry.empty]
+                                               entry/1 [archive.#module [module.#id @module/1
+                                                                         module.#descriptor ($archive.descriptor module/1 hash)
+                                                                         module.#document (document.document key content/1)]
+                                                        archive.#output sequence.empty
+                                                        archive.#registry registry.empty]]
+                                         archive (archive.has module/0 entry/0 archive)
+                                         archive (archive.has module/1 entry/1 archive)]
+                                        (in [archive (archive.export ///.version archive)]))
+                                      try.trusted)]]
+        ($_ _.and
+            (in (do async.monad
+                  [pre/0 (# fs file? (/.descriptor fs context))
+                   enabled? (//.enable! fs context)
+                   cached? (/.cache! fs context archive)
+                   actual (# fs read (/.descriptor fs context))
+                   post/0 (# fs file? (/.descriptor fs context))]
+                  (_.cover' [/.descriptor /.cache!]
+                            (and (not pre/0)
+                                 (|> (do try.monad
+                                       [_ enabled?
+                                        _ cached?]
+                                       actual)
+                                     (try#each (binary#= expected))
+                                     (try.else false))
+                                 post/0))))
+            ))))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux
index a9140b6a6..d3ba700a2 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux
@@ -38,10 +38,10 @@
             (in (do async.monad
                   [pre (# fs file? (/.path fs context @module @artifact))
                    _ (//module.enable! fs context @module)
-                   write! (/.write! fs context @module @artifact expected)
+                   write! (/.cache! fs context @module @artifact expected)
                    post (# fs file? (/.path fs context @module @artifact))
-                   read! (/.read! fs context @module @artifact)]
-                  (_.cover' [/.path /.write! /.read!]
+                   read! (/.cache fs context @module @artifact)]
+                  (_.cover' [/.path /.cache! /.cache]
                             (and (not pre)
                                  (case write!
                                    {try.#Success _} true