Some bug fixes.

10 files changed, 93 insertions, 74 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
index 06a2d5ca8..d810d7aca 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux
@@ -82,7 +82,7 @@
 
   (def: next
     (-> Archive ID)
-    (|>> :representation (get@ #next)))
+    (|>> :representation (value@ #next)))
 
   (def: .public empty
     Archive
@@ -111,8 +111,8 @@
         (#try.Success [next
                        (|> archive
                            :representation
-                           (update@ #..resolver (dictionary.has module [next #.None]))
-                           (update@ #..next inc)
+                           (revised@ #..resolver (dictionary.has module [next #.None]))
+                           (revised@ #..next ++)
                            :abstraction)]))))
 
   (def: .public (has module [descriptor document output] archive)
@@ -122,7 +122,7 @@
         (#.Some [id #.None])
         (#try.Success (|> archive
                           :representation
-                          (update@ #..resolver (dictionary.has module [id (#.Some [descriptor document output])]))
+                          (revised@ #..resolver (dictionary.has module [id (#.Some [descriptor document output])]))
                           :abstraction))
         
         (#.Some [id (#.Some [existing_descriptor existing_document existing_output])])
@@ -160,7 +160,7 @@
   (def: .public archived
     (-> Archive (List Module))
     (|>> :representation
-         (get@ #resolver)
+         (value@ #resolver)
          dictionary.entries
          (list.all (function (_ [module [id descriptor+document]])
                      (case descriptor+document
@@ -180,13 +180,13 @@
   (def: .public reserved
     (-> Archive (List Module))
     (|>> :representation
-         (get@ #resolver)
+         (value@ #resolver)
          dictionary.keys))
 
   (def: .public reservations
     (-> Archive (List [Module ID]))
     (|>> :representation
-         (get@ #resolver)
+         (value@ #resolver)
          dictionary.entries
          (list\map (function (_ [module [id _]])
                      [module id]))))
@@ -196,17 +196,17 @@
     (let [[+next +resolver] (:representation additions)]
       (|> archive
           :representation
-          (update@ #next (n.max +next))
-          (update@ #resolver (function (_ resolver)
-                               (list\fold (function (_ [module [id entry]] resolver)
-                                            (case entry
-                                              (#.Some _)
-                                              (dictionary.has module [id entry] resolver)
-                                              
-                                              #.None
-                                              resolver))
-                                          resolver
-                                          (dictionary.entries +resolver))))
+          (revised@ #next (n.max +next))
+          (revised@ #resolver (function (_ resolver)
+                                (list\fold (function (_ [module [id entry]] resolver)
+                                             (case entry
+                                               (#.Some _)
+                                               (dictionary.has module [id entry] resolver)
+                                               
+                                               #.None
+                                               resolver))
+                                           resolver
+                                           (dictionary.entries +resolver))))
           :abstraction)))
 
   (type: Reservation
@@ -281,6 +281,6 @@
            {#next next
             #resolver (list\fold (function (_ [module id] archive)
                                    (dictionary.has module [id #.None] archive))
-                                 (get@ #resolver (:representation ..empty))
+                                 (value@ #resolver (:representation ..empty))
                                  reservations)}))))
   )
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux
index de1858b97..e4cc633de 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux
@@ -50,7 +50,7 @@
 
   (def: .public artifacts
     (-> Registry (Row Artifact))
-    (|>> :representation (get@ #artifacts)))
+    (|>> :representation (value@ #artifacts)))
 
   (def: next
     (-> Registry ID)
@@ -62,8 +62,8 @@
       [id
        (|> registry
            :representation
-           (update@ #artifacts (row.add {#id id
-                                         #category #Anonymous}))
+           (revised@ #artifacts (row.suffix {#id id
+                                             #category #Anonymous}))
            :abstraction)]))
 
   (template [<tag> <create> <fetch>]
@@ -73,18 +73,18 @@
          [id
           (|> registry
               :representation
-              (update@ #artifacts (row.add {#id id
-                                            #category (<tag> name)}))
-              (update@ #resolver (dictionary.has name id))
+              (revised@ #artifacts (row.suffix {#id id
+                                                #category (<tag> name)}))
+              (revised@ #resolver (dictionary.has name id))
               :abstraction)]))
 
      (def: .public (<fetch> registry)
        (-> Registry (List Text))
        (|> registry
            :representation
-           (get@ #artifacts)
+           (value@ #artifacts)
            row.list
-           (list.all (|>> (get@ #category)
+           (list.all (|>> (value@ #category)
                           (case> (<tag> name) (#.Some name)
                                  _ #.None)))))]
 
@@ -99,7 +99,7 @@
   (def: .public (remember name registry)
     (-> Text Registry (Maybe ID))
     (|> (:representation registry)
-        (get@ #resolver)
+        (value@ #resolver)
         (dictionary.value name)))
 
   (def: .public writer
@@ -119,8 +119,8 @@
           artifacts (: (Writer (Row Category))
                        (binary.row/64 category))]
       (|>> :representation
-           (get@ #artifacts)
-           (row\map (get@ #category))
+           (value@ #artifacts)
+           (row\map (value@ #category))
            artifacts)))
 
   (exception: .public (invalid_category {tag Nat})
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 30777c282..a14d708d5 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux
@@ -59,7 +59,7 @@
 
   (def: .public signature
     (-> (Document Any) Signature)
-    (|>> :representation (get@ #signature)))
+    (|>> :representation (value@ #signature)))
 
   (def: .public (writer content)
     (All [d] (-> (Writer d) (Writer (Document d))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux
index bc413b413..8b4dfedb8 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux
@@ -29,7 +29,7 @@
 
 (def: .public (description signature)
   (-> Signature Text)
-  (format (%.name (get@ #name signature)) " " (%.nat (get@ #version signature))))
+  (format (%.name (value@ #name signature)) " " (%.nat (value@ #version signature))))
 
 (def: .public writer
   (Writer Signature)
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux
index 2df8c36ec..6ee936f42 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux
@@ -57,7 +57,7 @@
                   (do {! state.monad}
                     [.let [parents (case (archive.find module archive)
                                      (#try.Success [descriptor document])
-                                     (get@ #descriptor.references descriptor)
+                                     (value@ #descriptor.references descriptor)
                                      
                                      (#try.Failure error)
                                      ..fresh)]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index c5483ac0c..b4fa30d12 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -61,9 +61,9 @@
 
 (def: (archive fs static)
   (All [!] (-> (file.System !) Static file.Path))
-  (format (get@ #static.target static)
+  (format (value@ #static.target static)
           (\ fs separator)
-          (get@ #static.host static)))
+          (value@ #static.host static)))
 
 (def: (unversioned_lux_archive fs static)
   (All [!] (-> (file.System !) Static file.Path))
@@ -88,7 +88,7 @@
   (format (..module fs static module_id)
           (\ fs separator)
           (%.nat artifact_id)
-          (get@ #static.artifact_extension static)))
+          (value@ #static.artifact_extension static)))
 
 (def: (ensure_directory fs path)
   (-> (file.System Async) file.Path (Async (Try Any)))
@@ -125,7 +125,7 @@
 (def: .public (enable fs static)
   (-> (file.System Async) Static (Async (Try Any)))
   (do (try.with async.monad)
-    [_ (..ensure_directory fs (get@ #static.target static))]
+    [_ (..ensure_directory fs (value@ #static.target static))]
     (..ensure_directory fs (..archive fs static))))
 
 (def: (general_descriptor fs static)
@@ -174,7 +174,7 @@
                                   content (document.read $.key document)]
                                  (in [module content])))
                            (archive.archived archive)))]
-    (in (set@ #.modules modules (fresh_analysis_state host)))))
+    (in (with@ #.modules modules (fresh_analysis_state host)))))
 
 (def: (cached_artifacts fs static module_id)
   (-> (file.System Async) Static archive.ID (Async (Try (Dictionary Text Binary))))
@@ -231,7 +231,7 @@
                                             (case artifact_category
                                               #artifact.Anonymous
                                               (do !
-                                                [.let [output (row.add [artifact_id #.None data] output)]
+                                                [.let [output (row.suffix [artifact_id #.None data] output)]
                                                  _ (\ host re_learn context #.None directive)]
                                                 (in [definitions
                                                      [analysers
@@ -241,7 +241,7 @@
                                                      output]))
                                               
                                               (#artifact.Definition name)
-                                              (let [output (row.add [artifact_id #.None data] output)]
+                                              (let [output (row.suffix [artifact_id #.None data] output)]
                                                 (if (text\= $/program.name name)
                                                   (in [definitions
                                                        [analysers
@@ -260,7 +260,7 @@
 
                                               (#artifact.Analyser extension)
                                               (do !
-                                                [.let [output (row.add [artifact_id #.None data] output)]
+                                                [.let [output (row.suffix [artifact_id #.None data] output)]
                                                  value (\ host re_load context #.None directive)]
                                                 (in [definitions
                                                      [(dictionary.has extension (:as analysis.Handler value) analysers)
@@ -271,7 +271,7 @@
 
                                               (#artifact.Synthesizer extension)
                                               (do !
-                                                [.let [output (row.add [artifact_id #.None data] output)]
+                                                [.let [output (row.suffix [artifact_id #.None data] output)]
                                                  value (\ host re_load context #.None directive)]
                                                 (in [definitions
                                                      [analysers
@@ -282,7 +282,7 @@
 
                                               (#artifact.Generator extension)
                                               (do !
-                                                [.let [output (row.add [artifact_id #.None data] output)]
+                                                [.let [output (row.suffix [artifact_id #.None data] output)]
                                                  value (\ host re_load context #.None directive)]
                                                 (in [definitions
                                                      [analysers
@@ -293,7 +293,7 @@
 
                                               (#artifact.Directive extension)
                                               (do !
-                                                [.let [output (row.add [artifact_id #.None data] output)]
+                                                [.let [output (row.suffix [artifact_id #.None data] output)]
                                                  value (\ host re_load context #.None directive)]
                                                 (in [definitions
                                                      [analysers
@@ -304,7 +304,7 @@
 
                                               (#artifact.Custom name)
                                               (do !
-                                                [.let [output (row.add [artifact_id (#.Some name) data] output)]
+                                                [.let [output (row.suffix [artifact_id (#.Some name) data] output)]
                                                  _ (\ host re_learn context (#.Some name) directive)]
                                                 (in [definitions
                                                      [analysers
@@ -333,8 +333,8 @@
                                       (\ ! map (|>> [exported? type annotations]
                                                     #.Definition
                                                     [def_name])))))
-                            (get@ #.definitions content))]
-    (in [(document.write $.key (set@ #.definitions definitions content))
+                            (value@ #.definitions content))]
+    (in [(document.write $.key (with@ #.definitions definitions content))
          bundles])))
 
 (def: (load_definitions fs static module_id host_environment descriptor document)
@@ -345,8 +345,8 @@
                      Bundles]))))
   (do (try.with async.monad)
     [actual (cached_artifacts fs static module_id)
-     .let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)]
-     [document bundles output] (async\in (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))]
+     .let [expected (|> descriptor (value@ #descriptor.registry) artifact.artifacts)]
+     [document bundles output] (async\in (loaded_document (value@ #static.artifact_extension static) host_environment module_id expected actual document))]
     (in [[descriptor document output] bundles])))
 
 (def: (purge! fs static [module_name module_id])
@@ -361,12 +361,12 @@
 
 (def: (valid_cache? expected actual)
   (-> Descriptor Input Bit)
-  (and (text\= (get@ #descriptor.name expected)
-               (get@ #////.module actual))
-       (text\= (get@ #descriptor.file expected)
-               (get@ #////.file actual))
-       (n.= (get@ #descriptor.hash expected)
-            (get@ #////.hash actual))))
+  (and (text\= (value@ #descriptor.name expected)
+               (value@ #////.module actual))
+       (text\= (value@ #descriptor.file expected)
+               (value@ #////.file actual))
+       (n.= (value@ #descriptor.hash expected)
+            (value@ #////.hash actual))))
 
 (type: Purge
   (Dictionary Module archive.ID))
@@ -390,7 +390,7 @@
                  (if (purged? module_name)
                    purge
                    (if (|> descriptor
-                           (get@ #descriptor.references)
+                           (value@ #descriptor.references)
                            set.list
                            (list.any? purged?))
                      (dictionary.has module_name module_id purge)
@@ -417,7 +417,7 @@
                                               (in [true
                                                    [module_name [module_id [descriptor document]]]])
                                               (do !
-                                                [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)]
+                                                [input (//context.read fs ..pseudo_module import contexts (value@ #static.host_module_extension static) module_name)]
                                                 (in [(..valid_cache? descriptor input)
                                                      [module_name [module_id [descriptor document]]]])))))))
      load_order (|> pre_loaded_caches
@@ -447,7 +447,7 @@
                               (archive.has module descriptor,document,output archive))
                             archive
                             loaded_caches)
-        analysis_state (..analysis_state (get@ #static.host static) archive)]
+        analysis_state (..analysis_state (value@ #static.host static) archive)]
        (in [archive
             analysis_state
             (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]]
@@ -473,5 +473,5 @@
       
       (#try.Failure error)
       (in (#try.Success [archive.empty
-                         (fresh_analysis_state (get@ #static.host static))
+                         (fresh_analysis_state (value@ #static.host static))
                          ..empty_bundles])))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
index 0c7969507..979edaa76 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux
@@ -6,6 +6,7 @@
      [predicate (#+ Predicate)]
      ["." monad (#+ Monad do)]]
     [control
+     ["." maybe]
      ["." try (#+ Try)]
      ["." exception (#+ exception:)]
      [concurrency
@@ -17,7 +18,8 @@
       [encoding
        ["." utf8]]]
      [collection
-      ["." dictionary (#+ Dictionary)]]]
+      ["." dictionary (#+ Dictionary)]
+      ["." list]]]
     [world
      ["." file]]]]
   [program
@@ -138,8 +140,8 @@
 (type: .public Enumeration
   (Dictionary file.Path Binary))
 
-(def: (context_listing fs directory enumeration)
-  (-> (file.System Async) Context Enumeration (Async (Try Enumeration)))
+(def: (context_listing fs context directory enumeration)
+  (-> (file.System Async) Context file.Path Enumeration (Async (Try Enumeration)))
   (do {! (try.with async.monad)}
     [enumeration (|> directory
                      (\ fs directory_files)
@@ -147,23 +149,40 @@
                                               (if (text.ends_with? ..lux_extension file)
                                                 (do !
                                                   [source_code (\ fs read file)]
-                                                  (async\in (dictionary.has' (file.name fs file) source_code enumeration)))
+                                                  (async\in (dictionary.has' (text.replaced context "" file) source_code enumeration)))
                                                 (in enumeration)))
                                           enumeration))
                      (\ ! join))]
     (|> directory
         (\ fs sub_directories)
-        (\ ! map (monad.fold ! (context_listing fs) enumeration))
+        (\ ! map (monad.fold ! (context_listing fs context) enumeration))
         (\ ! join))))
 
 (def: Action
   (type (All [a] (Async (Try a)))))
 
+(def: (canonical fs context)
+  (-> (file.System Async) Context (Action Context))
+  (do (try.with async.monad)
+    [subs (\ fs sub_directories context)]
+    (in (|> subs
+            list.head
+            (maybe.else context)
+            (file.parent fs)
+            (maybe.else context)))))
+
 (def: .public (listing fs contexts)
   (-> (file.System Async) (List Context) (Action Enumeration))
-  (monad.fold (: (Monad Action)
-                 (try.with async.monad))
-              (..context_listing fs)
-              (: Enumeration
-                 (dictionary.empty text.hash))
-              contexts))
+  (let [! (: (Monad Action)
+             (try.with async.monad))]
+    (monad.fold !
+                (function (_ context enumeration)
+                  (do !
+                    [context (..canonical fs context)]
+                    (..context_listing fs
+                                       (format context (\ fs separator))
+                                       context
+                                       enumeration)))
+                (: Enumeration
+                   (dictionary.empty text.hash))
+                contexts)))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
index 21c15d551..744d0ecb9 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
@@ -35,8 +35,8 @@
   (-> dependency.Order Order)
   (list\map (function (_ [module [module_id [descriptor document]]])
               (|> descriptor
-                  (get@ #descriptor.registry)
+                  (value@ #descriptor.registry)
                   artifact.artifacts
                   row.list
-                  (list\map (|>> (get@ #artifact.id)))
+                  (list\map (|>> (value@ #artifact.id)))
                   [module_id]))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
index 06ef9b25b..d9707b0c0 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
@@ -143,7 +143,7 @@
   (let [class_path (|> custom
                        (maybe\map (|>> name.internal name.read))
                        (maybe.else (runtime.class_name [module artifact]))
-                       (text.suffix (get@ #static.artifact_extension static)))]
+                       (text.suffix (value@ #static.artifact_extension static)))]
     (do try.monad
       [_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)]
       (in (do_to sink
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux
index 90d28197a..a229c78a1 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux
@@ -104,7 +104,7 @@
                (..bundle_module output))
      entry_content (: (Try tar.Content)
                       (|> descriptor
-                          (get@ #descriptor.references)
+                          (value@ #descriptor.references)
                           set.list
                           (list.all (function (_ module) (dictionary.value module mapping)))
                           (list\map (|>> ..module_file _.string _.load_relative/1))