Adapting to new List type (part 4).

stdlib/source/library/lux/compiler/language/lux/analysis/coverage.lux

@@ -59,6 +59,7 @@
               {#Decimal (Set Decimal)}
               {#Text (Set Text)}
               {#Variant (Variant' @)}
+              {#List (List @)}
               {#Seq @ @}
               {#Alt @ @})))
 
@@ -112,6 +113,9 @@
            [{#Variant allR casesR} {#Variant allS casesS}]
            (and (by (maybe.equivalence n.equivalence) = allR allS)
                 (by (dictionary.equivalence =) = casesR casesS))
+
+           [{#List reference} {#List it}]
+           (by (list.equivalence =) = reference it)
 
            [{#Seq leftR rightR} {#Seq leftS rightS}]
            (and (= leftR leftS)
@@ -160,6 +164,13 @@
             (text (maybe.else "?" (maybe#each %.natural ?max_cases)) " ")
             (text.enclosed ["{" "}"]))
 
+        {#List it}
+        (|> it
+            (list.mix (function (_ after it)
+                        (text it " " (as_text after)))
+                      "")
+            (text.enclosed ["(list" ")"]))
+
         {#Seq left right}
         (text "(& " (as_text left) " " (as_text right) ")")
 
@@ -224,26 +235,10 @@
                               (in {#Seq leftC rightC}))))
                         lastC prevsP+)))
 
-        {//pattern.#List membersP+}
-        (when (list.as_stack (list.reversed membersP+))
-          {.#Empty}
-          {try.#Success {#Exhaustive}}
-
-          {.#Top lastP prevsP+}
-          (do [! try.monad]
-            [lastC (coverage lastP)]
-            (stack.mix' !
-                        (function (_ leftP rightC)
-                          (do !
-                            [leftC (coverage leftP)]
-                            (when rightC
-                              {#Exhaustive}
-                              (in leftC)
-
-                              _
-                              (in {#Seq leftC rightC}))))
-                        lastC
-                        prevsP+)))
+        {//pattern.#List it}
+        (|> it
+            (list.each' try.monad coverage)
+            (by try.monad each (|>> {#List})))
 
         ... Variant patterns can be shown to be exhaustive if all the possible
         ... cases are handled exhaustively.
@@ -260,9 +255,9 @@
                             (dictionary.has idx value_coverage))})))))
 
 (the (xor left right)
-  (-> Bit Bit Bit)
-  (or (and left (not right))
-      (and (not left) right)))
+  (-> Bit Bit
+      Bit)
+  (not (bit.= left right)))
 
 ... The coverage checker not only verifies that pattern-matching is
 ... exhaustive, but also that there are no redundant patterns.
@@ -296,7 +291,8 @@
 ... pattern-matching expression is exhaustive and whether it contains
 ... redundant patterns.
 (the .public (composite addition so_far)
-  (-> Coverage Coverage (Try Coverage))
+  (-> Coverage Coverage
+      (Try Coverage))
   (expansion.let [<redundancy> (exception.except ..redundancy [so_far addition])
                   <alternatively> {try.#Success {#Alt addition so_far}}
                   <else> (if (= so_far addition)
@@ -359,6 +355,15 @@
                       {#Exhaustive}
                       {#Variant (maybe#composite allA allSF) casesM})))))
 
+          [{#List addition'} {#List so_far'}]
+          (if (n.= (list.size addition')
+                   (list.size so_far'))
+            (|> (list.zipped_2 addition' so_far')
+                (list.each' try.monad (function (_ [addition' so_far'])
+                                        (composite addition' so_far')))
+                (by try.monad each (|>> {#List})))
+            <else>)
+
           [{#Seq leftA rightA} {#Seq leftSF rightSF}]
           (when [(= leftSF leftA) (= rightSF rightA)]
             ... Same prefix

stdlib/source/library/lux/compiler/language/lux/analysis/inference.lux

@@ -150,7 +150,7 @@
       (do phase.monad
         [[just_before variables outputT' args'A] (general' variables archive analyse outputT args')
          [here _] module.current
-         argA (<| (/.with_exception ..cannot_infer_argument [here inputT (list.of_stack argC)])
+         argA (<| (/.with_exception ..cannot_infer_argument [here inputT argC])
                   (/type.expecting inputT)
                   (analyse archive argC))]
         (in [just_before variables outputT' (stack.partial argA args'A)]))

stdlib/source/library/lux/compiler/language/lux/phase/analysis/when.lux

@@ -50,41 +50,41 @@
 (exception.the .public (mismatch [module type pattern])
   (Exception [Text Type Code])
   (exception.report
-   (list ["Type" (type.as_text type)]
-         ["Pattern" (code.relative module pattern)])))
+   (.list ["Type" (type.as_text type)]
+          ["Pattern" (code.relative module pattern)])))
 
 (exception.the .public (sum_has_no_case [case type])
   (Exception [Natural Type])
   (exception.report
-   (list ["Case" (%.natural case)]
-         ["Type" (type.as_text type)])))
+   (.list ["Case" (%.natural case)]
+          ["Type" (type.as_text type)])))
 
 (exception.the .public (invalid [module it])
   (Exception [Text Code])
   (exception.report
-   (list ["Pattern" (code.relative module it)])))
+   (.list ["Pattern" (code.relative module it)])))
 
 (exception.the .public (non_tuple type)
   (Exception Type)
   (exception.report
-   (list ["Type" (type.as_text type)])))
+   (.list ["Type" (type.as_text type)])))
 
 (exception.the .public (not_a_list type)
   (Exception Type)
   (exception.report
-   (list ["Type" (type.as_text type)])))
+   (.list ["Type" (type.as_text type)])))
 
 (exception.the .public (non_exhaustive [module input branches coverage])
   (Exception [Text Code (Stack [Code Code]) Coverage])
   (exception.report
-   (list ["Input" (code.relative module input)]
-         ["Branches" (|> branches
-                         (stack#each (function (_ [slot value])
-                                       (stack slot value)))
-                         stack#conjoint
-                         code.tuple
-                         (code.relative module))]
-         ["Coverage" (/coverage.as_text coverage)])))
+   (.list ["Input" (code.relative module input)]
+          ["Branches" (|> branches
+                          (stack#each (function (_ [slot value])
+                                        (stack slot value)))
+                          stack#conjoint
+                          code.tuple
+                          (code.relative module))]
+          ["Coverage" (/coverage.as_text coverage)])))
 
 (exception.the .public empty_branches)
 
@@ -298,7 +298,7 @@
                                                (do !
                                                  [[head [tail thenA]] ((as (for_any (_ a) (-> Type Code (Operation a) (Operation [Pattern a])))
                                                                            pattern_analysis)
-                                                                       type_of_input item then)]
+                                                                       type_of_item item then)]
                                                  (in [(stack.partial head tail) thenA]))))
                                          (do !
                                            [nextA next]

stdlib/source/library/lux/compiler/language/lux/phase/extension/analysis/lux.lux

@@ -83,8 +83,8 @@
 (exception.the .public (incorrect_arity [expected actual])
   (Exception [Natural Natural])
   (exception.report
-   (stack ["Expected" (%.natural expected)]
-          ["Actual" (%.natural actual)])))
+   (list ["Expected" (%.natural expected)]
+         ["Actual" (%.natural actual)])))
 
 (the (simple inputsT+ outputT extension_name)
   (-> (Stack Type) Type (-> extension.Name Handler))
@@ -141,7 +141,7 @@
  (exception.the .public (character_text_must_be_size_1 text)
    (Exception Text)
    (exception.report
-    (stack ["Text" (%.text text)])))
+    (list ["Text" (%.text text)])))
 
  (the text_char
    (Projection Character)
@@ -263,8 +263,8 @@
 (exception.the .public (cannot_access_global [from global])
   (Exception [Text Name])
   (exception.report
-   (stack ["From" (%.text from)]
-          ["Global" (name.as_text global)])))
+   (list ["From" (%.text from)]
+         ["Global" (name.as_text global)])))
 
 (the (expected_module current quoted)
   (-> Text Text
@@ -323,7 +323,7 @@
 (exception.the .public (unknown_local name)
   (Exception Text)
   (exception.report
-   (stack ["Name" (%.text name)])))
+   (list ["Name" (%.text name)])))
 
 (the .public local
   (-> extension.Name Handler)
@@ -468,18 +468,23 @@
   (..custom
    [(?.some ?code.any)
     (.function (_ extension_name analysis archive elements)
-      (<| typeA.with_var
-          (.function (_ [_ of]))
-          (do [! phase.monad]
-            [_ (typeA.inference (type (List of)))
-             elements (stack.each' ! (|>> (analysis archive)
-                                          (typeA.expecting of))
-                                   elements)
-             @ meta.provenance]
-            (in (|> elements
-                    list.of_stack
-                    {analysis.#Extension (..translation extension_name)}
-                    [@])))))]))
+      (if (stack.empty? elements)
+        (do [! phase.monad]
+          [_ (typeA.inference List)
+           @ meta.provenance]
+          (in [@ {analysis.#Extension (..translation extension_name) (list)}]))
+        (<| typeA.with_var
+            (.function (_ [_ of]))
+            (do [! phase.monad]
+              [_ (typeA.inference (type (List of)))
+               elements (stack.each' ! (|>> (analysis archive)
+                                            (typeA.expecting of))
+                                     elements)
+               @ meta.provenance]
+              (in (|> elements
+                      list.of_stack
+                      {analysis.#Extension (..translation extension_name)}
+                      [@]))))))]))
 
 (the with_list_extensions
   (-> Bundle

stdlib/source/library/lux/compiler/language/lux/phase/synthesis/function.lux

@@ -40,8 +40,8 @@
 (exception.the .public (cannot_find_foreign_variable_in_environment [foreign environment])
   (Exception [Register (Environment /.Term)])
   (exception.report
-   (stack ["Foreign" (%.natural foreign)]
-          ["Environment" (exception.listing /.as_text environment)])))
+   (list ["Foreign" (%.natural foreign)]
+         ["Environment" (exception.listing /.as_text environment)])))
 
 (the .public self_reference
   (template.macro (self_reference @)

stdlib/source/library/lux/compiler/language/lux/phase/synthesis/variable.lux

@@ -221,7 +221,7 @@
   [(exception.the .public (<name> register)
      (Exception Register)
      (exception.report
-      (stack ["Register" (%.natural register)])))]
+      (list ["Register" (%.natural register)])))]
 
   [redundant_declaration]
   [unknown_register]

stdlib/source/library/lux/compiler/language/lux/phase/translation/extension.lux

@@ -39,8 +39,8 @@
 (exception.the .public (incorrect_arity [expected actual])
   (Exception [Natural Natural])
   (exception.report
-   (stack ["Expected" (%.natural expected)]
-          ["Actual" (%.natural actual)])))
+   (list ["Expected" (%.natural expected)]
+         ["Actual" (%.natural actual)])))
 
 (the arity
   (syntax.macro (_ [arity <code>.natural])

stdlib/source/library/lux/compiler/meta/cache/module.lux

@@ -17,7 +17,7 @@
     ["[0]" text (.only)
      ["%" \\injection]]
     [collection
-     ["[0]" stack (.use "[1]#[0]" functor)]
+     ["[0]" list (.use "[1]#[0]" functor)]
      ["[0]" dictionary (.only Dictionary)]]]
    [macro
     ["[0]" expansion]]
@@ -104,13 +104,13 @@
     (-> (Monad !) (file.System !) module.ID
         (! (Try (Dictionary Text Binary)))))
   (do [! (try.with !)]
-    [files (by fs directory_files (..path fs @module))
-     pairs (|> files
-               (stack#each (function (_ file)
-                             [(file.name fs file) file]))
-               (stack.only (|>> product.left (text.= ..file) not))
-               (stack.each' ! (function (_ [name path])
-                                (|> path
-                                    (by fs read)
-                                    (by ! each (|>> [name]))))))]
-    (in (dictionary.of_stack text.hash pairs))))
+    [files (by fs directory_files (..path fs @module))]
+    (|> files
+        (list#each (function (_ file)
+                     [(file.name fs file) file]))
+        (list.only (|>> product.left (text.= ..file) not))
+        (list.each' ! (function (_ [name path])
+                        (|> path
+                            (by fs read)
+                            (by ! each (|>> [name])))))
+        (by ! each (dictionary.of_list text.hash)))))

stdlib/source/library/lux/compiler/meta/cache/purge.lux

@@ -15,6 +15,7 @@
    [data
     ["[0]" text (.only)]
     [collection
+     ["[0]" list (.use "[1]#[0]" mix functor)]
      ["[0]" stack (.use "[1]#[0]" mix functor)]
      ["[0]" dictionary (.only Dictionary)]
      ["[0]" set]]]
@@ -48,7 +49,7 @@
     [.let [cache (//module.path fs @module)]
      _ (|> cache
            (by fs directory_files)
-           (by ! each (stack.each' ! (by fs delete)))
+           (by ! each (list.each' ! (by fs delete)))
            (by ! conjoint))]
     (by fs delete cache)))
 

stdlib/source/library/lux/compiler/meta/io/context.lux

@@ -23,7 +23,8 @@
       ["[0]" utf8]]]
     [collection
      ["[0]" dictionary (.only Dictionary)]
-     ["[0]" stack]]]
+     ["[0]" stack]
+     ["[0]" list]]]
    ["[0]" type]
    [world
     ["[0]" file]]]]
@@ -151,21 +152,22 @@
   (Dictionary file.Path Binary))
 
 (the (context_listing fs context directory enumeration)
-  (-> (file.System Future) Context file.Path Enumeration (Future (Try Enumeration)))
+  (-> (file.System Future) Context file.Path Enumeration
+      (Future (Try Enumeration)))
   (do [! (try.with future.monad)]
     [enumeration (|> directory
                      (by fs directory_files)
-                     (by ! each (stack.mix' ! (function (_ file enumeration)
-                                                (if (text.ends_with? ..lux_extension file)
-                                                  (do !
-                                                    [source_code (by fs read file)]
-                                                    (future#in (dictionary.has' (text.replaced_once context "" file) source_code enumeration)))
-                                                  (in enumeration)))
-                                            enumeration))
+                     (by ! each (list.mix' ! (function (_ file enumeration)
+                                               (if (text.ends_with? ..lux_extension file)
+                                                 (do !
+                                                   [source_code (by fs read file)]
+                                                   (future#in (dictionary.has' (text.replaced_once context "" file) source_code enumeration)))
+                                                 (in enumeration)))
+                                           enumeration))
                      (by ! conjoint))]
     (|> directory
         (by fs sub_directories)
-        (by ! each (stack.mix' ! (context_listing fs context) enumeration))
+        (by ! each (list.mix' ! (context_listing fs context) enumeration))
         (by ! conjoint))))
 
 (the Action
@@ -178,7 +180,7 @@
   (do (try.with future.monad)
     [subs (by fs sub_directories context)]
     (in (|> subs
-            stack.head
+            (list.item 0)
             (try.else context)
             (file.parent fs)
             (maybe.else context)))))