Fixed a bug that broke re-compilation of STDLIB tests in Lua.

8 files changed, 183 insertions, 109 deletions

diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index d65fa7bcb..3fafb38f5 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -825,19 +825,6 @@
            (failure "Wrong syntax for $'")}
           tokens))
 
-... (def:'' .private (list#each f xs)
-...         {#UnivQ {#End}
-...                 {#UnivQ {#End}
-...                         {#Function {#Function {#Parameter 3} {#Parameter 1}}
-...                                    {#Function ($' List {#Parameter 3})
-...                                               ($' List {#Parameter 1})}}}}
-...         ({{#End}
-...           {#End}
-
-...           {#Item x xs'}
-...           {#Item (f x) (list#each f xs')}}
-...          xs))
-
 (def:'' .private (list#mix f init xs)
         ... (All (_ a b) (-> (-> b a a) a (List b) a))
         {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1}
@@ -1320,12 +1307,9 @@
 
 (def:''' .private (list#composite xs ys)
          (All (_ a) (-> ($' List a) ($' List a) ($' List a)))
-         ({{#Item x xs'}
-           {#Item x (list#composite xs' ys)}
-
-           {#End}
-           ys}
-          xs))
+         (list#mix (function' [head tail] {#Item head tail})
+                   ys
+                   (list#reversed xs)))
 
 (def:''' .private (right_associativity op a1 a2)
          (-> Code Code Code Code)
@@ -3993,7 +3977,7 @@
 (def: (referral_definitions module_name [r_defs r_opens])
   (-> Text Refer (Meta (List Code)))
   (do meta_monad
-    [current_module current_module_name
+    [current_module ..current_module_name
      .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any)))
                              (function (_ module_name all_defs referred_defs)
                                (monad#each meta_monad
@@ -4804,7 +4788,7 @@
 
 (macro: .public (using _imports)
   (do meta_monad
-    [current_module current_module_name
+    [current_module ..current_module_name
      imports (imports_parser #0 current_module {#End} _imports)
      .let [=imports (|> imports
                         (list#each (: (-> Importation Code)
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index a32be80ad..d16ca46b9 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -550,10 +550,10 @@
      ..current_module))
 
 (template [<name> <tag> <description>]
-  [(def: .public (<name> tag_name)
+  [(def: .public (<name> label_name)
      (-> Symbol (Meta [Nat (List Symbol) Type]))
      (do ..monad
-       [.let [[module name] tag_name]
+       [.let [[module name] label_name]
         =module (..module module)
         this_module_name ..current_module_name]
        (case (plist.value name (value@ .#definitions =module))
@@ -561,11 +561,11 @@
          (if (or (text#= this_module_name module)
                  exported?)
            (in [idx (list#each (|>> [module]) group) type])
-           (..failure ($_ text#composite "Cannot access " <description>  ": " (symbol#encoded tag_name) " from module " this_module_name)))
+           (..failure ($_ text#composite "Cannot access " <description>  ": " (symbol#encoded label_name) " from module " this_module_name)))
 
          _
          (..failure ($_ text#composite
-                        "Unknown " <description>  ": " (symbol#encoded tag_name))))))]
+                        "Unknown " <description>  ": " (symbol#encoded label_name))))))]
 
   [tag .#Tag "tag"]
   [slot .#Slot "slot"]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
index 110b76a3d..23123a8c5 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux
@@ -17,7 +17,7 @@
    ["[1][0]" analysis
     ["[1]/[0]" type]]
    ["/[1]" // "_"
-    ["/" directive {"+" Phase}]
+    ["/" directive {"+" Operation Phase}]
     ["[1][0]" analysis
      ["[0]" evaluation]
      ["[1]/[0]" macro {"+" Expander}]]
@@ -54,6 +54,26 @@
       {try.#Failure error}
       {try.#Failure error})))
 
+(def: (requiring phase archive expansion)
+  (All (_ anchor expression directive)
+    (-> (Phase anchor expression directive) Archive (List Code)
+        (Operation anchor expression directive /.Requirements)))
+  (function (_ state)
+    (loop [state state
+           input expansion
+           output /.no_requirements]
+      (case input
+        {.#End}
+        {try.#Success [state output]}
+        
+        {.#Item head tail}
+        (case (phase archive head state)
+          {try.#Success [state' head']}
+          (again state' tail (/.merge_requirements head' output))
+          
+          {try.#Failure error}
+          {try.#Failure error})))))
+
 (with_expansions [<lux_def_module> (as_is [|form_location| {.#Form (list& [|text_location| {.#Text "lux def module"}] annotations)}])]
   (def: .public (phase wrapper expander)
     (-> //.Wrapper Expander Phase)
@@ -99,9 +119,7 @@
                     (# ! each (revised@ /.#referrals (list#composite referrals))))
 
                 _
-                (|> expansion
-                    (monad.each ! (again archive))
-                    (# ! each (list#mix /.merge_requirements /.no_requirements)))))
+                (..requiring again archive expansion)))
 
             _
             (//.except ..not_a_directive code)))))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
index b9b2ec192..1171852cb 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
@@ -1,24 +1,24 @@
 (.using
-  [library
-   [lux {"-" Module}
-    [abstract
-     [monad {"+" do}]]
-    [control
-     ["[0]" try {"+" Try}]
-     ["[0]" exception {"+" exception:}]
-     ["<>" parser
-      [binary {"+" Parser}]]]
-    [data
-     [collection
-      ["[0]" dictionary {"+" Dictionary}]]
-     [format
-      ["[0]" binary {"+" Writer}]]]
-    [type {"+" :sharing}
-     abstract]]]
-  [//
-   ["[0]" signature {"+" Signature}]
-   ["[0]" key {"+" Key}]
-   [descriptor {"+" Module}]])
+ [library
+  [lux {"-" Module}
+   [abstract
+    [monad {"+" do}]]
+   [control
+    ["[0]" try {"+" Try}]
+    ["[0]" exception {"+" exception:}]
+    ["<>" parser
+     [binary {"+" Parser}]]]
+   [data
+    [collection
+     ["[0]" dictionary {"+" Dictionary}]]
+    [format
+     ["[0]" binary {"+" Writer}]]]
+   [type {"+" :sharing}
+    abstract]]]
+ [//
+  ["[0]" signature {"+" Signature}]
+  ["[0]" key {"+" Key}]
+  [descriptor {"+" Module}]])
 
 (exception: .public (invalid_signature [expected Signature
                                         actual Signature])
@@ -63,8 +63,9 @@
 
   (def: .public (writer content)
     (All (_ d) (-> (Writer d) (Writer (Document d))))
-    (let [writer (binary.and signature.writer
-                             content)]
+    (let [writer ($_ binary.and
+                     signature.writer
+                     content)]
       (|>> :representation writer)))
 
   (def: .public parser
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
index 7c3be5e1b..a124fae6a 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux
@@ -1,16 +1,16 @@
 (.using
-  [library
-   [lux "*"
-    [type
-     abstract]]]
-  [//
-   [signature {"+" Signature}]])
+ [library
+  [lux "*"
+   [type
+    abstract]]]
+ [//
+  [signature {"+" Signature}]])
 
 (abstract: .public (Key k)
   Signature
 
   (def: .public signature
-    (-> (Key Any) Signature)
+    (All (_ ?) (-> (Key ?) Signature))
     (|>> :representation))
 
   (def: .public (key signature sample)
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index f950abaa0..914e02d92 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -1,38 +1,38 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    ["[0]" type ("[1]#[0]" equivalence)]
-    [abstract
-     [equivalence {"+" Equivalence}]
-     [monad {"+" do}]
-     [\\specification
-      ["$[0]" functor {"+" Injection Comparison}]
-      ["$[0]" apply]
-      ["$[0]" monad]]]
-    [control
-     ["[0]" maybe]
-     ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
-    [data
-     ["[0]" product]
-     ["[0]" bit ("[1]#[0]" equivalence)]
-     ["[0]" text ("[1]#[0]" equivalence)
-      ["%" format {"+" format}]]
-     [collection
-      ["[0]" list ("[1]#[0]" functor monoid)]
-      ["[0]" set]]]
-    [meta
-     ["[0]" location]
-     ["[0]" symbol ("[1]#[0]" equivalence)]]
-    [math
-     ["[0]" random {"+" Random}]
-     [number
-      ["n" nat]]]]]
-  [\\library
-   ["[0]" /]]
-  ["[0]" / "_"
-   ["[1][0]" location]
-   ["[1][0]" symbol]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   ["[0]" type ("[1]#[0]" equivalence)]
+   [abstract
+    [equivalence {"+" Equivalence}]
+    [monad {"+" do}]
+    [\\specification
+     ["$[0]" functor {"+" Injection Comparison}]
+     ["$[0]" apply]
+     ["$[0]" monad]]]
+   [control
+    ["[0]" maybe]
+    ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
+   [data
+    ["[0]" product]
+    ["[0]" bit ("[1]#[0]" equivalence)]
+    ["[0]" text ("[1]#[0]" equivalence)
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" list ("[1]#[0]" functor monoid)]
+     ["[0]" set]]]
+   [meta
+    ["[0]" location]
+    ["[0]" symbol ("[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]]]
+ [\\library
+  ["[0]" /]]
+ ["[0]" / "_"
+  ["[1][0]" location]
+  ["[1][0]" symbol]])
 
 (template: (!expect <pattern> <value>)
   [(case <value>
@@ -159,6 +159,16 @@
                           (!expect (^multi {try.#Success actual}
                                            (n.= expected actual))))
                       ))
+        (_.cover [/.try]
+                 (and (|> (/.try (/.failure expected_error))
+                          (/.result expected_lux)
+                          (!expect (^multi {try.#Success {try.#Failure actual_error}}
+                                           (text#= (location.with location.dummy expected_error)
+                                                   actual_error))))
+                      (|> (/.try (# /.monad in expected))
+                          (/.result expected_lux)
+                          (!expect (^multi {try.#Success {try.#Success actual}}
+                                           (same? expected actual))))))
         )))
 
 (def: module_related
@@ -310,6 +320,11 @@
                          .#eval            (:as (-> Type Code (Meta Any)) [])
                          .#host            []]]]
     ($_ _.and
+        (_.cover [/.target]
+                 (|> /.target
+                     (/.result expected_lux)
+                     (try#each (same? target))
+                     (try.else false)))
         (_.cover [/.seed]
                  (|> (do /.monad
                        [pre /.seed
@@ -623,18 +638,18 @@
                         alias!)))
         )))
 
-(def: tags_related
+(def: label_related
   Test
   (do [! random.monad]
     [current_module (random.ascii/upper 1)
-     tag_module (random.only (|>> (text#= current_module) not)
-                             (random.ascii/upper 1))
+     label_module (random.only (|>> (text#= current_module) not)
+                               (random.ascii/upper 1))
 
      name_0 (random.ascii/upper 1)
      name_1 (random.only (|>> (text#= name_0) not)
                          (random.ascii/upper 1))
      
-     .let [random_tag (# ! each (|>> [tag_module])
+     .let [random_tag (# ! each (|>> [label_module])
                          (random.ascii/upper 1))
            random_labels (: (Random [Text (List Text)])
                             (do !
@@ -665,18 +680,18 @@
                                         [.#module_hash        0
                                          .#module_aliases     (list)
                                          .#definitions        (list)
-                                         .#imports            (list tag_module)
+                                         .#imports            (list label_module)
                                          .#module_state       {.#Active}]]
-                                       [tag_module
+                                       [label_module
                                         [.#module_hash        0
                                          .#module_aliases     (list)
-                                         .#definitions        (list& [name_0 {.#Type [false type_0 {.#Left tags_0}]}]
+                                         .#definitions        (list& [name_0 {.#Type [true type_0 {.#Left tags_0}]}]
                                                                      [name_1 {.#Type [true type_1 {.#Right tags_1}]}]
                                                                      ($_ list#composite
                                                                          (|> {.#Item tags_0}
                                                                              list.enumeration
                                                                              (list#each (function (_ [index short])
-                                                                                          [short {.#Tag [false type_0 {.#Item tags_0} index]}])))
+                                                                                          [short {.#Tag [true type_0 {.#Item tags_0} index]}])))
                                                                          (|> {.#Item tags_1}
                                                                              list.enumeration
                                                                              (list#each (function (_ [index short])
@@ -699,21 +714,47 @@
                                     (product.equivalence
                                      (list.equivalence symbol.equivalence)
                                      type.equivalence))]
-                   (|> (/.tag_lists tag_module)
+                   (|> (/.tag_lists label_module)
                        (/.result expected_lux)
-                       (try#each (# equivalence = (list [(list#each (|>> [tag_module]) {.#Item tags_1})
+                       (try#each (# equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0})
+                                                         type_0]
+                                                        [(list#each (|>> [label_module]) {.#Item tags_1})
                                                          type_1])))
                        (try.else false))))
         (_.cover [/.tags_of]
-                 (|> (/.tags_of [tag_module name_1])
+                 (|> (/.tags_of [label_module name_1])
                      (/.result expected_lux)
-                     (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})}))
+                     (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})}))
                      (try.else false)))
+        (_.cover [/.tag]
+                 (|> {.#Item tags_0}
+                     list.enumeration
+                     (list.every? (function (_ [expected_index label])
+                                    (|> [label_module label]
+                                        /.tag
+                                        (/.result expected_lux)
+                                        (!expect (^multi {try.#Success [actual_index actual_tags actual_type]}
+                                                         (let [correct_index!
+                                                               (n.= expected_index
+                                                                    actual_index)
+
+                                                               correct_tags!
+                                                               (# (list.equivalence symbol.equivalence) =
+                                                                  (list#each (|>> [label_module]) {.#Item tags_0})
+                                                                  actual_tags)
+
+                                                               correct_type!
+                                                               (type#= type_0
+                                                                       actual_type)]
+                                                           (and correct_index!
+                                                                correct_tags!
+                                                                correct_type!))))
+                                        )))))
         (_.cover [/.slot]
                  (|> {.#Item tags_1}
                      list.enumeration
-                     (list.every? (function (_ [expected_index tag])
-                                    (|> [tag_module tag]
+                     (list.every? (function (_ [expected_index label])
+                                    (|> [label_module label]
                                         /.slot
                                         (/.result expected_lux)
                                         (!expect (^multi {try.#Success [actual_index actual_tags actual_type]}
@@ -723,7 +764,7 @@
 
                                                                correct_tags!
                                                                (# (list.equivalence symbol.equivalence) =
-                                                                  (list#each (|>> [tag_module]) {.#Item tags_1})
+                                                                  (list#each (|>> [label_module]) {.#Item tags_1})
                                                                   actual_tags)
 
                                                                correct_type!
@@ -943,8 +984,9 @@
                 ..context_related
                 ..definition_related
                 ..search_related
-                ..tags_related
                 ..locals_related
+                (_.for [.Label]
+                       ..label_related)
                 ))
           
           /location.test
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 761192245..c60d3ba2d 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -20,7 +20,8 @@
      ]]
    ["[1][0]" meta "_"
     ["[1]/[0]" archive "_"
-     ["[1]/[0]" signature]]]
+     ["[1]/[0]" signature]
+     ["[1]/[0]" key]]]
    ]])
 
 (def: .public test
@@ -33,6 +34,7 @@
       /analysis/composite.test
       /analysis/pattern.test
       /meta/archive/signature.test
+      /meta/archive/key.test
       ... /syntax.test
       ... /analysis.test
       ... /synthesis.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux
new file mode 100644
index 000000000..45d29931d
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux
@@ -0,0 +1,27 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [math
+    ["[0]" random]]]]
+ [\\library
+  ["[0]" /]]
+ ["[0]" // "_"
+  ["[1][0]" signature]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Key])
+      (do random.monad
+        [expected //signature.random
+         document random.nat]
+        ($_ _.and
+            (_.cover [/.key /.signature]
+                     (|> document
+                         (/.key expected)
+                         /.signature
+                         (same? expected)))
+            ))))