Optimizations for the pure-Lux JVM compiler. [Part 4]

author: Eduardo Julian 2022-02-28 04:57:40 -0400
committer: Eduardo Julian 2022-02-28 04:57:40 -0400
commit: 62436b809630ecd3e40bd6e2b45a8870a2866934 (patch)
tree: 00a10d36b76e154cdd04d4e7bb8bf63379489992 /stdlib
parent: 4167849041d7635a0fc2e81fc2bebae3fa0bb3d9 (diff)
16 files changed, 355 insertions, 171 deletions
diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux
index fd68e5ccb..09dbf910f 100644
--- a/stdlib/source/library/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux
@@ -1,39 +1,36 @@
 (.using
-  [library
-   [lux "*"
-    ["[0]" ffi]
-    [abstract
-     [equivalence {"+" Equivalence}]
-     [monad {"+" Monad do}]]
-    [control
-     ["[0]" state {"+" +State}]
-     ["[0]" try {"+" Try}]]
-    [data
-     ["[0]" product]
-     ["[0]" text]
-     ["[0]" format "_"
-      ["[1]" binary {"+" Writer} ("specification#[0]" monoid)]]
-     [collection
-      ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]]
-    [macro
-     ["[0]" template]]
-    [math
-     [number
-      ["[0]" i32]
-      ["n" nat]
-      ["[0]" int]
-      ["[0]" frac]]]
-    [type
-     abstract]]]
-  ["[0]" // {"+" UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference}
-   [//
-    [encoding
-     ["[1][0]" name {"+" Internal External}]
-     ["[1][0]" unsigned]]
-    ["[1][0]" index {"+" Index}]
-    [type
-     [category {"+" Value Method}]
-     ["[1][0]" descriptor {"+" Descriptor}]]]])
+ [library
+  [lux "*"
+   ["[0]" ffi]
+   [abstract
+    [equivalence {"+" Equivalence}]
+    [functor {"+" Functor}]
+    [monad {"+" Monad do}]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" state {"+" +State}]
+    ["[0]" try {"+" Try}]]
+   [data
+    ["[0]" product]
+    ["[0]" text]
+    ["[0]" format "_"
+     ["[1]" binary {"+" Writer} ("specification#[0]" monoid)]]
+    [collection
+     ["[0]" sequence {"+" Sequence} ("[1]#[0]" mix)]]]
+   [math
+    [number
+     ["[0]" int]
+     ["[0]" frac]
+     ["[0]" i32]]]]]
+ ["[0]" // {"+" UTF8 String Class Integer Float Long Double Constant Name_And_Type Reference}
+  [//
+   ["[1][0]" index {"+" Index}]
+   [encoding
+    ["[1][0]" name {"+" Internal External}]
+    ["[1][0]" unsigned]]
+   [type
+    [category {"+" Value Method}]
+    ["[1][0]" descriptor {"+" Descriptor}]]]])
 
 (type: .public Pool
   [Index (Sequence [Index Constant])])
@@ -47,42 +44,90 @@
 (type: .public (Resource a)
   (+State Try Pool a))
 
-(def: .public monad
+(implementation: .public functor
+  (Functor Resource)
+
+  (def: (each $ it)
+    (|>> it
+         (case> {try.#Success [state output]}
+                {try.#Success [state ($ output)]}
+                
+                ... {try.#Failure error}
+                failure
+                (:expected failure)))))
+
+(implementation: .public monad
   (Monad Resource)
-  (state.with try.monad))
-
-(template: (!add <tag> <equivalence> <value>)
-  [(function (_ [current pool])
-     (let [<value>' <value>]
-       (with_expansions [<try_again> (as_is (again (.++ idx)))]
-         (loop [idx 0]
-           (case (sequence.item idx pool)
-             {try.#Success entry}
-             (case entry
-               [index {<tag> reference}]
-               (if (# <equivalence> = reference <value>')
-                 {try.#Success [[current pool]
-                                index]}
-                 <try_again>)
-               
-               _
+
+  (def: &functor ..functor)
+  
+  (def: (in it)
+    (function (_ state)
+      {try.#Success [state it]}))
+  
+  (def: (conjoint it)
+    (function (_ state)
+      (case (it state)
+        {try.#Success [state' it']}
+        (it' state')
+
+        ... {try.#Failure error}
+        failure
+        (:expected failure)))))
+
+(template: (try|each <binding> <value> <body>)
+  [(case <value>
+     {try.#Success <binding>}
+     <body>
+
+     ... {try.#Failure error}
+     failure
+     (:expected failure))])
+
+(template: (try|in <it>)
+  [{try.#Success <it>}])
+
+(template: (!add <state> <tag> <equivalence> <value>)
+  [(let [[current pool] <state>
+         <value>' <value>]
+     (with_expansions [<try_again> (as_is (again (.++ idx)))]
+       (loop [idx 0]
+         (case (sequence.item idx pool)
+           {try.#Success entry}
+           (case entry
+             [index {<tag> reference}]
+             (if (# <equivalence> = reference <value>')
+               {try.#Success [[current pool]
+                              index]}
                <try_again>)
              
-             {try.#Failure _}
-             (let [new {<tag> <value>'}]
-               (do [! try.monad]
-                 [@new (//unsigned.u2 (//.size new))
-                  next (: (Try Index)
-                          (|> current
-                              //index.value
-                              (//unsigned.+/2 @new)
-                              (# ! each //index.index)))]
-                 (in [[next
-                       (sequence.suffix [current new] pool)]
-                      current]))))))))])
-
-(template: (!index <index>)
-  [(|> <index> //index.value //unsigned.value)])
+             _
+             <try_again>)
+           
+           {try.#Failure _}
+           (<| (let [new {<tag> <value>'}])
+               (try|each @new (//unsigned.u2 (//.size new)))
+               (try|each next (: (Try Index)
+                                 (|> current
+                                     //index.value
+                                     (//unsigned.+/2 @new)
+                                     (# try.monad each //index.index))))
+               (try|in [[next
+                         (sequence.suffix [current new] pool)]
+                        current]))))))])
+
+(template: (/|do <state> <body>)
+  [(function (_ <state>)
+     <body>)])
+
+(template: (/|each <state> <binding> <value> <body>)
+  [(case (<value> <state>)
+     {try.#Success [<state> <binding>]}
+     <body>
+
+     ... {try.#Failure error}
+     failure
+     (:expected failure))])
 
 (type: (Adder of)
   (-> of (Resource (Index of))))
@@ -90,7 +135,8 @@
 (template [<name> <type> <tag> <equivalence>]
   [(def: .public (<name> value)
      (Adder <type>)
-     (!add <tag> <equivalence> value))]
+     (<| (/|do %)
+         (!add % <tag> <equivalence> value)))]
 
   [integer Integer //.#Integer (//.value_equivalence i32.equivalence)]
   [float Float //.#Float (//.value_equivalence //.float_equivalence)]
@@ -101,24 +147,25 @@
 
 (def: .public (string value)
   (-> Text (Resource (Index String)))
-  (do ..monad
-    [@value (utf8 value)
-     .let [value (//.string @value)]]
-    (!add //.#String (//.value_equivalence //index.equivalence) value)))
+  (<| (/|do %)
+      (/|each % @value (utf8 value))
+      (let [value (//.string @value)])
+      (!add % //.#String (//.value_equivalence //index.equivalence) value)))
 
 (def: .public (class name)
   (-> Internal (Resource (Index Class)))
-  (do ..monad
-    [@name (utf8 (//name.read name))
-     .let [value (//.class @name)]]
-    (!add //.#Class //.class_equivalence value)))
+  (<| (/|do %)
+      (/|each % @name (utf8 (//name.read name)))
+      (let [value (//.class @name)])
+      (!add % //.#Class //.class_equivalence value)))
 
 (def: .public (descriptor value)
   (All (_ kind)
     (-> (Descriptor kind)
         (Resource (Index (Descriptor kind)))))
-  (let [value (//descriptor.descriptor value)]
-    (!add //.#UTF8 text.equivalence value)))
+  (<| (let [value (//descriptor.descriptor value)])
+      (/|do %)
+      (!add % //.#UTF8 text.equivalence value)))
 
 (type: .public (Member of)
   (Record
@@ -128,24 +175,27 @@
 (def: .public (name_and_type [name descriptor])
   (All (_ of)
     (-> (Member of) (Resource (Index (Name_And_Type of)))))
-  (do ..monad
-    [@name (utf8 name)
-     @descriptor (..descriptor descriptor)]
-    (!add //.#Name_And_Type //.name_and_type_equivalence [//.#name @name //.#descriptor @descriptor])))
+  (<| (/|do %)
+      (/|each % @name (utf8 name))
+      (/|each % @descriptor (..descriptor descriptor))
+      (!add % //.#Name_And_Type //.name_and_type_equivalence [//.#name @name //.#descriptor @descriptor])))
 
 (template [<name> <tag> <of>]
   [(def: .public (<name> class member)
      (-> External (Member <of>) (Resource (Index (Reference <of>))))
-     (do ..monad
-       [@class (..class (//name.internal class))
-        @name_and_type (name_and_type member)]
-       (!add <tag> //.reference_equivalence [//.#class @class //.#name_and_type @name_and_type])))]
+     (<| (/|do %)
+         (/|each % @class (..class (//name.internal class)))
+         (/|each % @name_and_type (name_and_type member))
+         (!add % <tag> //.reference_equivalence [//.#class @class //.#name_and_type @name_and_type])))]
 
   [field //.#Field Value]
   [method //.#Method Method]
   [interface_method //.#Interface_Method Method]
   )
 
+(template: (!index <index>)
+  [(|> <index> //index.value //unsigned.value)])
+
 (def: .public writer
   (Writer Pool)
   (function (_ [next pool])
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index 8f1c1fddf..45430e7e9 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -392,7 +392,7 @@
 
   (type: .public Except
     (Record
-     [#classes (List SVar)
+     [#classes (List Text)
       #exception SVar
       #handler (Statement Any)]))
   
@@ -403,7 +403,7 @@
              (..nested (:representation body!))
              (|> excepts
                  (list#each (function (_ [classes exception catch!])
-                              (format \n+ "except (" (|> classes (list#each ..code) (text.interposed ..input_separator))
+                              (format \n+ "except (" (text.interposed ..input_separator classes)
                                       ") as " (:representation exception) ":"
                                       (..nested (:representation catch!)))))
                  text.together))))
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index c63f5cb2c..787866710 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -54,7 +54,8 @@
     [import {"+" Import}]
     ["[0]" context {"+" Context}]
     ["[0]" cache
-     ["[1]/[0]" module]]
+     ["[1]/[0]" module]
+     ["[1]/[0]" artifact]]
     [cli {"+" Compilation Library}
      ["[0]" compiler {"+" Compiler}]]
     ["[0]" archive {"+" Output Archive}
@@ -109,7 +110,7 @@
       (let [system (value@ #&file_system platform)
             write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any))
                                (function (_ [artifact_id custom content])
-                                 (ioW.write system context module_id artifact_id content)))]
+                                 (cache/artifact.write! system context module_id artifact_id content)))]
         (do [! ..monad]
           [_ (cache/module.enable! system context module_id)
            _ (for [@.python (|> entry
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
index 65e2dcc6a..dff13d37f 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux
@@ -113,7 +113,7 @@
     (function (_ extension phase archive module)
       (do ////////phase.monad
         []
-        (in (_.apply/* (_.var "__import__") (list (_.string module))))))]))
+        (in (_.apply/* (list (_.string module)) (_.var "__import__")))))]))
 
 (def: python::apply
   (custom
@@ -122,7 +122,7 @@
       (do [! ////////phase.monad]
         [abstractionG (phase archive abstractionS)
          inputsG (monad.each ! (phase archive) inputsS)]
-        (in (_.apply/* abstractionG inputsG))))]))
+        (in (_.apply/* inputsG abstractionG))))]))
 
 (def: python::function
   (custom
@@ -137,9 +137,9 @@
                               (list.repeated (.nat arity) []))]
         (in (_.lambda g!inputs
                       (case (.nat arity)
-                        0 (_.apply/1 abstractionG //runtime.unit)
-                        1 (_.apply/* abstractionG g!inputs)
-                        _ (_.apply/1 abstractionG (_.list g!inputs)))))))]))
+                        0 (_.apply/* (list //runtime.unit) abstractionG)
+                        1 (_.apply/* g!inputs abstractionG)
+                        _ (_.apply/* (list (_.list g!inputs)) abstractionG))))))]))
 
 (def: python::exec
   (custom
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index b9f8d24e1..26e21c065 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -56,9 +56,9 @@
     [valueO (expression archive valueS)
      bodyO (expression archive bodyS)]
     ... TODO: Find some way to do 'let' without paying the price of the closure.
-    (in (_.apply/* (_.lambda (list (..register register))
-                             bodyO)
-                   (list valueO)))))
+    (in (_.apply/* (list valueO)
+                   (_.lambda (list (..register register))
+                             bodyO)))))
 
 (def: .public (let! statement expression archive [valueS register bodyS])
   (Generator! [Synthesis Register Synthesis])
@@ -356,4 +356,4 @@
                             pattern_matching!)]
      _ (/////generation.execute! directive)
      _ (/////generation.save! case_artifact {.#None} directive)]
-    (in (_.apply/* @case @dependencies+))))
+    (in (_.apply/* @dependencies+ @case))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index a164ccd5e..9692d6ee7 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -39,7 +39,7 @@
   (do [! ///////phase.monad]
     [functionO (expression archive functionS)
      argsO+ (monad.each ! (expression archive) argsS+)]
-    (in (_.apply/* functionO argsO+))))
+    (in (_.apply/* argsO+ functionO))))
 
 (def: .public capture
   (-> Register SVar)
@@ -64,7 +64,7 @@
                                   (_.return @function)))]
        _ (/////generation.execute! directive)
        _ (/////generation.save! function_id {.#None} directive)]
-      (in (_.apply/* @function inits)))))
+      (in (_.apply/* inits @function)))))
 
 (def: input
   (|>> ++ //case.register))
@@ -82,7 +82,7 @@
            @num_args (_.var "num_args")
            @self (_.var (///reference.artifact [function_module function_artifact]))
            apply_poly (.function (_ args func)
-                        (_.apply/* func (list (_.splat_poly args))))
+                        (_.apply/* (list (_.splat_poly args)) func))
            initialize_self! (_.set (list (//case.register 0)) @self)
            initialize! (list#mix (.function (_ post pre!)
                                    ($_ _.then
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index aecb9b4dd..36762f8cc 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -105,10 +105,10 @@
                                                         actual_loop
                                                         (_.return @loop)
                                                         ))
-                                             (_.apply/* @loop foreigns)]))]
+                                             (_.apply/* foreigns @loop)]))]
        _ (/////generation.execute! directive)
        _ (/////generation.save! loop_artifact {.#None} directive)]
-      (in (_.apply/* instantiation initsO+)))))
+      (in (_.apply/* initsO+ instantiation)))))
 
 (def: .public (again! statement expression archive argsS+)
   (Generator! (List Synthesis))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index 12a2cc5d4..4e293bb74 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -148,7 +148,7 @@
                                      inputs)]
         (in (list (` (def: .public ((~ nameC) (~+ inputsC))
                        (-> (~+ inputs_typesC) (Computation Any))
-                       (_.apply/* (~ runtime_nameC) (list (~+ inputsC)))))
+                       (_.apply/* (list (~+ inputsC)) (~ runtime_nameC))))
                   (` (def: (~ code_nameC)
                        (Statement Any)
                        (..feature (~ runtime_nameC)
@@ -159,15 +159,15 @@
 
 (runtime: (lux::try op)
   (with_vars [exception]
-    (_.try (_.return (..right (_.apply/* op (list ..unit))))
-           (list [(list (_.var "Exception")) exception
+    (_.try (_.return (..right (_.apply/* (list ..unit) op)))
+           (list [(list "Exception") exception
                   (_.return (..left (_.str/1 exception)))]))))
 
 (runtime: (lux::program_args program_args)
   (with_vars [inputs value]
     ($_ _.then
         (_.set (list inputs) ..none)
-        (<| (_.for_in value (_.apply/* (_.var "reversed") (list program_args)))
+        (<| (_.for_in value (_.apply/* (list program_args) (_.var "reversed")))
             (_.set (list inputs)
                    (..some (_.list (list value inputs)))))
         (_.return inputs))))
@@ -379,10 +379,9 @@
 
 (runtime: (f64::decode input)
   (with_vars [ex]
-    (_.try
-     (_.return (..some (_.float/1 input)))
-     (list [(list (_.var "Exception")) ex
-            (_.return ..none)]))))
+    (_.try (_.return (..some (_.float/1 input)))
+           (list [(list "Exception") ex
+                  (_.return ..none)]))))
 
 (def: runtime::f64
   (Statement Any)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 6a7235ac0..522da7f04 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -393,6 +393,10 @@
         [bodyS bodyS
          synthesis_storage path_storage]
         (case bodyS
+          (^or {/.#Simple _}
+               (^ (/.constant _)))
+          synthesis_storage
+          
           (^ (/.variant [lefts right? valueS]))
           (for_synthesis valueS synthesis_storage)
 
@@ -418,6 +422,9 @@
                     (set.union (value@ #dependencies (for_path pathS synthesis_storage)))
                     (for_synthesis inputS synthesis_storage))
 
+          (^ (/.branch/exec [before after]))
+          (list#mix for_synthesis synthesis_storage (list before after))
+
           (^ (/.branch/let [inputS register exprS]))
           (revised@ #dependencies
                     (set.union (|> synthesis_storage
@@ -447,8 +454,5 @@
           (list#mix for_synthesis synthesis_storage replacementsS+)
 
           {/.#Extension [extension argsS]}
-          (list#mix for_synthesis synthesis_storage argsS)
-
-          _
-          synthesis_storage))
+          (list#mix for_synthesis synthesis_storage argsS)))
       )))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
new file mode 100644
index 000000000..d294bc51a
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
@@ -0,0 +1,39 @@
+(.using
+ [library
+  [lux "*"
+   [target {"+" Target}]
+   [control
+    [try {"+" Try}]
+    [concurrency
+     ["[0]" async {"+" Async}]]]
+   [data
+    [binary {"+" Binary}]
+    [text
+     ["%" format {"+" format}]]]
+   [world
+    ["[0]" file]]]]
+ ["[0]" // "_"
+  ["[1][0]" module]
+  [//
+   ["[0]" context {"+" Context}]
+   [archive
+    ["[0]" module]
+    ["[0]" artifact]]]])
+
+(def: .public (path fs context @module @artifact)
+  (All (_ !)
+    (-> (file.System !) Context module.ID artifact.ID file.Path))
+  (format (//module.path fs context @module)
+          (# fs separator)
+          (%.nat @artifact)
+          (value@ context.#artifact_extension context)))
+
+(def: .public (read! fs context @module @artifact)
+  (All (_ !)
+    (-> (file.System !) Context module.ID artifact.ID (! (Try Binary))))
+  (# fs read (..path fs context @module @artifact)))
+
+(def: .public (write! fs context @module @artifact content)
+  (All (_ !)
+    (-> (file.System !) Context module.ID artifact.ID Binary (! (Try Any))))
+  (# fs write content (..path fs context @module @artifact)))
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 46055f00d..5c6340f86 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -57,17 +57,6 @@
       ["[0]" directive]
       ["[1]/[0]" program]]]]]])
 
-(def: .public (artifact fs context module_id artifact_id)
-  (All (_ !) (-> (file.System !) Context module.ID artifact.ID file.Path))
-  (format (cache/module.path fs context module_id)
-          (# fs separator)
-          (%.nat artifact_id)
-          (value@ context.#artifact_extension context)))
-
-(def: .public (write fs context module_id artifact_id content)
-  (-> (file.System Async) Context module.ID artifact.ID Binary (Async (Try Any)))
-  (# fs write content (..artifact fs context module_id artifact_id)))
-
 (def: (general_descriptor fs context)
   (-> (file.System Async) Context file.Path)
   (format (cache.path fs context)
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index ae9d6c593..9d44f0e96 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -1,24 +1,24 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]]]
-  ["[0]" / "_"
-   ["[1][0]" apply]
-   ["[1][0]" codec]
-   ["[1][0]" comonad
-    ["[1]/[0]" cofree]]
-   ["[1][0]" enum]
-   ["[1][0]" equivalence]
-   ["[1][0]" hash]
-   ["[1][0]" mix]
-   ["[1][0]" functor
-    ["[1]/[0]" contravariant]]
-   ["[1][0]" interval]
-   ["[1][0]" monad
-    ["[1]/[0]" free]]
-   ["[1][0]" monoid]
-   ["[1][0]" order]
-   ["[1][0]" predicate]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]]]
+ ["[0]" / "_"
+  ["[1][0]" apply]
+  ["[1][0]" codec]
+  ["[1][0]" comonad
+   ["[1]/[0]" cofree]]
+  ["[1][0]" enum]
+  ["[1][0]" equivalence]
+  ["[1][0]" hash]
+  ["[1][0]" mix]
+  ["[1][0]" functor
+   ["[1]/[0]" contravariant]]
+  ["[1][0]" interval]
+  ["[1][0]" monad
+   ["[1]/[0]" free]]
+  ["[1][0]" monoid]
+  ["[1][0]" order]
+  ["[1][0]" predicate]])
 
 (def: functor
   Test
diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux
index bbb5cc045..e4cf534e0 100644
--- a/stdlib/source/test/lux/abstract/interval.lux
+++ b/stdlib/source/test/lux/abstract/interval.lux
@@ -1,24 +1,24 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    [abstract
-     [monad {"+" do}]
-     ["[0]" order]
-     [\\specification
-      ["$[0]" equivalence]]]
-    [control
-     [pipe {"+" case>}]]
-    [data
-     [collection
-      ["[0]" set]
-      ["[0]" list]]]
-    [math
-     ["[0]" random {"+" Random}]
-     [number
-      ["n" nat]]]]]
-  [\\library
-   ["[0]" / {"+" Interval} ("#[0]" equivalence)]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]
+    ["[0]" order]
+    [\\specification
+     ["$[0]" equivalence]]]
+   [control
+    [pipe {"+" case>}]]
+   [data
+    [collection
+     ["[0]" set]
+     ["[0]" list]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]]]
+ [\\library
+  ["[0]" / {"+" Interval} ("#[0]" equivalence)]])
 
 (template [<name> <cmp>]
   [(def: .public <name>
diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux
index 0d9fb493a..b68adfedd 100644
--- a/stdlib/source/test/lux/target/python.lux
+++ b/stdlib/source/test/lux/target/python.lux
@@ -1,6 +1,6 @@
 (.using
  [library
-  [lux {"-" exec}
+  [lux "*"
    ["_" test {"+" Test}]
    ["[0]" ffi]
    ["[0]" static]
@@ -17,7 +17,7 @@
     ["[0]" try {"+" Try} ("[1]#[0]" functor)]]
    [data
     ["[0]" bit ("[1]#[0]" equivalence)]
-    ["[0]" text {"+" \n} ("[1]#[0]" equivalence)
+    ["[0]" text ("[1]#[0]" equivalence)
      ["%" format {"+" format}]]
     [collection
      ["[0]" list ("[1]#[0]" functor)]]]
@@ -412,7 +412,7 @@
   (let [$output (static.random (|>> %.nat (format "output_") code.text)
                                random.nat)
         environment (..dict [])]
-    (.exec
+    (exec
       ("python exec" (/.code (it (/.var $output))) (:expected environment))
       (Dict::get [$output] environment))))
 
@@ -533,6 +533,52 @@
                ..test|access)
         )))
 
+(def: test|exception
+  Test
+  (do [! random.monad]
+    [expected_error (random.ascii/upper 10)
+     expected random.safe_frac
+     dummy (random.only (|>> (f.= expected) not)
+                        random.safe_frac)
+     $ex (# ! each (|>> %.nat (format "ex_") /.var) random.nat)]
+    ($_ _.and
+        (_.cover [/.raise /.Exception/1]
+                 (case (try (..statement
+                             (function (_ $output)
+                               ($_ /.then
+                                   (/.raise (/.Exception/1 (/.string expected_error)))
+                                   (/.set (list $output) (/.float dummy))))))
+                   {try.#Failure actual_error}
+                   (text#= expected_error actual_error)
+                   
+                   {try.#Success _}
+                   false))
+        (_.cover [/.try /.Except]
+                 (and (|> (..statement
+                           (function (_ $output)
+                             (/.try ($_ /.then
+                                        (/.raise (/.Exception/1 (/.string expected_error)))
+                                        (/.set (list $output) (/.float dummy)))
+                                    (list [/.#classes (list "Exception")
+                                           /.#exception $ex
+                                           /.#handler (/.set (list $output) (/.float expected))]))))
+                          (:as Frac)
+                          (f.= expected))
+                      (case (try (..statement
+                                  (function (_ $output)
+                                    (/.try ($_ /.then
+                                               (/.raise (/.Exception/1 (/.string expected_error)))
+                                               (/.set (list $output) (/.float dummy)))
+                                           (list [/.#classes (list)
+                                                  /.#exception $ex
+                                                  /.#handler (/.set (list $output) (/.float expected))])))))
+                        {try.#Failure actual_error}
+                        (text#= expected_error actual_error)
+                        
+                        {try.#Success actual}
+                        false)))
+        )))
+
 (def: test|statement
   Test
   (do [! random.monad]
@@ -587,6 +633,7 @@
                             (/.set (list $output) (/.apply/* (list) $def)))))
                      (:as Frac)
                      (f.= expected/0)))
+        ..test|exception
         (_.for [/.Location]
                ..test|location)
         )))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
index d1c3c9249..a92a50ea7 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
@@ -16,6 +16,7 @@
   ["[0]" /]]
  ["[0]" / "_"
   ["[1][0]" module]
+  ["[1][0]" artifact]
   ["$/[1]" // "_"
    ["[1][0]" context]]])
 
@@ -45,4 +46,5 @@
                                  post/1))))
 
             /module.test
+            /artifact.test
             ))))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux
new file mode 100644
index 000000000..a9140b6a6
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux
@@ -0,0 +1,53 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    ["[0]" try]
+    [concurrency
+     ["[0]" async {"+" Async} ("[1]#[0]" monad)]]]
+   [data
+    ["[0]" binary ("[1]#[0]" equivalence)
+     ["$[1]" \\test]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]
+   [world
+    ["[0]" file]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" // "_"
+    ["[1][0]" module]]]]
+ ["$[0]" /// "_"
+  ["[1][0]" context]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [.let [/ "/"
+               fs (file.mock /)]
+         context $///context.random
+         @module random.nat
+         @artifact random.nat
+         expected ($binary.random 1)]
+        ($_ _.and
+            (in (do async.monad
+                  [pre (# fs file? (/.path fs context @module @artifact))
+                   _ (//module.enable! fs context @module)
+                   write! (/.write! fs context @module @artifact expected)
+                   post (# fs file? (/.path fs context @module @artifact))
+                   read! (/.read! fs context @module @artifact)]
+                  (_.cover' [/.path /.write! /.read!]
+                            (and (not pre)
+                                 (case write!
+                                   {try.#Success _} true
+                                   {try.#Failure _} false)
+                                 post
+                                 (case read!
+                                   {try.#Success actual} (binary#= expected actual)
+                                   {try.#Failure _} false)))))
+            ))))
author	Eduardo Julian	2022-02-28 04:57:40 -0400
committer	Eduardo Julian	2022-02-28 04:57:40 -0400
commit	62436b809630ecd3e40bd6e2b45a8870a2866934 (patch)
tree	00a10d36b76e154cdd04d4e7bb8bf63379489992 /stdlib
parent	4167849041d7635a0fc2e81fc2bebae3fa0bb3d9 (diff)