diff options
Diffstat (limited to '')
32 files changed, 284 insertions, 117 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 172de25e7..3d49eb706 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -258,8 +258,8 @@ (wrap [state (#.Right [descriptor (document.write key analysis_module) - (row\map (function (_ [artifact_id directive]) - [artifact_id (write_directive directive)]) + (row\map (function (_ [artifact_id custom directive]) + [artifact_id custom (write_directive directive)]) final_buffer)])])) (#.Some [source requirements temporary_payload]) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 9ebf79b7b..bc0e9b3cc 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -98,8 +98,8 @@ (-> Static <Platform> archive.ID [Descriptor (Document Any) Output] (Promise (Try Any)))) (let [system (get@ #&file_system platform) - write_artifact! (: (-> [artifact.ID Binary] (Action Any)) - (function (_ [artifact_id content]) + write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) + (function (_ [artifact_id custom content]) (ioW.write system static module_id artifact_id content)))] (do {! ..monad} [_ (ioW.prepare system static module_id) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 13d36021f..02adbd2bd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -34,7 +34,7 @@ [archive.ID artifact.ID]) (type: #export (Buffer directive) - (Row [artifact.ID directive])) + (Row [artifact.ID (Maybe Text) directive])) (exception: #export (cannot_interpret {error Text}) (exception.report @@ -54,14 +54,14 @@ evaluate!) (: (-> directive (Try Any)) execute!) - (: (-> Context expression (Try [Text Any directive])) + (: (-> Context (Maybe Text) expression (Try [Text Any directive])) define!) (: (-> Context Binary directive) ingest) - (: (-> Context directive (Try Any)) + (: (-> Context (Maybe Text) directive (Try Any)) re_learn) - (: (-> Context directive (Try Any)) + (: (-> Context (Maybe Text) directive (Try Any)) re_load)) (type: #export (State anchor expression directive) @@ -210,20 +210,20 @@ (#try.Failure error) (exception.throw ..cannot_interpret error)))) -(def: #export (define! context code) +(def: #export (define! context custom code) (All [anchor expression directive] - (-> Context expression (Operation anchor expression directive [Text Any directive]))) + (-> Context (Maybe Text) expression (Operation anchor expression directive [Text Any directive]))) (function (_ (^@ stateE [bundle state])) - (case (\ (get@ #host state) define! context code) + (case (\ (get@ #host state) define! context custom code) (#try.Success output) (#try.Success [stateE output]) (#try.Failure error) (exception.throw ..cannot_interpret error)))) -(def: #export (save! artifact_id code) +(def: #export (save! artifact_id custom code) (All [anchor expression directive] - (-> artifact.ID directive (Operation anchor expression directive Any))) + (-> artifact.ID (Maybe Text) directive (Operation anchor expression directive Any))) (do {! phase.monad} [?buffer (extension.read (get@ #buffer))] (case ?buffer @@ -231,7 +231,7 @@ ## TODO: Optimize by no longer checking for overwrites... (if (row.any? (|>> product.left (n.= artifact_id)) buffer) (phase.throw ..cannot_overwrite_output [artifact_id]) - (extension.update (set@ #buffer (#.Some (row.add [artifact_id code] buffer))))) + (extension.update (set@ #buffer (#.Some (row.add [artifact_id custom code] buffer))))) #.None (phase.throw ..no_buffer_for_saving_code [artifact_id])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index dc8272030..8fd5d2416 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -114,8 +114,8 @@ [codeG (generate archive codeS) id (/////generation.learn name) module_id (phase.lift (archive.id module archive)) - [target_name value directive] (/////generation.define! [module_id id] codeG) - _ (/////generation.save! id directive)] + [target_name value directive] (/////generation.define! [module_id id] #.None codeG) + _ (/////generation.save! id #.None directive)] (wrap [code//type codeG value])))) (def: (definition archive name expected codeC) @@ -166,8 +166,8 @@ [codeG (generate archive codeS) module_id (phase.lift (archive.id current_module archive)) id (<learn> extension) - [target_name value directive] (/////generation.define! [module_id id] codeG) - _ (/////generation.save! id directive)] + [target_name value directive] (/////generation.define! [module_id id] #.None codeG) + _ (/////generation.save! id #.None directive)] (wrap [codeG value]))))) (def: #export (<full> archive extension codeT codeC) @@ -393,7 +393,7 @@ (do phase.monad [programG (generate archive programS) artifact_id (/////generation.learn /////program.name)] - (/////generation.save! artifact_id (program [module_id artifact_id] programG)))) + (/////generation.save! artifact_id #.None (program [module_id artifact_id] programG)))) (def: (def::program program) (All [anchor expression directive] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux index df13919b0..0f2d9adf6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -119,5 +119,5 @@ @self)))))))) ))] _ (/////generation.execute! definition) - _ (/////generation.save! (product.right function_name) definition)] + _ (/////generation.save! (product.right function_name) #.None definition)] (wrap instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 2f6370418..65783662a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -775,11 +775,12 @@ (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id ..runtime)] + _ (/////generation.save! ..module_id #.None ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) (row.row [..module_id + #.None (|> ..runtime _.code (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 37cda09e1..42d9cf2a4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -87,7 +87,7 @@ class.public class.final)) -(def: this-offset 1) +(def: this_offset 1) (def: internal (All [category] @@ -98,22 +98,22 @@ (def: #export (abstraction generate archive [environment arity bodyS]) (Generator Abstraction) (do phase.monad - [@begin //runtime.forge-label - [function-context bodyG] (generation.with-new-context archive - (generation.with-anchor [@begin ..this-offset] + [@begin //runtime.forge_label + [function_context bodyG] (generation.with_new_context archive + (generation.with_anchor [@begin ..this_offset] (generate archive bodyS))) - #let [function-class (//runtime.class-name function-context)] - [fields methods instance] (..with generate archive @begin function-class environment arity bodyG) + #let [function_class (//runtime.class_name function_context)] + [fields methods instance] (..with generate archive @begin function_class environment arity bodyG) class (phase.lift (class.class version.v6_0 ..modifier - (name.internal function-class) + (name.internal function_class) (..internal /abstract.class) (list) fields methods (row.row))) #let [bytecode (format.run class.writer class)] - _ (generation.execute! [function-class bytecode]) - _ (generation.save! function-class [function-class bytecode])] + _ (generation.execute! [function_class bytecode]) + _ (generation.save! function_class #.None [function_class bytecode])] (wrap instance))) (def: #export (apply generate archive [abstractionS inputsS]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index e445ec2d4..edfa6d78d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -537,7 +537,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! ..artifact_id [class bytecode])))) + (generation.save! ..artifact_id #.None [class bytecode])))) (def: generate_function (Operation Any) @@ -594,7 +594,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! //function.artifact_id [class bytecode])))) + (generation.save! //function.artifact_id #.None [class bytecode])))) (def: #export generate (Operation Any) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 97a5b1691..789d30fcc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -133,5 +133,5 @@ (_.apply/1 @self)))))))) ))] _ (/////generation.execute! definition) - _ (/////generation.save! (product.right function_name) definition)] + _ (/////generation.save! (product.right function_name) #.None definition)] (wrap instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index a6719856c..18b65c352 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -108,7 +108,7 @@ )) (|> @context (_.apply/* foreigns))])))] _ (/////generation.execute! directive) - _ (/////generation.save! artifact_id directive)] + _ (/////generation.save! artifact_id #.None directive)] (wrap (|> instantiation (_.apply/* initsO+)))))) (def: #export (recur! statement expression archive argsS+) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index a0266db38..8f1e5b117 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -422,11 +422,12 @@ (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id ..runtime)] + _ (/////generation.save! ..module_id #.None ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) (row.row [..module_id + #.None (|> ..runtime _.code (\ utf8.codec encode))])]))) 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 a4e5e81fc..3a776a2a7 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 @@ -330,5 +330,5 @@ directive (_.def @case @dependencies+ pattern_matching!)] _ (/////generation.execute! directive) - _ (/////generation.save! case_artifact directive)] + _ (/////generation.save! case_artifact #.None directive)] (wrap (_.apply/* @case @dependencies+)))) 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 ca18fb0ef..d2e70def2 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 @@ -48,7 +48,7 @@ #.Nil (do ///////phase.monad [_ (/////generation.execute! function_definition) - _ (/////generation.save! function_id function_definition)] + _ (/////generation.save! function_id #.None function_definition)] (wrap @function)) _ @@ -60,7 +60,7 @@ function_definition (_.return @function)))] _ (/////generation.execute! directive) - _ (/////generation.save! function_id directive)] + _ (/////generation.save! function_id #.None directive)] (wrap (_.apply/* @function inits))))) (def: input 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 353c890f9..4ec21d754 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 @@ -103,7 +103,7 @@ )) (_.apply/* @loop foreigns)]))] _ (/////generation.execute! directive) - _ (/////generation.save! loop_artifact directive)] + _ (/////generation.save! loop_artifact #.None directive)] (wrap (_.apply/* instantiation initsO+))))) (def: #export (recur! statement expression archive argsS+) 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 7a19539df..34009976f 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 @@ -450,11 +450,12 @@ (/////generation.with_buffer (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id ..runtime)] + _ (/////generation.save! ..module_id #.None ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) (row.row [..module_id + #.None (|> ..runtime _.code (\ utf8.codec encode))])])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index af7906c9c..c24efad81 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -108,5 +108,5 @@ (_.do "concat" (list @missing)))))))))))) )))] _ (/////generation.execute! declaration) - _ (/////generation.save! function_artifact declaration)] + _ (/////generation.save! function_artifact #.None declaration)] (wrap instatiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index 2ce60a9a1..3e8e09d8c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -393,11 +393,12 @@ (Operation [Registry Output]) (do ///////phase.monad [_ (/////generation.execute! ..runtime) - _ (/////generation.save! ..module_id ..runtime)] + _ (/////generation.save! ..module_id #.None ..runtime)] (wrap [(|> artifact.empty artifact.resource product.right) (row.row [..module_id + #.None (|> ..runtime _.code (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 735e315c5..39beec921 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -39,7 +39,7 @@ [version (#+ Version)]]]) (type: #export Output - (Row [artifact.ID Binary])) + (Row [artifact.ID (Maybe Text) Binary])) (exception: #export (unknown_document {module Module} {known_modules (List Module)}) 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 33e09e51a..2c6deeb27 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -7,7 +7,7 @@ [pipe (#+ case>)] ["." exception (#+ exception:)] ["<>" parser - ["<b>" binary (#+ Parser)]]] + ["<.>" binary (#+ Parser)]]] [data ["." product] ["." text @@ -30,7 +30,8 @@ (#Analyser Text) (#Synthesizer Text) (#Generator Text) - (#Directive Text)) + (#Directive Text) + (#Custom Text)) (type: #export Artifact {#id ID @@ -90,6 +91,7 @@ [#Synthesizer synthesizer synthesizers] [#Generator generator generators] [#Directive directive directives] + [#Custom custom customs] ) (def: #export (remember name registry) @@ -109,8 +111,9 @@ [1 #Definition binary.text] [2 #Analyser binary.text] [3 #Synthesizer binary.text] - [4 #Generator binary.text] - [5 #Directive binary.text])))) + [4 #Generator binary.text] + [5 #Directive binary.text] + [6 #Custom binary.text])))) artifacts (: (Writer (Row Category)) (binary.row/64 category))] (|>> :representation @@ -126,16 +129,20 @@ (Parser Registry) (let [category (: (Parser Category) (do {! <>.monad} - [tag <b>.nat] + [tag <binary>.nat] (case tag - 0 (\ ! map (|>> #Anonymous) <b>.any) - 1 (\ ! map (|>> #Definition) <b>.text) - 2 (\ ! map (|>> #Analyser) <b>.text) - 3 (\ ! map (|>> #Synthesizer) <b>.text) - 4 (\ ! map (|>> #Generator) <b>.text) - 5 (\ ! map (|>> #Directive) <b>.text) + (^template [<nat> <tag> <parser>] + [<nat> (\ ! map (|>> <tag>) <parser>)]) + ([0 #Anonymous <binary>.any] + [1 #Definition <binary>.text] + [2 #Analyser <binary>.text] + [3 #Synthesizer <binary>.text] + [4 #Generator <binary>.text] + [5 #Directive <binary>.text] + [6 #Custom <binary>.text]) + _ (<>.fail (exception.construct ..invalid_category [tag])))))] - (|> (<b>.row/64 category) + (|> (<binary>.row/64 category) (\ <>.monad map (row\fold (function (_ artifact registry) (product.right (case artifact @@ -149,7 +156,8 @@ [#Analyser ..analyser] [#Synthesizer ..synthesizer] [#Generator ..generator] - [#Directive ..directive]) + [#Directive ..directive] + [#Custom ..custom]) ))) ..empty))))) ) 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 0b7a54a34..cd7b7169a 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -227,12 +227,12 @@ (case (do ! [data (try.from_maybe (dictionary.get (format (%.nat artifact_id) extension) actual)) #let [context [module_id artifact_id] - directive (\ host ingest context data) - output (row.add [artifact_id data] output)]] + directive (\ host ingest context data)]] (case artifact_category #artifact.Anonymous (do ! - [_ (\ host re_learn context directive)] + [#let [output (row.add [artifact_id #.None data] output)] + _ (\ host re_learn context #.None directive)] (wrap [definitions [analysers synthesizers @@ -241,25 +241,27 @@ output])) (#artifact.Definition name) - (if (text\= $/program.name name) - (wrap [definitions - [analysers - synthesizers - generators - directives] - output]) - (do ! - [value (\ host re_load context directive)] - (wrap [(dictionary.put name value definitions) + (let [output (row.add [artifact_id #.None data] output)] + (if (text\= $/program.name name) + (wrap [definitions [analysers synthesizers generators directives] - output]))) + output]) + (do ! + [value (\ host re_load context #.None directive)] + (wrap [(dictionary.put name value definitions) + [analysers + synthesizers + generators + directives] + output])))) (#artifact.Analyser extension) (do ! - [value (\ host re_load context directive)] + [#let [output (row.add [artifact_id #.None data] output)] + value (\ host re_load context #.None directive)] (wrap [definitions [(dictionary.put extension (:as analysis.Handler value) analysers) synthesizers @@ -269,7 +271,8 @@ (#artifact.Synthesizer extension) (do ! - [value (\ host re_load context directive)] + [#let [output (row.add [artifact_id #.None data] output)] + value (\ host re_load context #.None directive)] (wrap [definitions [analysers (dictionary.put extension (:as synthesis.Handler value) synthesizers) @@ -279,7 +282,8 @@ (#artifact.Generator extension) (do ! - [value (\ host re_load context directive)] + [#let [output (row.add [artifact_id #.None data] output)] + value (\ host re_load context #.None directive)] (wrap [definitions [analysers synthesizers @@ -289,12 +293,24 @@ (#artifact.Directive extension) (do ! - [value (\ host re_load context directive)] + [#let [output (row.add [artifact_id #.None data] output)] + value (\ host re_load context #.None directive)] (wrap [definitions [analysers synthesizers generators (dictionary.put extension (:as directive.Handler value) directives)] + output])) + + (#artifact.Custom name) + (do ! + [#let [output (row.add [artifact_id (#.Some name) data] output)] + value (\ host re_load context (#.Some name) directive)] + (wrap [definitions + [analysers + synthesizers + generators + directives] output])))) (#try.Success [definitions' bundles' output']) (recur input' definitions' bundles' output') 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 f5366ab8e..7e79903d5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -11,6 +11,7 @@ ["." promise (#+ Promise)]]] [data ["." binary (#+ Binary)] + ["." maybe ("#\." functor)] ["." text ["%" format (#+ format)]] [collection @@ -109,11 +110,13 @@ (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) manifest))) -(def: (write_class static module artifact content sink) - (-> Static archive.ID artifact.ID Binary java/util/jar/JarOutputStream +(def: (write_class static module artifact custom content sink) + (-> Static archive.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream java/util/jar/JarOutputStream) - (let [class_path (format (runtime.class_name [module artifact]) - (get@ #static.artifact_extension static))] + (let [class_path (|> custom + (maybe\map (|>> name.internal name.read)) + (maybe.default (runtime.class_name [module artifact])) + (text.suffix (get@ #static.artifact_extension static)))] (do_to sink (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) @@ -123,8 +126,8 @@ (def: (write_module static [module output] sink) (-> Static [archive.ID Output] java/util/jar/JarOutputStream java/util/jar/JarOutputStream) - (row\fold (function (_ [artifact content] sink) - (..write_class static module artifact content sink)) + (row\fold (function (_ [artifact custom content] sink) + (..write_class static module artifact custom content sink)) sink output)) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index ac2b5758c..36b1db690 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -33,30 +33,25 @@ ["$" lux [generation (#+ Context)]]]]]]) -## TODO: Delete ASAP -(type: (Action ! a) - (! (Try a))) - (def: (write_module sequence [module output] so_far) (All [directive] (-> (-> directive directive directive) [archive.ID Output] directive (Try directive))) (|> output row.to_list - (list\map product.right) + (list\map (|>> product.right product.right)) (monad.fold try.monad (function (_ content so_far) (|> content (\ utf8.codec decode) (\ try.monad map - (function (_ content) - (sequence so_far - (:share [directive] - directive - so_far - - directive - (:assume content))))))) + (|>> :assume + (:share [directive] + directive + so_far + + directive) + (sequence so_far))))) so_far))) (def: #export (package header to_code sequence scope) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 52cd3efd4..ddfacbc5e 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -318,8 +318,8 @@ (: (-> s (Try [s Exit])) on_await)) -(`` (implementation: (mock_process mock state) - (All [s] (-> (Mock s) (Atom s) (Process IO))) +(`` (implementation: (mock_process state mock) + (All [s] (-> (Atom s) (Mock s) (Process IO))) (~~ (template [<name> <mock>] [(def: (<name> _) @@ -368,7 +368,7 @@ s (Shell IO))) - (def: (execute input) - (io.io (do try.monad - [mock (mock input)] - (wrap (..mock_process mock (atom.atom init))))))) + (def: execute + (|>> mock + (\ try.monad map (..mock_process (atom.atom init))) + io.io))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 15a32959b..1e0c522b9 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -234,12 +234,14 @@ ///package.dependencies (try\map set.to_list) (try.default (list))) - sub_repositories (|> package - ///package.repositories - (try\map set.to_list) - (try.default (list)) - (list\map new_repository) - (list\compose repositories))] + ## For security reasons, it's not a good idea to allow dependencies to introduce repositories. + ## package_repositories (|> package + ## ///package.repositories + ## (try\map set.to_list) + ## (try.default (list)) + ## (list\map new_repository)) + ## sub_repositories (list\compose repositories package_repositories) + sub_repositories repositories] [successes failures resolution] (recur sub_repositories (#.Cons head successes) failures diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 8f1dae1ea..c5756ee97 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -8,7 +8,7 @@ ["." try (#+ Try)] ["." exception] ["<>" parser - ["<xml>" xml (#+ Parser)]]] + ["<.>" xml (#+ Parser)]]] [data ["." name] ["." maybe ("#\." functor)] diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 1292c232f..4b0960d32 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -5,6 +5,7 @@ [abstract [monad (#+ do)]] [control + [pipe (#+ case>)] [io (#+ IO)] ["." try] ["." exception] @@ -72,6 +73,38 @@ (def: (on_await state) (#try.Success [state shell.error])))))))) +(def: #export (reader_shell error?) + (-> Bit (-> (List Text) (Shell IO))) + (shell.mock + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) + (#try.Success + (: (shell.Mock (List Text)) + (implementation + (def: (on_read state) + (if error? + (exception.throw shell.no_more_output []) + (case state + (#.Cons head tail) + (#try.Success [tail head]) + + #.Nil + (exception.throw shell.no_more_output [])))) + (def: (on_error state) + (if error? + (case state + (#.Cons head tail) + (#try.Success [tail head]) + + #.Nil + (exception.throw shell.no_more_output [])) + (exception.throw shell.no_more_output []))) + (def: (on_write input state) + (#try.Failure "on_write")) + (def: (on_destroy state) + (#try.Failure "on_destroy")) + (def: (on_await state) + (#try.Success [state shell.error])))))))) + (def: compiler (Random Dependency) (do random.monad @@ -181,4 +214,39 @@ (text\= /.failure end))))] (_.cover' [/.failure] (try.default false verdict))))) + (do ! + [expected/0 (random.ascii/alpha 5) + expected/1 (random.ascii/alpha 5) + expected/2 (random.ascii/alpha 5)] + (`` ($_ _.and + (~~ (template [<error?> <log!>] + [(let [console (@version.echo "") + shell (|> (list expected/0 expected/1 expected/2) + (..reader_shell <error?>) + shell.async)] + (wrap (do {! promise.monad} + [verdict (do ///action.monad + [process (shell [environment.empty working_directory "" (list "")]) + _ (<log!> console process) + actual/0 (\ console read_line []) + actual/1 (\ console read_line []) + actual/2 (\ console read_line []) + end! (|> (\ console read_line []) + (\ ! map (|>> (case> (#try.Failure error) + true + + (#try.Success _) + false) + #try.Success)))] + (wrap (and (text\= expected/0 actual/0) + (text\= expected/1 actual/1) + (text\= expected/2 actual/2) + end!)))] + (_.cover' [<log!>] + (try.default false verdict)))))] + + [#0 /.log_output!] + [#1 /.log_error!] + )) + ))) )))) diff --git a/stdlib/source/test/aedifex/dependency.lux b/stdlib/source/test/aedifex/dependency.lux index 7ce95f716..733e15710 100644 --- a/stdlib/source/test/aedifex/dependency.lux +++ b/stdlib/source/test/aedifex/dependency.lux @@ -5,7 +5,9 @@ [abstract [monad (#+ do)] [\\specification - ["$." equivalence]]] + ["$." equivalence] + ["$." order] + ["$." hash]]] [math ["." random (#+ Random)]]]] [// @@ -26,4 +28,8 @@ ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) )))) diff --git a/stdlib/source/test/aedifex/dependency/status.lux b/stdlib/source/test/aedifex/dependency/status.lux index f886c031f..64bb2f642 100644 --- a/stdlib/source/test/aedifex/dependency/status.lux +++ b/stdlib/source/test/aedifex/dependency/status.lux @@ -3,8 +3,12 @@ [lux #* ["_" test (#+ Test)] [abstract + [monad (#+ do)] [\\specification ["$." equivalence]]] + [data + ["." binary #_ + ["#T" \\test]]] [math ["." random (#+ Random) ("#\." monad)]]]] ["$." /// #_ @@ -31,4 +35,14 @@ ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [payload (binaryT.random 1)] + (_.cover [/.verified] + (case (/.verified payload) + (#/.Verified sha1 md5) + true + + _ + false))) )))) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index c593f1706..7163ac780 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -14,7 +14,7 @@ [parser ["." cli]]] [data - ["." text] + ["." text ("#\." equivalence)] [collection ["." set (#+ Set)] ["." dictionary (#+ Dictionary)]]] @@ -144,9 +144,20 @@ (_.for [/.Distribution /.License /.SCM /.Organization /.Email /.Developer /.Contributor /.Info /.Source /.Target /.Name /.Profile] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid ..random)) - )))) + (`` ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + + (_.cover [/.default] + (text\= "" /.default)) + (_.cover [/.default_compiler] + (|> (\ /.monoid identity) + (get@ #/.compiler) + (is? /.default_compiler))) + (_.cover [/.default_target] + (|> (\ /.monoid identity) + (get@ #/.target) + (is? /.default_target))) + ))))) diff --git a/stdlib/source/test/aedifex/repository/identity.lux b/stdlib/source/test/aedifex/repository/identity.lux index 74daecb4d..e19acde36 100644 --- a/stdlib/source/test/aedifex/repository/identity.lux +++ b/stdlib/source/test/aedifex/repository/identity.lux @@ -20,7 +20,7 @@ (def: #export test Test (<| (_.covering /._) - (_.for [/.Identity] + (_.for [/.User /.Password /.Identity] ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux index 24745da4a..7d6d3f98b 100644 --- a/stdlib/source/test/aedifex/runtime.lux +++ b/stdlib/source/test/aedifex/runtime.lux @@ -3,7 +3,9 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + [\\specification + ["$." equivalence]]] [data ["." maybe ("#\." functor)] ["." text ("#\." equivalence)] @@ -35,6 +37,9 @@ [path (random.ascii/alpha 5) runtime ..random] (`` ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (~~ (template [<command>] [(_.cover [/.default_java /.default_js /.default_python /.default_lua /.default_ruby] (let [listing (|> (list /.default_java /.default_js /.default_python /.default_lua /.default_ruby) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 26924ef8e..1e9976f4e 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -19,7 +19,9 @@ [data ["." bit ("#\." equivalence)] ["." text ("#\." equivalence) - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [collection + ["." list]]] [macro ["." code ("#\." equivalence)]] ["." math @@ -553,6 +555,38 @@ (n.= (n.* (inc expected_left) (dec expected_right)) (actual expected_left expected_right)))))) +(/.template: (!n/+ <left> <right>) + (n.+ <left> <right>)) + +(def: for_template + Test + (`` ($_ _.and + (_.cover [/.template] + (let [bits (list (~~ (/.template [_] + [true] + + [0] [1] [2] + )))] + (and (n.= 3 (list.size bits)) + (list.every? (bit\= true) bits)))) + (do random.monad + [left random.nat + right random.nat] + (_.cover [/.template:] + (n.= (n.+ left right) + (!n/+ left right)))) + (do {! random.monad} + [sample (\ ! map (n.% 5) random.nat)] + (_.cover [/.^template] + (case sample + (/.^template [<case>] + [<case> true]) + ([0] [1] [2] [3] [4]) + + _ + false))) + ))) + (def: test Test (<| (_.covering /._) @@ -577,6 +611,7 @@ ..for_type ..for_i64 ..for_function + ..for_template ..sub_tests ))) |