A few JVM-related fixes & improvements.

6 files changed, 278 insertions, 26 deletions

diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index c05f16b50..82e92e097 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -19,15 +19,7 @@
       ... ["[1]/[0]" synthesis]
       ]]]
    ["[1][0]" meta "_"
-    ["[1]/[0]" archive "_"
-     ["[1]/[0]" signature]
-     ["[1]/[0]" key]
-     ["[1]/[0]" artifact]
-     ["[1]/[0]" registry]
-     ["[1]/[0]" module]
-     ["[1]/[0]" document]
-     ["[1]/[0]" descriptor]
-     ["[1]/[0]" unit]]]
+    ["[1]/[0]" archive]]
    ]])
 
 (def: .public test
@@ -38,14 +30,7 @@
       /reference.test
       /phase.test
       /analysis.test
-      /meta/archive/signature.test
-      /meta/archive/key.test
-      /meta/archive/artifact.test
-      /meta/archive/registry.test
-      /meta/archive/module.test
-      /meta/archive/document.test
-      /meta/archive/descriptor.test
-      /meta/archive/unit.test
+      /meta/archive.test
       /phase/extension.test
       /phase/analysis/simple.test
       ... /syntax.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux
new file mode 100644
index 000000000..62dbff389
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux
@@ -0,0 +1,258 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" try]
+    ["[0]" exception]]
+   [data
+    ["[0]" product]
+    ["[0]" text
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" list]
+     ["[0]" set ("[1]#[0]" equivalence)]
+     ["[0]" sequence]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]
+   [meta
+    ["[0]" symbol "_"
+     ["$[1]" \\test]]]]]
+ [\\library
+  ["[0]" /
+   ["[1][0]" key]
+   ["[1][0]" registry]
+   ["[1][0]" signature]
+   ["[1][0]" module
+    ["[2][0]" document]
+    ["[2][0]" descriptor]]]]
+ ["$[0]" / "_"
+  ["[1][0]" signature]
+  ["[1][0]" key]
+  ["[1][0]" artifact]
+  ["[1][0]" registry]
+  ["[1][0]" module]
+  ["[1][0]" unit]])
+
+(def: (descriptor module hash)
+  (-> /descriptor.Module Nat /descriptor.Descriptor)
+  [/descriptor.#name module
+   /descriptor.#file (format module ".lux")
+   /descriptor.#hash hash
+   /descriptor.#state {.#Active}
+   /descriptor.#references (set.empty text.hash)])
+
+(def: test|entry
+  Test
+  (do random.monad
+    [module/0 (random.ascii/lower 1)
+     module/1 (random.ascii/lower 2)
+     signature $/signature.random
+     .let [version (value@ /signature.#version signature)]
+     fake_version (random.only (|>> (n.= version) not) random.nat)
+     content/0 random.nat
+     content/1 (random.only (|>> (n.= content/0) not) random.nat)
+     hash random.nat
+     .let [key (/key.key signature content/0)]]
+    ($_ _.and
+        (_.cover [/.has /.find]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        .let [entry [/.#module [/module.#id @module/0
+                                                /module.#descriptor (..descriptor module/0 hash)
+                                                /module.#document (/document.document key content/0)]
+                                     /.#output sequence.empty
+                                     /.#registry /registry.empty]]
+                        archive (/.has module/0 entry archive)
+                        entry' (/.find module/0 archive)]
+                       (in (same? entry entry')))
+                     (try.else false)))
+        (_.cover [/.module_is_only_reserved]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        entry' (/.find module/0 archive)]
+                       (in false))
+                     (exception.otherwise (exception.match? /.module_is_only_reserved))))
+        (_.cover [/.cannot_replace_document]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        .let [entry/0 [/.#module [/module.#id @module/0
+                                                  /module.#descriptor (..descriptor module/0 hash)
+                                                  /module.#document (/document.document key content/0)]
+                                       /.#output sequence.empty
+                                       /.#registry /registry.empty]
+                              entry/1 [/.#module [/module.#id @module/0
+                                                  /module.#descriptor (..descriptor module/0 hash)
+                                                  /module.#document (/document.document key content/1)]
+                                       /.#output sequence.empty
+                                       /.#registry /registry.empty]]
+                        archive (/.has module/0 entry/0 archive)
+                        archive (/.has module/0 entry/1 archive)]
+                       (in false))
+                     (exception.otherwise (exception.match? /.cannot_replace_document))))
+        (_.cover [/.module_must_be_reserved_before_it_can_be_added]
+                 (|> (do try.monad
+                       [.let [entry [/.#module [/module.#id 0
+                                                /module.#descriptor (..descriptor module/0 hash)
+                                                /module.#document (/document.document key content/0)]
+                                     /.#output sequence.empty
+                                     /.#registry /registry.empty]]
+                        archive (/.has module/0 entry /.empty)]
+                       (in false))
+                     (exception.otherwise (exception.match? /.module_must_be_reserved_before_it_can_be_added))))
+        (_.cover [/.archived?]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        .let [pre (/.archived? archive module/0)
+                              entry [/.#module [/module.#id @module/0
+                                                /module.#descriptor (..descriptor module/0 hash)
+                                                /module.#document (/document.document key content/0)]
+                                     /.#output sequence.empty
+                                     /.#registry /registry.empty]]
+                        archive (/.has module/0 entry archive)
+                        .let [post (/.archived? archive module/0)]]
+                       (in (and (not pre) post)))
+                     (try.else false)))
+        (_.cover [/.unknown_document]
+                 (and (|> (do try.monad
+                            [_ (/.id module/0 /.empty)]
+                            (in false))
+                          (exception.otherwise (exception.match? /.unknown_document)))
+                      (|> (do try.monad
+                            [_ (/.find module/0 /.empty)]
+                            (in false))
+                          (exception.otherwise (exception.match? /.unknown_document)))))
+        (_.cover [/.archived]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        .let [pre (/.archived archive)
+                              entry [/.#module [/module.#id @module/0
+                                                /module.#descriptor (..descriptor module/0 hash)
+                                                /module.#document (/document.document key content/0)]
+                                     /.#output sequence.empty
+                                     /.#registry /registry.empty]]
+                        archive (/.has module/0 entry archive)
+                        .let [post (/.archived archive)
+                              (^open "list#[0]") (list.equivalence text.equivalence)]]
+                       (in (and (list#= (list) pre)
+                                (list#= (list module/0) post))))
+                     (try.else false)))
+        (_.cover [/.entries]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        .let [pre (/.entries archive)
+                              entry [/.#module [/module.#id @module/0
+                                                /module.#descriptor (..descriptor module/0 hash)
+                                                /module.#document (/document.document key content/0)]
+                                     /.#output sequence.empty
+                                     /.#registry /registry.empty]]
+                        archive (/.has module/0 entry archive)]
+                       (in (and (list.empty? pre)
+                                (case (/.entries archive)
+                                  (^ (list [module/0' @module/0' entry']))
+                                  (and (same? module/0 module/0')
+                                       (same? @module/0 @module/0')
+                                       (same? entry entry'))
+
+                                  _
+                                  false))))
+                     (try.else false)))
+        (_.cover [/.export /.import]
+                 (|> (do try.monad
+                       [[@module/0 archive] (/.reserve module/0 /.empty)
+                        [@module/1 archive] (/.reserve module/1 archive)
+                        .let [entry/0 [/.#module [/module.#id @module/0
+                                                  /module.#descriptor (..descriptor module/0 hash)
+                                                  /module.#document (/document.document key content/0)]
+                                       /.#output sequence.empty
+                                       /.#registry /registry.empty]
+                              entry/1 [/.#module [/module.#id @module/1
+                                                  /module.#descriptor (..descriptor module/1 hash)
+                                                  /module.#document (/document.document key content/1)]
+                                       /.#output sequence.empty
+                                       /.#registry /registry.empty]]
+                        archive (/.has module/0 entry/0 archive)
+                        archive (/.has module/1 entry/1 archive)
+                        .let [pre (/.reserved archive)]
+                        archive (|> archive
+                                    (/.export version)
+                                    (/.import version))
+                        .let [post (/.reserved archive)]]
+                       (in (set#= (set.of_list text.hash pre)
+                                  (set.of_list text.hash post))))
+                     (try.else false)))
+        (_.cover [/.version_mismatch]
+                 (|> (do try.monad
+                       [archive (|> /.empty
+                                    (/.export version)
+                                    (/.import fake_version))]
+                       (in false))
+                     (exception.otherwise (exception.match? /.version_mismatch))))
+        )))
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Archive])
+      (do random.monad
+        [module/0 (random.ascii/lower 1)
+         module/1 (random.ascii/lower 2)
+         signature $/signature.random
+         content/0 random.nat
+         content/1 (random.only (|>> (n.= content/0) not) random.nat)
+         hash random.nat
+         .let [key (/key.key signature content/0)]])
+      ($_ _.and
+          (_.cover [/.empty]
+                   (list.empty? (/.entries /.empty)))
+          (_.cover [/.reserve /.id]
+                   (|> (do try.monad
+                         [[@module/0 archive] (/.reserve module/0 /.empty)
+                          [@module/1 archive] (/.reserve module/1 archive)
+                          @module/0' (/.id module/0 archive)
+                          @module/1' (/.id module/1 archive)]
+                         (in (and (same? @module/0 @module/0')
+                                  (same? @module/1 @module/1'))))
+                       (try.else false)))
+          (_.cover [/.reserved]
+                   (|> (do try.monad
+                         [[@module/0 archive] (/.reserve module/0 /.empty)
+                          [@module/1 archive] (/.reserve module/1 archive)]
+                         (in (set#= (set.of_list text.hash (list module/0 module/1))
+                                    (set.of_list text.hash (/.reserved archive)))))
+                       (try.else false)))
+          (_.cover [/.reservations]
+                   (|> (do try.monad
+                         [[@module/0 archive] (/.reserve module/0 /.empty)
+                          [@module/1 archive] (/.reserve module/1 archive)
+                          .let [hash (product.hash text.hash n.hash)]]
+                         (in (set#= (set.of_list hash (list [module/0 @module/0] [module/1 @module/1]))
+                                    (set.of_list hash (/.reservations archive)))))
+                       (try.else false)))
+          (_.cover [/.module_has_already_been_reserved]
+                   (|> (do try.monad
+                         [[@module/0 archive] (/.reserve module/0 /.empty)
+                          _ (/.reserve module/0 archive)]
+                         (in false))
+                       (exception.otherwise (exception.match? /.module_has_already_been_reserved))))
+          (_.cover [/.reserved?]
+                   (|> (do try.monad
+                         [[@module/0 archive] (/.reserve module/0 /.empty)]
+                         (in (and (/.reserved? archive module/0)
+                                  (not (/.reserved? archive module/1)))))
+                       (try.else false)))
+          (_.for [/.Entry]
+                 ..test|entry)
+
+          $/signature.test
+          $/key.test
+          $/artifact.test
+          $/registry.test
+          $/module.test
+          $/unit.test
+          )))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux
index 3d0bc262e..311f1f80d 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux
@@ -9,7 +9,10 @@
     [number
      ["n" nat]]]]]
  [\\library
-  ["[0]" /]])
+  ["[0]" /]]
+ ["[0]" / "_"
+  ["[1][0]" document]
+  ["[1][0]" descriptor]])
 
 (def: .public test
   Test
@@ -18,4 +21,7 @@
       ($_ _.and
           (_.cover [/.ID /.runtime]
                    (n.= 0 /.runtime))
+
+          /document.test
+          /descriptor.test
           )))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux
index d9d0e09a2..95a290b11 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux
@@ -11,7 +11,7 @@
     [parser
      ["<[0]>" binary]]]
    [data
-    ["[0]" text]
+    ["[0]" text ("[1]#[0]" equivalence)]
     [format
      ["[0]" binary]]]
    [math
@@ -40,13 +40,16 @@
 (def: .public test
   Test
   (<| (_.covering /._)
-      (_.for [/.Descriptor /.Module])
+      (_.for [/.Descriptor])
       (do random.monad
         [expected (..random 5)])
       ($_ _.and
           (_.for [/.equivalence]
                  ($equivalence.spec /.equivalence (..random 1)))
 
+          (_.for [/.Module]
+                 (_.cover [/.runtime]
+                          (text#= "" /.runtime)))
           (_.cover [/.writer /.parser]
                    (|> expected
                        (binary.result /.writer)
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux
index 749dcdd09..a73bf751d 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux
@@ -19,10 +19,10 @@
      ["[0]" nat]]]]]
  [\\library
   ["[0]" /
-   [//
+   [///
     ["[1][0]" signature ("[1]#[0]" equivalence)]
     ["[1][0]" key]]]]
- ["[0]" // "_"
+ ["[0]" /// "_"
   ["[1][0]" signature]])
 
 (def: .public test
@@ -30,9 +30,9 @@
   (<| (_.covering /._)
       (_.for [/.Document])
       (do random.monad
-        [signature/0 //signature.random
+        [signature/0 ///signature.random
          signature/1 (random.only (|>> (/signature#= signature/0) not)
-                                  //signature.random)
+                                  ///signature.random)
          .let [key/0 (/key.key signature/0 0)
                key/1 (/key.key signature/1 0)]
          expected random.nat]
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux
index 948329ada..85c19714c 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux
@@ -26,8 +26,8 @@
   (Random /.Signature)
   ($_ random.and
       ($_ random.and
-          (random.ascii/upper 5)
-          (random.ascii/lower 5))
+          (random.ascii/upper 1)
+          (random.ascii/lower 1))
       ////version.random
       ))