Fixed artifact file-name generation and archive module naming in caching.

15 files changed, 160 insertions, 80 deletions

diff --git a/stdlib/source/lux/control/function.lux b/stdlib/source/lux/control/function.lux
index ce999eb39..d9b8e36c5 100644
--- a/stdlib/source/lux/control/function.lux
+++ b/stdlib/source/lux/control/function.lux
@@ -5,7 +5,7 @@
 
 (def: #export identity
   {#.doc (doc "Identity function."
-              "Does nothing to it's argument and just returns it."
+              "Does nothing to its argument and just returns it."
               (let [value "foo"]
                 (is? (identity value)
                      value)))}
@@ -40,6 +40,8 @@
     (-> i (-> i o) o))
   (function input))
 
-(structure: #export monoid (All [a] (Monoid (-> a a)))
+(structure: #export monoid
+  (All [a] (Monoid (-> a a)))
+  
   (def: identity ..identity)
   (def: compose ..compose))
diff --git a/stdlib/source/lux/control/io.lux b/stdlib/source/lux/control/io.lux
index da93918c3..533e321b9 100644
--- a/stdlib/source/lux/control/io.lux
+++ b/stdlib/source/lux/control/io.lux
@@ -17,7 +17,7 @@
   {#.doc "A type that represents synchronous, effectful computations that may interact with the outside world."}
   (-> Any a)
 
-  (def: #export (label thunk)
+  (def: (label thunk)
     (All [a] (-> (-> Any a) (IO a)))
     (:abstraction thunk))
 
@@ -26,7 +26,7 @@
                     (function (g!func g!arg)
                       computation))))
 
-  (template: (!execute io)
+  (template: (!run io)
     ## creatio ex nihilo
     ((:representation io) []))
 
@@ -47,22 +47,22 @@
   (def: #export run
     {#.doc "A way to execute IO computations and perform their side-effects."}
     (All [a] (-> (IO a) a))
-    (|>> !execute))
+    (|>> !run))
 
   (structure: #export functor (Functor IO)
     (def: (map f)
-      (|>> !execute f !io)))
+      (|>> !run f !io)))
 
   (structure: #export apply (Apply IO)
     (def: &functor ..functor)
 
     (def: (apply ff fa)
-      (!io ((!execute ff) (!execute fa)))))
+      (!io ((!run ff) (!run fa)))))
 
   (structure: #export monad (Monad IO)
     (def: &functor ..functor)
 
     (def: wrap (|>> !io))
     
-    (def: join (|>> !execute !execute !io)))
+    (def: join (|>> !run !run !io)))
   )
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index b34cd4242..dad69604e 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1379,9 +1379,7 @@
 
                 (#.Left error)
                 (recover-from-failure error)))}
-  (with-gensyms [g!_]
-    (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
-                                               (~ expression)))))))))
+  (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
 
 (syntax: #export (check {#let [imports (..context *compiler*)]}
                         {class (..type^ imports (list))}
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux
index c559d3555..e5a5b3624 100644
--- a/stdlib/source/lux/host.old.lux
+++ b/stdlib/source/lux/host.old.lux
@@ -1462,9 +1462,7 @@
 
                 (#.Left error)
                 (recover-from-failure error)))}
-  (with-gensyms [g!_]
-    (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
-                                               (~ expression)))))))))
+  (wrap (list (` ("lux try" ((~! io.io) (~ expression)))))))
 
 (syntax: #export (check {#let [imports (class-imports *compiler*)]}
                         {class (generic-type^ imports (list))}
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index fa519d8a2..7419ddac5 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -57,17 +57,16 @@
                   <State+> (as-is (///directive.State+ anchor expression directive))
                   <Bundle> (as-is (///generation.Bundle anchor expression directive))]
 
-  (def: (cache-module platform host target-dir module-file-name module-name output ## module
-                      )
+  (def: (cache-module platform host target-dir module-file-name module-id extension output)
     (All <type-vars>
-      (-> <Platform> Host Path Path Text Output ## Module
+      (-> <Platform> Host Path Path archive.ID Text Output
           (Promise (Try Any))))
     (let [system (get@ #&file-system platform)
           write-artifact! (: (-> [Text Binary] (Promise (Try Any)))
                              (function (_ [name content])
-                               (ioW.write system host target-dir module-name name content)))]
+                               (ioW.write system host target-dir module-id name extension content)))]
       (do (try.with promise.monad)
-        [_ (ioW.prepare system host target-dir module-name)
+        [_ (ioW.prepare system host target-dir module-id)
          _ (|> output
                row.to-list
                (monad.map promise.monad
@@ -162,9 +161,9 @@
     ##   (io.fail error))
     )
 
-  (def: #export (compile target partial-host-extension expander platform host configuration archive state)
+  (def: #export (compile target partial-host-extension expander platform host configuration archive extension state)
     (All <type-vars>
-      (-> Text Text Expander <Platform> Host Configuration Archive <State+> (Promise (Try [Archive <State+>]))))
+      (-> Text Text Expander <Platform> Host Configuration Archive Text <State+> (Promise (Try [Archive <State+>]))))
     (let [source-module (get@ #cli.module configuration)
           compiler (:share <type-vars>
                            {<State+>
@@ -182,7 +181,7 @@
                                      (Promise (Try [Archive <State+>])))
                                  recur})]
             (do (try.with promise.monad)
-              [[_module-id archive] (promise@wrap (archive.reserve module archive))
+              [[module-id archive] (promise@wrap (archive.reserve module archive))
                input (context.read (get@ #&file-system platform)
                                    (get@ #cli.sources configuration)
                                    partial-host-extension
@@ -233,10 +232,9 @@
                                            host
                                            target
                                            (get@ #///.file input)
-                                           module
-                                           output
-                                           ## module
-                                           )]
+                                           module-id
+                                           extension
+                                           output)]
                         (case (archive.add module descriptor+document archive)
                           (#try.Success archive)
                           (wrap [archive state])
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index 54c2f615a..e08a6219f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -52,6 +52,7 @@
       [arity (#+ Arity)]
       [reference (#+ Register)]
       [meta
+       [io (#+ lux-context)]
        [archive (#+ Archive)]]]]]])
 
 (type: #export Byte-Code Binary)
@@ -76,11 +77,9 @@
 (type: #export Host
   (generation.Host (Bytecode Any) Definition))
 
-(def: prefix "lux/")
-
 (def: #export (class-name [module id])
   (-> generation.Context Text)
-  (format ..prefix (%.nat module) "/" (%.nat id)))
+  (format lux-context "/" (%.nat module) "/" (%.nat id)))
 
 (def: #export class (type.class "LuxRuntime" (list)))
 
diff --git a/stdlib/source/lux/tool/compiler/meta/cache.lux b/stdlib/source/lux/tool/compiler/meta/cache.lux
index bb4c4d8c8..fbf7fe128 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache.lux
@@ -6,7 +6,7 @@
     ["ex" exception (#+ exception:)]
     pipe]
    [data
-    ["." bit ("#;." equivalence)]
+    ["." bit ("#@." equivalence)]
     ["." maybe]
     ["." product]
     [number
@@ -16,7 +16,7 @@
     ["." text
      [format (#- Format)]]
     [collection
-     ["." list ("#;." functor fold)]
+     ["." list ("#@." functor fold)]
      ["dict" dictionary (#+ Dictionary)]
      ["." set (#+ Set)]]]
    [world
@@ -94,7 +94,7 @@
                                  (do @
                                    [_ (..delete System<m> file)]
                                    (wrap #1))))))]
-             [(list.every? (bit;= #1))
+             [(list.every? (bit@= #1))
               (if> [(..delete System<m> document)]
                    [(wrap [])])]))))
 
@@ -152,7 +152,7 @@
                    (do> @
                         [(..cached System<m>)]
                         [(monad.map @ (load-document System<m> contexts root key binary))
-                         (:: @ map (list;fold (function (_ full-document archive)
+                         (:: @ map (list@fold (function (_ full-document archive)
                                                 (case full-document
                                                   (#.Some [[module references] document])
                                                   (dict.put module [references document] archive)
@@ -162,17 +162,17 @@
                                               (: (Dictionary Text [(List Module) (Ex [d] (Document d))])
                                                  (dict.new text.hash))))]))
      #let [candidate-entries (dict.entries candidate)
-           candidate-dependencies (list;map (product.both id product.left)
+           candidate-dependencies (list@map (product.both id product.left)
                                             candidate-entries)
            candidate-archive (|> candidate-entries
-                                 (list;map (product.both id product.right))
+                                 (list@map (product.both id product.right))
                                  (dict.from-list text.hash))
            graph (|> candidate
                      dict.entries
-                     (list;map (product.both id product.left))
+                     (list@map (product.both id product.left))
                      /dependency.graph
                      (/dependency.prune candidate-archive))
-           archive (list;fold (function (_ module archive)
+           archive (list@fold (function (_ module archive)
                                 (if (dict.contains? module graph)
                                   archive
                                   (dict.remove module archive)))
diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
index ec01baf45..bb3736518 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
@@ -3,29 +3,32 @@
    [data
     ["." text]
     [collection
-     ["." list ("#;." functor fold)]
-     ["dict" dictionary (#+ Dictionary)]]]]
+     ["." list ("#@." functor fold)]
+     ["." dictionary (#+ Dictionary)]]]]
   [///io (#+ Module)]
   [///archive (#+ Archive)])
 
-(type: #export Graph (Dictionary Module (List Module)))
+(type: #export Graph
+  (Dictionary Module (List Module)))
 
-(def: #export empty Graph (dict.new text.hash))
+(def: #export empty
+  Graph
+  (dictionary.new text.hash))
 
 (def: #export (add to from)
   (-> Module Module Graph Graph)
-  (|>> (dict.update~ from (list) (|>> (#.Cons to)))
-       (dict.update~ to (list) id)))
+  (|>> (dictionary.update~ from (list) (|>> (#.Cons to)))
+       (dictionary.update~ to (list) id)))
 
 (def: dependents
-  (-> Module Graph (Maybe (List Text)))
-  dict.get)
+  (-> Module Graph (Maybe (List Module)))
+  dictionary.get)
 
 (def: #export (remove module dependency)
   (-> Module Graph Graph)
   (case (dependents module dependency)
     (#.Some dependents)
-    (list;fold remove (dict.remove module dependency) dependents)
+    (list@fold remove (dictionary.remove module dependency) dependents)
 
     #.None
     dependency))
@@ -36,18 +39,18 @@
 
 (def: #export (dependency [module imports])
   (-> Dependency Graph)
-  (list;fold (..add module) ..empty imports))
+  (list@fold (..add module) ..empty imports))
 
 (def: #export graph
   (-> (List Dependency) Graph)
-  (|>> (list;map ..dependency)
-       (list;fold dict.merge empty)))
+  (|>> (list@map ..dependency)
+       (list@fold dictionary.merge empty)))
 
 (def: #export (prune archive graph)
   (-> Archive Graph Graph)
-  (list;fold (function (_ module graph)
-               (if (dict.contains? module archive)
+  (list@fold (function (_ module graph)
+               (if (dictionary.contains? module archive)
                  graph
                  (..remove module graph)))
              graph
-             (dict.keys graph)))
+             (dictionary.keys graph)))
diff --git a/stdlib/source/lux/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux
index 579164881..271dcb79a 100644
--- a/stdlib/source/lux/tool/compiler/meta/io.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io.lux
@@ -14,3 +14,5 @@
 (def: #export (sanitize system)
   (All [m] (-> (System m) Text Text))
   (text.replace-all "/" (:: system separator)))
+
+(def: #export lux-context "lux")
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index abb8b75c6..2a5713f4f 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -16,56 +16,66 @@
      ["%" format (#+ format)]]]
    [world
     ["." file (#+ Path File System)]]]
-  ["." // (#+ Module)])
+  ["." // (#+ Module)
+   [//
+    ["." archive]]])
 
 (exception: #export (cannot-prepare {archive Path}
-                                    {module Module}
+                                    {module-id archive.ID}
                                     {error Text})
   (exception.report
    ["Archive" archive]
-   ["Module" module]
+   ["Module ID" (%.nat module-id)]
    ["Error" error]))
 
 (def: #export (archive system host root)
   (-> (System Promise) Host Path Path)
   (format root (:: system separator) host))
 
-(def: #export (document system host root module)
-  (-> (System Promise) Host Path Module Path)
+(def: #export (lux-archive system host root)
+  (-> (System Promise) Host Path Path)
   (format (..archive system host root)
           (:: system separator)
-          (//.sanitize system module)))
+          //.lux-context))
+
+(def: #export (document system host root module-id)
+  (-> (System Promise) Host Path archive.ID Path)
+  (format (..lux-archive system host root)
+          (:: system separator)
+          (%.nat module-id)))
 
-(def: #export (artifact system host root module name)
-  (-> (System Promise) Host Path Module Text Path)
-  (format (document system host root module)
+(def: #export (artifact system host root module-id name extension)
+  (-> (System Promise) Host Path archive.ID Text Text Path)
+  (format (document system host root module-id)
           (:: system separator)
-          (//.sanitize system name)))
+          name
+          extension))
 
-(def: #export (prepare system host root module)
-  (-> (System Promise) Host Path Module (Promise (Try Any)))
+(def: #export (prepare system host root module-id)
+  (-> (System Promise) Host Path archive.ID (Promise (Try Any)))
   (do promise.monad
-    [#let [document (..document system host root module)]
+    [#let [document (..document system host root module-id)]
      document-exists? (file.exists? promise.monad system document)]
     (if document-exists?
       (wrap (#try.Success []))
       (do @
-        [outcome (!.use (:: system create-directory) document)]
+        [_ (file.get-directory @ system (..lux-archive system host root))
+         outcome (!.use (:: system create-directory) document)]
         (case outcome
           (#try.Success output)
           (wrap (#try.Success []))
 
           (#try.Failure error)
           (wrap (exception.throw ..cannot-prepare [(..archive system host root)
-                                                   module
+                                                   module-id
                                                    error])))))))
 
-(def: #export (write system host root module name content)
-  (-> (System Promise) Host Path Module Text Binary (Promise (Try Any)))
+(def: #export (write system host root module-id name extension content)
+  (-> (System Promise) Host Path archive.ID Text Text Binary (Promise (Try Any)))
   (do (try.with promise.monad)
     [artifact (: (Promise (Try (File Promise)))
                  (file.get-file promise.monad system
-                                (..artifact system host root module name)))]
+                                (..artifact system host root module-id name extension)))]
     (!.use (:: artifact over-write) content)))
 
 (def: #export (module system host root document)
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 371dbdec7..5fb10d4ba 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -92,6 +92,7 @@
   (def: #export (compiler target partial-host-extension
                           expander host-analysis platform host generation-bundle host-directive-bundle program extender
                           service
+                          extension
                           packager,package)
     (All [<parameters>]
       (-> Path
@@ -105,6 +106,7 @@
           (-> expression artifact)
           Extender
           Service
+          Text
           [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
           (Promise Any)))
     (do promise.monad
@@ -126,7 +128,7 @@
                                        {(Platform <parameters>)
                                         platform}
                                        {(Promise (Try [Archive (directive.State+ <parameters>)]))
-                                        (platform.compile target partial-host-extension expander platform host configuration archive.empty state)})
+                                        (platform.compile target partial-host-extension expander platform host configuration archive.empty extension state)})
                ## _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
                ## _ (cache/io.clean target ...)
                ]
diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux
index b0f89abc7..5353e29cd 100644
--- a/stdlib/source/test/lux/abstract/monoid.lux
+++ b/stdlib/source/test/lux/abstract/monoid.lux
@@ -4,7 +4,7 @@
    ["_" test (#+ Test)]
    [abstract/monad (#+ do)]
    [math
-    ["r" random (#+ Random)]]
+    ["." random (#+ Random)]]
    [control
     ["." function]]]
   {1
@@ -14,12 +14,18 @@
 
 (def: #export (spec (^open "/@.") (^open "/@.") gen-sample)
   (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test))
-  (do r.monad
-    [sample gen-sample]
+  (do random.monad
+    [sample gen-sample
+     left gen-sample
+     mid gen-sample
+     right gen-sample]
     (<| (_.context (%.name (name-of /.Monoid)))
         ($_ _.and
             (_.test "Left identity."
                     (/@= sample (/@compose /@identity sample)))
             (_.test "Right identity."
                     (/@= sample (/@compose sample /@identity)))
+            (_.test "Associativity."
+                    (/@= (/@compose left (/@compose mid right))
+                         (/@compose (/@compose left mid) right)))
             ))))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 169332b30..3a6491f25 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -4,8 +4,9 @@
   ["." / #_
    ["#." concatenative]
    ["#." continuation]
-   ["#." try]
    ["#." exception]
+   ["#." function]
+   ["#." try]
    ["#." io]
    ["#." parser]
    ["#." pipe]
@@ -63,8 +64,9 @@
   ($_ _.and
       /concatenative.test
       /continuation.test
-      /try.test
       /exception.test
+      /function.test
+      /try.test
       /io.test
       /parser.test
       /pipe.test
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
new file mode 100644
index 000000000..f7d4d7678
--- /dev/null
+++ b/stdlib/source/test/lux/control/function.lux
@@ -0,0 +1,58 @@
+(.module:
+  [lux #*
+   [abstract
+    [equivalence (#+ Equivalence)]
+    [monad (#+ do)]]
+   [data
+    ["." name]
+    [number
+     ["n" nat]]
+    ["." text ("#@." equivalence)
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random)]]
+   ["_" test (#+ Test)]]
+  ["." /// #_
+   [abstract
+    ["#." monoid]]]
+  {1
+   ["." /]})
+
+(def: #export test
+  Test
+  (do random.monad
+    [expected random.nat
+     f0 (:: @ map n.+ random.nat)
+     f1 (:: @ map n.* random.nat)
+     dummy random.nat
+     extra (|> random.nat (random.filter (|>> (n.= expected) not)))]
+    (<| (_.context (name.module (name-of /._)))
+        ($_ _.and
+            (let [equivalence (: (Equivalence (-> Nat Nat))
+                                 (structure
+                                  (def: (= left right)
+                                    (n.= (left extra)
+                                         (right extra)))))
+                  generator (: (Random (-> Nat Nat))
+                               (:: @ map n.- random.nat))]
+              (///monoid.spec equivalence /.monoid generator))
+            
+            (_.test (%.name (name-of /.identity))
+                    (n.= expected
+                         (/.identity expected)))
+            (_.test (%.name (name-of /.compose))
+                    (n.= (f0 (f1 expected))
+                         ((/.compose f0 f1) expected)))
+            (_.test (%.name (name-of /.constant))
+                    (n.= expected
+                         ((/.constant expected) dummy)))
+            (_.test (%.name (name-of /.flip))
+                    (let [outcome ((/.flip n.-) expected extra)]
+                      (and (n.= (n.- extra expected)
+                                outcome)
+                           (not (n.= (n.- expected extra)
+                                     outcome)))))
+            (_.test (%.name (name-of /.apply))
+                    (n.= (f0 extra)
+                         (/.apply extra f0)))
+            ))))
diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux
index fb5d3e67b..a0e5f7d4b 100644
--- a/stdlib/source/test/lux/control/io.lux
+++ b/stdlib/source/test/lux/control/io.lux
@@ -11,6 +11,7 @@
       ["$." apply]
       ["$." monad]]}]
    [data
+    ["." name]
     [number
      ["n" nat]]]]
   {1
@@ -29,7 +30,7 @@
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.IO)))
+  (<| (_.context (name.module (name-of /._)))
       (do r.monad
         [sample r.nat
          exit-code r.int]
@@ -38,8 +39,9 @@
             ($apply.spec ..injection ..comparison /.apply)
             ($monad.spec ..injection ..comparison /.monad)
 
-            (_.test "Can execute computations designated as I/O computations."
-                    (n.= sample (/.run (/.io sample))))
-            (_.test "I/O operations won't execute unless they are explicitly run."
+            (_.test (%.name (name-of /.run))
+                    (n.= sample
+                         (/.run (/.io sample))))
+            (_.test (%.name (name-of /.exit))
                     (exec (/.exit exit-code)
                       true))))))