From 7db42ab1b9d3c764772ca63c74bf44bb2b8b8325 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 9 Jul 2022 14:35:38 -0400 Subject: First-class programs instead of having a "lux program" extension. --- stdlib/source/documentation/lux.lux | 7 +- stdlib/source/documentation/lux/program.lux | 20 ++- stdlib/source/documentation/lux/test.lux | 2 +- stdlib/source/documentation/lux/world.lux | 1 - stdlib/source/documentation/lux/world/net.lux | 1 - stdlib/source/documentation/lux/world/net/uri.lux | 1 - .../library/lux/meta/compiler/default/init.lux | 150 +++++++++------- .../library/lux/meta/compiler/default/platform.lux | 23 +-- .../lux/phase/extension/declaration/lux.lux | 77 ++------- .../source/library/lux/meta/compiler/meta/cli.lux | 6 + .../lux/meta/compiler/meta/packager/ruby.lux | 2 +- stdlib/source/library/lux/program.lux | 43 ++--- stdlib/source/program/aedifex.lux | 189 ++++++++++----------- .../program/aedifex/artifact/snapshot/time.lux | 2 +- .../program/aedifex/artifact/snapshot/version.lux | 2 +- .../aedifex/artifact/snapshot/version/value.lux | 2 +- .../source/program/aedifex/artifact/time/time.lux | 5 +- stdlib/source/program/aedifex/cli.lux | 7 +- stdlib/source/program/aedifex/command/auto.lux | 10 +- stdlib/source/program/aedifex/command/build.lux | 21 ++- stdlib/source/program/aedifex/command/deploy.lux | 8 +- .../program/aedifex/command/deploy/release.lux | 23 +-- .../program/aedifex/command/deploy/snapshot.lux | 7 +- stdlib/source/program/aedifex/command/deps.lux | 1 - stdlib/source/program/aedifex/command/install.lux | 1 - stdlib/source/program/aedifex/command/test.lux | 16 +- .../program/aedifex/dependency/resolution.lux | 20 ++- stdlib/source/program/aedifex/format.lux | 6 +- stdlib/source/program/aedifex/hash.lux | 2 +- stdlib/source/program/aedifex/input.lux | 2 +- stdlib/source/program/aedifex/parser.lux | 25 +-- stdlib/source/program/aedifex/profile.lux | 8 +- .../source/program/aedifex/repository/identity.lux | 2 +- stdlib/source/program/aedifex/repository/local.lux | 24 +-- stdlib/source/program/aedifex/runtime.lux | 2 +- stdlib/source/program/compositor.lux | 37 +++- stdlib/source/test/aedifex.lux | 13 +- stdlib/source/test/lux.lux | 27 +-- stdlib/source/test/lux/meta/compiler/meta/cli.lux | 3 + stdlib/source/test/lux/program.lux | 80 ++++----- 40 files changed, 444 insertions(+), 434 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 086a7212f..947fec8a1 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -1,7 +1,7 @@ (.require [library [lux - [program (.only program:)] + [program (.only program)] ["$" documentation] ["[0]" debug] [control @@ -893,5 +893,6 @@ /test.documentation /world.documentation]))) -(program: inputs - (io.io (debug.log! ($.markdown ..documentation)))) +(def _ + (program inputs + (io.io (debug.log! ($.markdown ..documentation))))) diff --git a/stdlib/source/documentation/lux/program.lux b/stdlib/source/documentation/lux/program.lux index 60f433db2..bc126a34a 100644 --- a/stdlib/source/documentation/lux/program.lux +++ b/stdlib/source/documentation/lux/program.lux @@ -53,16 +53,18 @@ (.List $.Module) ($.module /._ "" - [($.definition /.program: + [($.definition /.program "Defines the entry-point to a program (similar to the 'main' function/method in other programming languages)." ["Can take a list of all the input parameters to the program." - (program: all_arguments - (do io.monad - [foo (initialize program)] - (do_something_with all_arguments)))] + (def _ + (program all_arguments + (do io.monad + [foo (initialize program)] + (do_something_with all_arguments))))] ["Can also parse them using CLI parsers from the library/lux/control/parser/cli module." - (program: [config configuration_parser] - (do io.monad - [data (initialize program with config)] - (do_something_with data)))])] + (def _ + (program [config configuration_parser] + (do io.monad + [data (initialize program with config)] + (do_something_with data))))])] [..\\parser])) diff --git a/stdlib/source/documentation/lux/test.lux b/stdlib/source/documentation/lux/test.lux index c66aa8eac..467b04150 100644 --- a/stdlib/source/documentation/lux/test.lux +++ b/stdlib/source/documentation/lux/test.lux @@ -67,7 +67,7 @@ ($.definition /.run! (format "Executes a test, and exits the program with either a successful or a failing exit code." - \n "WARNING: This procedure is only meant to be used in (program: ...) forms.") + \n "WARNING: This procedure is only meant to be used in (program ...) forms.") [(run! test)]) ($.definition /.coverage' diff --git a/stdlib/source/documentation/lux/world.lux b/stdlib/source/documentation/lux/world.lux index 795612a5e..2e3dd6945 100644 --- a/stdlib/source/documentation/lux/world.lux +++ b/stdlib/source/documentation/lux/world.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except) - [program (.only program:)] ["$" documentation] ["[0]" debug] [control diff --git a/stdlib/source/documentation/lux/world/net.lux b/stdlib/source/documentation/lux/world/net.lux index 1bc599540..6ec146ddf 100644 --- a/stdlib/source/documentation/lux/world/net.lux +++ b/stdlib/source/documentation/lux/world/net.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except) - [program (.only program:)] ["$" documentation] ["[0]" debug] [control diff --git a/stdlib/source/documentation/lux/world/net/uri.lux b/stdlib/source/documentation/lux/world/net/uri.lux index ab808ab5f..525dacf19 100644 --- a/stdlib/source/documentation/lux/world/net/uri.lux +++ b/stdlib/source/documentation/lux/world/net/uri.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except) - [program (.only program:)] ["$" documentation] ["[0]" debug] [control diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 6d6704655..019edf1c5 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -27,7 +27,7 @@ ["[1][0]" phase] [language [lux - [program (.only Program)] + ["[1][0]" program (.only Program)] ["[1][0]" syntax (.only Aliases)] ["[1][0]" synthesis] ["[1][0]" declaration (.only Requirements)] @@ -47,6 +47,7 @@ ["[0]D" lux]]]]]] [meta ["[0]" archive (.only Archive) + ["[0]" unit] ["[0]" registry (.only Registry)] ["[0]" module (.only) ["[0]" descriptor] @@ -230,62 +231,93 @@ (-> .Module Aliases) (|>> (the .#module_aliases) (dictionary.of_list text.hash))) -(def .public (compiler wrapper expander prelude write_declaration) - (All (_ anchor expression declaration) - (-> ///phase.Wrapper Expander descriptor.Module (-> declaration Binary) - (Instancer (///declaration.State+ anchor expression declaration) .Module))) - (let [execute! (declarationP.phase wrapper expander)] - (function (_ key parameters input) - (let [dependencies (default_dependencies prelude input)] - [///.#dependencies dependencies - ///.#process (function (_ state archive) - (do [! try.monad] - [.let [hash (text#hash (the ///.#code input))] - [state [source buffer]] (<| (///phase.result' state) - (..begin dependencies hash input)) - .let [module (the ///.#module input)]] - (loop (again [iteration (<| (///phase.result' state) - (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))]) - (do ! - [[state ?source&requirements&temporary_payload] iteration] - (case ?source&requirements&temporary_payload - {.#None} - (do ! - [[state [analysis_module [final_buffer final_registry]]] (///phase.result' state (..end module)) - .let [descriptor [descriptor.#hash hash - descriptor.#name module - descriptor.#file (the ///.#file input) - descriptor.#references (set.of_list text.hash dependencies) - descriptor.#state {.#Compiled}]]] - (in [state - {.#Right [[module.#id (try.else module.runtime (archive.id module archive)) - module.#descriptor descriptor - module.#document (document.document key analysis_module)] - (sequence#each (function (_ [artifact_id custom declaration]) - [artifact_id custom (write_declaration declaration)]) - final_buffer) - final_registry]}])) +(with_expansions [ (these anchor expression declaration)] + (def (define_program! archive program global program_module program_definition) + (All (_ ) + (-> Archive + (Program expression declaration) (-> Archive Symbol (///generation.Operation expression)) + descriptor.Module Text + (///generation.Operation Any))) + (do ///phase.monad + [ [@program _] (///generation.definition archive [program_module program_definition]) + @self (///generation.learn [///program.name {.#None}] true (set.has @program (set.empty unit.hash))) + + |program| (global archive [program_module program_definition]) + @module (///phase.lifted (archive.id program_module archive))] + (///generation.save! @self {.#None} (program [@module @self] |program|)))) + + (def .public (compiler program global wrapper expander prelude write_declaration program_module program_definition) + (All (_ anchor expression declaration) + (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation expression)) + ///phase.Wrapper Expander descriptor.Module (-> declaration Binary) + descriptor.Module (Maybe Text) + (Instancer (///declaration.State+ ) .Module))) + (let [execute! (declarationP.phase wrapper expander)] + (function (_ key parameters input) + (let [dependencies (default_dependencies prelude input)] + [///.#dependencies dependencies + ///.#process (function (_ state archive) + (do [! try.monad] + [.let [hash (text#hash (the ///.#code input))] + [state [source buffer]] (<| (///phase.result' state) + (..begin dependencies hash input)) + .let [module (the ///.#module input)]] + (loop (again [iteration (<| (///phase.result' state) + (..iteration wrapper archive expander module source buffer ///syntax.no_aliases))]) + (do ! + [[state ?source&requirements&temporary_payload] iteration] + (case ?source&requirements&temporary_payload + {.#None} + (do ! + [[state [analysis_module [final_buffer final_registry]]] + (<| (///phase.result' state) + (do [! ///phase.monad] + [_ (if (text#= program_module module) + (case program_definition + {.#Some program_definition} + (///declaration.lifted_generation + (define_program! archive program global program_module program_definition)) + + {.#None} + (in [])) + (in []))] + (..end module))) + + .let [descriptor [descriptor.#hash hash + descriptor.#name module + descriptor.#file (the ///.#file input) + descriptor.#references (set.of_list text.hash dependencies) + descriptor.#state {.#Compiled}]]] + (in [state + {.#Right [[module.#id (try.else module.runtime (archive.id module archive)) + module.#descriptor descriptor + module.#document (document.document key analysis_module)] + (sequence#each (function (_ [artifact_id custom declaration]) + [artifact_id custom (write_declaration declaration)]) + final_buffer) + final_registry]}])) - {.#Some [source requirements temporary_payload]} - (let [[temporary_buffer temporary_registry] temporary_payload] - (in [state - {.#Left [///.#dependencies (|> requirements - (the ///declaration.#imports) - (list#each product.left)) - ///.#process (function (_ state archive) - (again (<| (///phase.result' state) - (do [! ///phase.monad] - [analysis_module (<| (is (Operation .Module)) - ///declaration.lifted_analysis - extension.lifted - meta.current_module) - _ (///declaration.lifted_generation - (///generation.set_buffer temporary_buffer)) - _ (///declaration.lifted_generation - (///generation.set_registry temporary_registry)) - _ (|> requirements - (the ///declaration.#referrals) - (monad.each ! (execute! archive))) - temporary_payload (..get_current_payload temporary_payload)] - (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))]}])) - )))))])))) + {.#Some [source requirements temporary_payload]} + (let [[temporary_buffer temporary_registry] temporary_payload] + (in [state + {.#Left [///.#dependencies (|> requirements + (the ///declaration.#imports) + (list#each product.left)) + ///.#process (function (_ state archive) + (again (<| (///phase.result' state) + (do [! ///phase.monad] + [analysis_module (<| (is (Operation .Module)) + ///declaration.lifted_analysis + extension.lifted + meta.current_module) + _ (///declaration.lifted_generation + (///generation.set_buffer temporary_buffer)) + _ (///declaration.lifted_generation + (///generation.set_registry temporary_registry)) + _ (|> requirements + (the ///declaration.#referrals) + (monad.each ! (execute! archive))) + temporary_payload (..get_current_payload temporary_payload)] + (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))]}])) + )))))])))) + ) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 436d6bac3..b0ce99018 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except Module) ["[0]" debug] [abstract ["[0]" monad (.only Monad do)]] @@ -64,7 +64,7 @@ ["[0]" registry (.only Registry)] ["[0]" artifact] ["[0]" module (.only) - ["[0]" descriptor (.only Descriptor)] + ["[0]" descriptor (.only Descriptor Module)] ["[0]" document (.only Document)]]] ["[0]" io ["_[1]" /] @@ -693,11 +693,12 @@ product.left) archive)) - (def (compiler phase_wrapper expander platform) + (def (compiler program global phase_wrapper expander platform program_module program_definition) (All (_ ) - (-> ///phase.Wrapper Expander + (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation expression)) + ///phase.Wrapper Expander Text (Maybe Module) (///.Compiler .Module Any))) - (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (the #write platform))] + (let [instancer (//init.compiler program global phase_wrapper expander syntax.prelude (the #write platform) program_module program_definition)] (instancer $.key (list)))) (def (custom_compiler import context platform compilation_sources compiler @@ -868,11 +869,13 @@ {try.#Success [context (the compiler.#parameters it) /#value]} (exception.except ..invalid_custom_compiler [/#definition /#type])))))) - (def .public (compile lux_compiler phase_wrapper import file_context expander platform compilation context) + (def .public (compile program global lux_compiler phase_wrapper import file_context expander platform compilation context) (All (_ ) - (-> (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander Compilation Lux_Context Lux_Return)) - (let [[host_dependencies libraries compilers sources target module configuration] compilation - import! (|> (..compiler phase_wrapper expander platform) + (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation expression)) + (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander Compilation Lux_Context + Lux_Return)) + (let [[host_dependencies libraries compilers sources target program_module program_definition configuration] compilation + import! (|> (..compiler program global phase_wrapper expander platform program_module program_definition) (serial_compiler import file_context platform sources) (..parallel context))] (do [! ..monad] @@ -884,5 +887,5 @@ lux_compiler (function.on parameters)))))) (monad.all !))] - (import! customs descriptor.runtime module)))) + (import! customs descriptor.runtime program_module)))) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 5c0593b49..b127af8c6 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -271,7 +271,7 @@ (/////generation.log! (format tag " : Tag of " (%.type owner)))) labels))) -(def (deftype_tagged expander host_analysis) +(def (def_type_tagged expander host_analysis) (-> Expander /////analysis.Bundle Handler) (..custom [(all <>.and .local .any @@ -459,83 +459,27 @@ (phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))] ["Analysis" - defanalysis + def_analysis /////analysis.Handler /////analysis.Handler /////declaration.lifted_analysis ..analyser] ["Synthesis" - defsynthesis + def_synthesis /////synthesis.Handler /////synthesis.Handler /////declaration.lifted_synthesis ..synthesizer] ["Generation" - defgeneration + def_generation (/////generation.Handler anchorT expressionT declarationT) (/////generation.Handler anchor expression declaration) /////declaration.lifted_generation ..generator] ["Declaration" - defdeclaration + def_declaration (/////declaration.Handler anchorT expressionT declarationT) (/////declaration.Handler anchor expression declaration) (<|) ..declaration] ) -... TODO; Both "prepare-program" and "define-program" exist only -... because the old compiler couldn't handle a fully-inlined definition -... for "defprogram". Inline them ASAP. -(def (prepare_program archive analyse synthesize programC) - (All (_ anchor expression declaration output) - (-> Archive - /////analysis.Phase - /////synthesis.Phase - Code - (Operation anchor expression declaration Synthesis))) - (do phase.monad - [[_ programA] (<| /////declaration.lifted_analysis - scope.with - typeA.fresh - (typeA.expecting (type_literal (-> (List Text) (IO Any)))) - (analyse archive programC))] - (/////declaration.lifted_synthesis - (synthesize archive programA)))) - -(def (define_program archive @module generate program programS) - (All (_ anchor expression declaration output) - (-> Archive - module.ID - (/////generation.Phase anchor expression declaration) - (Program expression declaration) - Synthesis - (/////generation.Operation anchor expression declaration Any))) - (do phase.monad - [dependencies (cache/artifact.dependencies archive programS) - [interim_artifacts programG] (/////generation.with_interim_artifacts archive - (generate archive programS)) - @self (/////generation.learn [/////program.name {.#None}] true (list#mix set.has dependencies interim_artifacts))] - (/////generation.save! @self {.#None} (program [@module @self] programG)))) - -(def (defprogram program) - (All (_ anchor expression declaration) - (-> (Program expression declaration) (Handler anchor expression declaration))) - (function (handler extension_name phase archive inputsC+) - (case inputsC+ - (list programC) - (do phase.monad - [state (///.lifted phase.state) - .let [analyse (the [/////declaration.#analysis /////declaration.#phase] state) - synthesize (the [/////declaration.#synthesis /////declaration.#phase] state) - generate (the [/////declaration.#generation /////declaration.#phase] state)] - programS (prepare_program archive analyse synthesize programC) - current_module (/////declaration.lifted_analysis - (///.lifted meta.current_module_name)) - @module (phase.lifted (archive.id current_module archive)) - _ (/////declaration.lifted_generation - (define_program archive @module generate program programS))] - (in /////declaration.no_requirements)) - - _ - (phase.except ///.invalid_syntax [extension_name %.code inputsC+])))) - (def (bundle::def expander host_analysis program anchorT,expressionT,declarationT extender) (All (_ anchor expression declaration) (-> Expander @@ -548,12 +492,11 @@ (|> ///bundle.empty (dictionary.has "module" defmodule) (dictionary.has "alias" defalias) - (dictionary.has "type tagged" (deftype_tagged expander host_analysis)) - (dictionary.has "analysis" (defanalysis anchorT,expressionT,declarationT extender)) - (dictionary.has "synthesis" (defsynthesis anchorT,expressionT,declarationT extender)) - (dictionary.has "generation" (defgeneration anchorT,expressionT,declarationT extender)) - (dictionary.has "declaration" (defdeclaration anchorT,expressionT,declarationT extender)) - (dictionary.has "program" (defprogram program)) + (dictionary.has "type tagged" (def_type_tagged expander host_analysis)) + (dictionary.has "analysis" (def_analysis anchorT,expressionT,declarationT extender)) + (dictionary.has "synthesis" (def_synthesis anchorT,expressionT,declarationT extender)) + (dictionary.has "generation" (def_generation anchorT,expressionT,declarationT extender)) + (dictionary.has "declaration" (def_declaration anchorT,expressionT,declarationT extender)) ))) (def .public (bundle expander host_analysis program anchorT,expressionT,declarationT extender) diff --git a/stdlib/source/library/lux/meta/compiler/meta/cli.lux b/stdlib/source/library/lux/meta/compiler/meta/cli.lux index 72e8b7ef1..21d0885ad 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/cli.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/cli.lux @@ -56,6 +56,7 @@ #sources (List Source) #target Target #module Module + #program (Maybe Text) #configuration Configuration])) (type .public Interpretation @@ -84,6 +85,10 @@ [configuration_parser "--configuration" Configuration (.then configuration.parser .any)] ) +(def program_parser + (Parser (Maybe Text)) + (<>.maybe (.named "--program" .any))) + (def .public service (Parser Service) (let [compilation (is (Parser Compilation) @@ -94,6 +99,7 @@ (<>.some ..source_parser) ..target_parser ..module_parser + ..program_parser (<>.else configuration.empty ..configuration_parser)))] (all <>.or (<>.after (.this "build") diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux index 39bc028af..1c0d70dc2 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/packager/ruby.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except) - [type (.only sharing)] [abstract ["[0]" monad (.only do)]] [control @@ -22,6 +21,7 @@ [number ["[0]" nat]]] [meta + [type (.only sharing)] [target ["_" ruby]]] [world diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index f7fd562eb..acfe5a74c 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["<>" parser] - ["[0]" io] + ["[0]" io (.only IO)] [concurrency ["[0]" thread]]] [meta @@ -16,6 +16,9 @@ [syntax (.only syntax)]]]]] ["" \\parser]) +(type .public Program + (-> (List Text) (IO Any))) + (type Arguments (Variant {#Raw Text} @@ -26,7 +29,7 @@ (<>.or .local (.tuple (<>.some .any)))) -(def .public program: +(def .public program (syntax (_ [args ..arguments^ body .any]) (with_symbols [g!program g!args g!_ g!output g!message] @@ -39,22 +42,22 @@ [(, g!output) (, body) (, g!_) (,! thread.run!)] ((,' in) (, g!output)))))] - (in (list (` ("lux def program" - (, (case args - {#Raw args} - (` (.function ((, g!program) (, (code.symbol ["" args]))) - (, initialization+event_loop))) - - {#Parsed args} - (` (.function ((, g!program) (, g!args)) - (case ((,! .result) (.is (,! (.Parser (io.IO .Any))) - ((,! do) (,! <>.monad) - [(,* args) - (, g!_) (,! .end)] - ((,' in) (, initialization+event_loop)))) - (, g!args)) - {.#Right (, g!output)} - (, g!output) + (in (list (` (is Program + (, (case args + {#Raw args} + (` (.function ((, g!program) (, (code.symbol ["" args]))) + (, initialization+event_loop))) + + {#Parsed args} + (` (.function ((, g!program) (, g!args)) + (case ((,! .result) (.is (,! (.Parser (io.IO .Any))) + ((,! do) (,! <>.monad) + [(,* args) + (, g!_) (,! .end)] + ((,' in) (, initialization+event_loop)))) + (, g!args)) + {.#Right (, g!output)} + (, g!output) - {.#Left (, g!message)} - (.panic! (, g!message))))))))))))))) + {.#Left (, g!message)} + (.panic! (, g!message))))))))))))))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 870ae6dd3..f94f56037 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except local) - [program (.only program:)] + ["[0]" program] ["[0]" debug] [abstract [monad (.only do)]] @@ -10,8 +10,6 @@ ["[0]" maybe] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception (.only exception)] - [parser - [environment (.only Environment)]] [concurrency ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] [data @@ -34,7 +32,7 @@ [world ["[0]" shell (.only Exit Shell)] ["[0]" console (.only Console)] - ["[0]" program (.only Program)] + ["[0]" environment] ["[0]" file (.only Path) ["[0]" watch]] [net @@ -69,30 +67,30 @@ set.list (list#each (|>> (/repository/remote.repository http.default {.#None}) /repository.async)))) -(def program (program.async program.default)) +(def environment (environment.async environment.default)) (def fs (file.async file.default)) -(def local (/repository/local.repository ..program ..fs)) +(def local (/repository/local.repository ..environment ..fs)) -(def (with_dependencies program console command profile) +(def (with_dependencies environment console command profile) (All (_ a) - (-> (Program Async) (Console Async) - (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) + (-> (environment.Environment Async) (Console Async) + (-> (Console Async) (environment.Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) (Command a))) (do /action.monad [resolution (/command/deps.do! console - (/repository/local.repository program (file.async file.default)) + (/repository/local.repository environment (file.async file.default)) (..repositories profile) (|>> (/repository/remote.repository http.default {.#None}) /repository.async) profile) - [exit_code output] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile) + [exit_code output] ((command console environment (file.async file.default) (shell.async shell.default) resolution) profile) _ (case exit_code (static shell.normal) (in []) _ (do async.monad - [_ (at program exit exit_code)] + [_ (at environment exit exit_code)] (in {try.#Failure ""})))] (in output))) @@ -106,13 +104,13 @@ (def succeed! (IO Any) - (at program.default exit shell.normal)) + (at environment.default exit shell.normal)) (def (fail! error) (-> Text (IO Any)) (exec (debug.log! error) - (at program.default exit shell.error))) + (at environment.default exit shell.error))) (def (command action) (All (_ a) (-> (Async (Try a)) (IO Any))) @@ -150,86 +148,87 @@ (maybe.trusted (text.clip 0 (-- (text.size it)) it)) it)))))) -(program: [[profiles operation] /cli.command] - (do [! io.monad] - [console (at ! each (|>> (try.else ..write_only) console.async) - console.default)] - (case operation - {/cli.#Version} - (..command - (/command/version.do! console (at /.monoid identity))) - - _ - (do ! - [?profile (/input.read io.monad file.default profiles)] - (case ?profile - {try.#Failure error} - (..fail! error) - - {try.#Success profile} - (case operation - {/cli.#Version} - (in []) - - {/cli.#Clean} - (..command - (/command/clean.do! console (file.async file.default) profile)) - - {/cli.#POM} - (..command - (/command/pom.do! console (file.async file.default) profile)) - - {/cli.#Install} - (..command - (/command/install.do! console ..fs ..local profile)) - - {/cli.#Deploy repository identity} - (..command - (case (the /.#identity profile) - {.#Some artifact} - (case (dictionary.value repository (the /.#deploy_repositories profile)) - {.#Some remote} - (/command/deploy.do! ..program - (shell.async shell.default) - console - ..local - (/repository.async (/repository/remote.repository http.default {.#Some identity} remote)) - (file.async file.default) - artifact - profile) +(def _ + (program.program [[profiles operation] /cli.command] + (do [! io.monad] + [console (at ! each (|>> (try.else ..write_only) console.async) + console.default)] + (case operation + {/cli.#Version} + (..command + (/command/version.do! console (at /.monoid identity))) + + _ + (do ! + [?profile (/input.read io.monad file.default profiles)] + (case ?profile + {try.#Failure error} + (..fail! error) + + {try.#Success profile} + (case operation + {/cli.#Version} + (in []) + + {/cli.#Clean} + (..command + (/command/clean.do! console (file.async file.default) profile)) + + {/cli.#POM} + (..command + (/command/pom.do! console (file.async file.default) profile)) + + {/cli.#Install} + (..command + (/command/install.do! console ..fs ..local profile)) + + {/cli.#Deploy repository identity} + (..command + (case (the /.#identity profile) + {.#Some artifact} + (case (dictionary.value repository (the /.#deploy_repositories profile)) + {.#Some remote} + (/command/deploy.do! ..environment + (shell.async shell.default) + console + ..local + (/repository.async (/repository/remote.repository http.default {.#Some identity} remote)) + (file.async file.default) + artifact + profile) + + {.#None} + (async#in (exception.except ..cannot_find_repository [repository (the /.#deploy_repositories profile)]))) {.#None} - (async#in (exception.except ..cannot_find_repository [repository (the /.#deploy_repositories profile)]))) - - {.#None} - (async#in (exception.except /.no_identity [])))) - - {/cli.#Dependencies} - (..command - (/command/deps.do! console - (/repository/local.repository ..program (file.async file.default)) - (..repositories profile) - (|>> (/repository/remote.repository http.default {.#None}) - /repository.async) - profile)) - - {/cli.#Compilation compilation} - (case compilation - {/cli.#Build} (..command - (..with_dependencies ..program console /command/build.do! profile)) - {/cli.#Test} (..command - (..with_dependencies ..program console /command/test.do! profile))) - - {/cli.#Auto auto} - (do ! - [?watcher watch.default] - (case ?watcher - {try.#Failure error} - (..fail! error) - - {try.#Success watcher} - (..command - (case auto - {/cli.#Build} (..with_dependencies ..program console (/command/auto.do! /command/auto.delay watcher /command/build.do!) profile) - {/cli.#Test} (..with_dependencies ..program console (/command/auto.do! /command/auto.delay watcher /command/test.do!) profile)))))) - ))))) + (async#in (exception.except /.no_identity [])))) + + {/cli.#Dependencies} + (..command + (/command/deps.do! console + (/repository/local.repository ..environment (file.async file.default)) + (..repositories profile) + (|>> (/repository/remote.repository http.default {.#None}) + /repository.async) + profile)) + + {/cli.#Compilation compilation} + (case compilation + {/cli.#Build} (..command + (..with_dependencies ..environment console /command/build.do! profile)) + {/cli.#Test} (..command + (..with_dependencies ..environment console /command/test.do! profile))) + + {/cli.#Auto auto} + (do ! + [?watcher watch.default] + (case ?watcher + {try.#Failure error} + (..fail! error) + + {try.#Success watcher} + (..command + (case auto + {/cli.#Build} (..with_dependencies ..environment console (/command/auto.do! /command/auto.delay watcher /command/build.do!) profile) + {/cli.#Test} (..with_dependencies ..environment console (/command/auto.do! /command/auto.delay watcher /command/test.do!) profile)))))) + )))))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux index b4fb82186..9d9492965 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux @@ -17,7 +17,7 @@ [time ["[0]" instant (.only Instant)]]]]] ["[0]" /// - ["[1][0]" time + ["[1][0]" time (.only) ["[1]/[0]" date] ["[1]/[0]" time]]]) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux index 3ab65cab4..7bf1b9e3e 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux @@ -8,7 +8,7 @@ ["<>" parser]] [data ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["<[1]>" \\parser]] [format ["[0]" xml (.only XML) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux index 534283b7f..54d190c44 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux @@ -5,7 +5,7 @@ [equivalence (.only Equivalence)]] [data ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["%" \\format]]]]] ["[0]" /// (.only Snapshot) ["[1][0]" time] diff --git a/stdlib/source/program/aedifex/artifact/time/time.lux b/stdlib/source/program/aedifex/artifact/time/time.lux index 01e2c85cb..f093c7577 100644 --- a/stdlib/source/program/aedifex/artifact/time/time.lux +++ b/stdlib/source/program/aedifex/artifact/time/time.lux @@ -1,7 +1,6 @@ (.require [library [lux (.except) - ["[0]" time] [abstract [monad (.only do)]] [control @@ -12,7 +11,9 @@ ["<[1]>" \\parser (.only Parser)]]] [math [number - ["n" nat]]]]] + ["n" nat]]] + [world + ["[0]" time]]]] ["[0]" // ["[1]" date]]) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 26a1fd325..8e74893a2 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -5,12 +5,13 @@ [equivalence (.only Equivalence)] [monad (.only do)]] [control - ["<>" parser - ["[0]" cli (.only Parser)]]] + ["<>" parser]] [data ["[0]" sum] ["[0]" product] - ["[0]" text]]]] + ["[0]" text]] + [program + ["cli" \\parser (.only Parser)]]]] [// [repository [identity (.only Identity)]] diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 15d78527b..4e4871f52 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -12,7 +12,7 @@ ["[0]" list] ["[0]" set]]] [world - [program (.only Program)] + [environment (.only Environment)] [shell (.only Exit Shell)] [console (.only Console)] ["[0]" file (.only) @@ -46,11 +46,11 @@ (def .public (do! delay watcher command) (All (_ a) (-> Nat (Watcher Async) - (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) - (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit Any])))) - (function (_ console program fs shell resolution) + (-> (Console Async) (Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit a])) + (-> (Console Async) (Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit Any])))) + (function (_ console environment fs shell resolution) (function (_ profile) - (with_expansions [ ((command console program fs shell resolution) profile)] + (with_expansions [ ((command console environment fs shell resolution) profile)] (do [! async.monad] [targets (|> profile (the ///.#sources) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 9eae7660d..190ec3802 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -16,7 +16,7 @@ ["[0]" text (.use "[1]#[0]" order) ["%" \\format (.only format)]] [collection - ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" list (.use "[1]#[0]" functor mix monoid)] ["[0]" dictionary (.only Dictionary)] ["[0]" set]]] [math @@ -34,7 +34,7 @@ ["[0]" packager (.only) ["[0]_[1]" ruby]]]]] [world - ["[0]" program (.only Program)] + ["[0]" environment (.only Environment)] ["[0]" file (.only Path)] ["[0]" shell (.only Exit Process Shell)] ["[0]" console (.only Console)] @@ -275,19 +275,19 @@ "--add-opens" "java.base/java.lang=ALL-UNNAMED")) runtime))) -(def .public (do! console program fs shell resolution) - (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit Lux Path])) +(def .public (do! console environment fs shell resolution) + (-> (Console Async) (Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit Lux Path])) (function (_ profile) (let [target (the ///.#target profile)] (case (the ///.#program profile) {.#None} (async#in (exception.except ..no_specified_program [])) - {.#Some program_module} + {.#Some [program_module program_definition]} (do async.monad - [environment (program.environment async.monad program) - .let [home (at program home) - working_directory (at program directory)]] + [.let [home (at environment home) + working_directory (at environment directory)] + environment (environment.environment async.monad environment)] (do ///action.monad [[resolution lux] (async#in (..lux resolution (the ///.#lux profile))) .let [host_dependencies (..host_dependencies fs home resolution) @@ -320,7 +320,10 @@ (..plural "--compiler" (list#each compiler.format (the ///.#compilers profile))) (..plural "--source" (set.list (the ///.#sources profile))) (..singular "--target" cache_directory) - (..singular "--module" program_module) + (case program_module + "" (..singular "--module" program_definition) + _ (list#composite (..singular "--module" program_module) + (..singular "--program" program_definition))) (..singular "--configuration" (configuration.format (the ///.#configuration profile)))))] process (at shell execute [(dictionary.composite environment command_environment) working_directory diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index c579f165a..c4dfe7c7d 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -8,7 +8,7 @@ [concurrency [async (.only Async)]]] [world - [program (.only Program)] + [environment (.only Environment)] [shell (.only Shell)] ["[0]" file] ["[0]" console (.only Console)]]]] @@ -26,11 +26,11 @@ (def .public success "Successfully deployed the project.") -(def .public (do! program shell console local remote fs artifact profile) - (-> (Program Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any)) +(def .public (do! environment shell console local remote fs artifact profile) + (-> (Environment Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any)) (do [! ///action.monad] [_ (if (/snapshot.snapshot? artifact) (/snapshot.do! console remote fs artifact profile) - (/release.do! program shell console local remote fs artifact profile))] + (/release.do! environment shell console local remote fs artifact profile))] (is (Async (Try Any)) (console.write_line ..success console)))) diff --git a/stdlib/source/program/aedifex/command/deploy/release.lux b/stdlib/source/program/aedifex/command/deploy/release.lux index e30c115d2..d7394d7a3 100644 --- a/stdlib/source/program/aedifex/command/deploy/release.lux +++ b/stdlib/source/program/aedifex/command/deploy/release.lux @@ -3,7 +3,6 @@ [lux (.except) ["[0]" ffi (.only import)] [abstract - [predicate (.only Predicate)] ["[0]" monad (.only do)]] [control ["[0]" pipe] @@ -11,8 +10,8 @@ ["[0]" io (.only IO)] [concurrency ["[0]" async (.only Async)]] - [parser - ["[0]" environment]]] + [function + [predicate (.only Predicate)]]] [data [binary (.only Binary)] ["[0]" text (.only) @@ -34,7 +33,9 @@ ["[0]" packager ["[1]" jvm]]]]] [world - [program (.only Program)] + ["[0]" environment + [/ (.only Environment)] + ["[1]" \\parser]] [console (.only Console)] ["[0]" shell (.only Shell)] ["[0]" file]]]] @@ -112,8 +113,8 @@ (Predicate Artifact) (|>> //snapshot.snapshot? not)) -(def (install_dummies! program local fs artifact) - (-> (Program Async) (Repository Async) (file.System Async) Artifact (Async (Try Any))) +(def (install_dummies! environment local fs artifact) + (-> (Environment Async) (Repository Async) (file.System Async) Artifact (Async (Try Any))) (do (try.with async.monad) [.let [$artifact (////artifact.uri (the ////artifact.#version artifact) artifact)] _ (at local upload (..jar $artifact) ..dummy_jar) @@ -144,13 +145,13 @@ _ (..release_unsigned_artifact! local remote signature)] (in []))) -(def .public (do! program shell console local remote fs artifact profile) - (-> (Program Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any)) +(def .public (do! environment shell console local remote fs artifact profile) + (-> (Environment Async) (Shell Async) (Console Async) (Repository Async) (Repository Async) (file.System Async) Artifact (Command Any)) (do [! ////action.monad] [_ (///install.do! console fs local profile) - _ (install_dummies! program local fs artifact) - .let [working_directory (at program directory) - @root (////repository/local.root program fs) + _ (install_dummies! environment local fs artifact) + .let [working_directory (at environment directory) + @root (////repository/local.root environment fs) $bundle (////artifact.bundle (the ////artifact.#version artifact) artifact) / (at fs separator) @local (%.format @root / $bundle)] diff --git a/stdlib/source/program/aedifex/command/deploy/snapshot.lux b/stdlib/source/program/aedifex/command/deploy/snapshot.lux index eec503275..bd253bfcd 100644 --- a/stdlib/source/program/aedifex/command/deploy/snapshot.lux +++ b/stdlib/source/program/aedifex/command/deploy/snapshot.lux @@ -2,15 +2,16 @@ [library [lux (.except) [abstract - [monad (.only do)] - [predicate (.only Predicate)]] + [monad (.only do)]] [control + [function + [predicate (.only Predicate)]] [concurrency ["[0]" async (.only Async)]]] [data ["[0]" binary ["[1]" \\format]] - ["[0]" text + ["[0]" text (.only) [encoding ["[0]" utf8]]] [collection diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 4ffc6e641..4ec5693f0 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -16,7 +16,6 @@ ["%" \\format]]] [world [net (.only URL)] - [program (.only Program)] ["[0]" file] ["[0]" console (.only Console)]]]] ["[0]" // diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 2bd647a44..67739203a 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -25,7 +25,6 @@ [meta ["[0]" export]]]] [world - [program (.only Program)] ["[0]" file] ["[0]" console (.only Console)]]]] ["[0]" // diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 7acc3e8c9..16a2694d4 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -17,7 +17,7 @@ [macro ["^" pattern]]] [world - ["[0]" program (.only Program)] + ["[0]" environment (.only Environment)] ["[0]" file] ["[0]" shell (.only Exit Shell)] ["[0]" console (.only Console)]]]] @@ -35,14 +35,14 @@ (def .public success "[TEST ENDED]") (def .public failure "[TEST FAILED]") -(def .public (do! console program fs shell resolution profile) - (-> (Console Async) (Program Async) (file.System Async) (Shell Async) Resolution (Command [Exit Any])) +(def .public (do! console environment fs shell resolution profile) + (-> (Console Async) (Environment Async) (file.System Async) (Shell Async) Resolution (Command [Exit Any])) (do async.monad - [environment (program.environment async.monad program) - .let [working_directory (at program directory)]] + [.let [home (at environment home) + working_directory (at environment directory)] + environment_vars (environment.environment async.monad environment)] (do [! ///action.monad] - [.let [home (at program home)] - [build_exit compiler program] (//build.do! console program fs shell resolution + [[build_exit compiler program] (//build.do! console environment fs shell resolution (has ///.#program (the ///.#test profile) profile))] (if (i.= shell.normal build_exit) (do ! @@ -63,7 +63,7 @@ [//build.#Python ///.#python] [//build.#Lua ///.#lua] [//build.#Ruby ///.#ruby]))] - process (at shell execute [(dictionary.composite environment command_environment) + process (at shell execute [(dictionary.composite environment_vars command_environment) working_directory test_command test_parameters]) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 7cabf5b88..ae075b5b0 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -6,17 +6,18 @@ [abstract [codec (.only Codec)] [equivalence (.only Equivalence)] - [monad (.only do)] - ["[0]" predicate (.only Predicate)]] + [monad (.only do)]] [control ["[0]" maybe] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception (.only Exception exception)] + [function + ["[0]" predicate (.only Predicate)]] [concurrency ["[0]" async (.only Async)]]] [data ["[0]" binary (.only Binary)] - ["[0]" textnone + ["[0]" text (.only) ["%" \\format (.only format)] [encoding ["[0]" utf8]]] @@ -49,7 +50,7 @@ ["[1][0]" artifact (.only Version Artifact) ["[1]/[0]" extension (.only Extension)] ["[1]/[0]" versioning] - ["[0]" snapshotnone + ["[0]" snapshot (.only) [version ["[0]" value]]]] ["[1][0]" repository (.only Repository) @@ -222,12 +223,13 @@ tail resolution) _ (do [! async.monad] - [?package (case (dictionary.value head resolution) - {.#Some package} - (in {try.#Success package}) + [?package (is (Async (Try Package)) + (case (dictionary.value head resolution) + {.#Some package} + (in {try.#Success package}) - {.#None} - (..any console repositories head))] + {.#None} + (..any console repositories head)))] (case ?package {try.#Success package} (do ! diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 06dfa2988..5eb32d757 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -8,8 +8,8 @@ ["[0]" list (.use "[1]#[0]" monad)] ["[0]" set (.only Set)]]] [meta + ["[0]" code] [macro - ["[0]" code] ["[0]" template]] [compiler [meta @@ -171,8 +171,8 @@ (..on_list "compilers" (the /.#compilers value) ..compiler) (..on_set "sources" (the /.#sources value) code.text) (dictionary.has "target" (code.text (the /.#target value))) - (..on_maybe "program" (the /.#program value) code.text) - (..on_maybe "test" (the /.#test value) code.text) + (..on_maybe "program" (the /.#program value) code.symbol) + (..on_maybe "test" (the /.#test value) code.symbol) (..on_dictionary "deploy_repositories" (the /.#deploy_repositories value) code.text code.text) (,, (with_template [] [(dictionary.has (template.text []) (..runtime (the value)))] diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index b292f004b..4506720a1 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -11,7 +11,7 @@ ["[0]" exception (.only exception)]] [data ["[0]" binary (.only Binary)] - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only Format format)] ["[0]" encoding]]] [math diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index a29cb49a7..509d8e16f 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -9,7 +9,7 @@ ["[0]" try (.only Try)]] [data [binary (.only Binary)] - ["[0]" text + ["[0]" text (.only) [encoding ["[0]" utf8]]] [collection diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 95197c4d9..0327a4cd9 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Module) + [lux (.except type) [abstract [monad (.only do)]] [control @@ -19,10 +19,7 @@ [compiler [meta [cli - [compiler (.only Compiler)]] - [archive - [module - [descriptor (.only Module)]]]]]] + [compiler (.only Compiler)]]]]] [world [net (.only URL)]]]] ["[0]" // @@ -171,9 +168,13 @@ (Parser /.Target) .text) -(def module - (Parser Module) - .text) +(def module_or_program + (Parser Symbol) + .symbol) + +(def program + (Parser Symbol) + .global) (def deploy_repository (Parser [Text //repository.Address]) @@ -234,12 +235,12 @@ (|> ..target (..singular input "target") (<>.else /.default_target))) - ^program (is (Parser (Maybe Module)) + ^program (is (Parser (Maybe Symbol)) (<>.maybe - (..singular input "program" ..module))) - ^test (is (Parser (Maybe Module)) + (..singular input "program" ..module_or_program))) + ^test (is (Parser (Maybe Symbol)) (<>.maybe - (..singular input "test" ..module))) + (..singular input "test" ..program))) ^deploy_repositories (is (Parser (Dictionary Text //repository.Address)) (<| (at ! each (dictionary.of_list text.hash)) (<>.else (list)) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 579c21b41..627073d79 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -175,8 +175,8 @@ #compilers (List Compiler) #sources (Set Source) #target Target - #program (Maybe Module) - #test (Maybe Module) + #program (Maybe Symbol) + #test (Maybe Symbol) #deploy_repositories (Dictionary Text Address) #configuration (property.List Text) #java Runtime @@ -207,9 +207,9 @@ ... #target text.equivalence ... #program - (maybe.equivalence text.equivalence) + (maybe.equivalence symbol.equivalence) ... #test - (maybe.equivalence text.equivalence) + (maybe.equivalence symbol.equivalence) ... #deploy_repositories (dictionary.equivalence text.equivalence) ... #configuration diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux index 348a3fc46..eaca93cdb 100644 --- a/stdlib/source/program/aedifex/repository/identity.lux +++ b/stdlib/source/program/aedifex/repository/identity.lux @@ -6,7 +6,7 @@ [equivalence (.only Equivalence)]] [data ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only format)] [encoding ["[0]" utf8]]]]]]) diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 39a5c8396..af9b502aa 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -11,7 +11,7 @@ ["[0]" text (.only) ["%" \\format (.only format)]]] [world - [program (.only Program)] + [environment (.only Environment)] ["[0]" file] [net ["[0]" uri (.only URI)]]]]] @@ -20,37 +20,37 @@ ["[1][0]" local] ["[1][0]" metadata]]]) -(def .public (root program fs) - (-> (Program Async) (file.System Async) file.Path) +(def .public (root environment fs) + (-> (Environment Async) (file.System Async) file.Path) (let [/ (at fs separator)] (|> ///local.repository (text.replaced uri.separator /) - (format (at program home) /)))) + (format (at environment home) /)))) (def (path /) (-> Text (-> URI file.Path)) (text.replaced uri.separator /)) -(def (absolute_path program fs) - (-> (Program Async) (file.System Async) (-> URI file.Path)) +(def (absolute_path environment fs) + (-> (Environment Async) (file.System Async) (-> URI file.Path)) (let [/ (at fs separator)] (|>> ///metadata.local_uri (..path /) - (format (..root program fs) /)))) + (format (..root environment fs) /)))) -(def .public (repository program fs) - (-> (Program Async) (file.System Async) (//.Repository Async)) +(def .public (repository environment fs) + (-> (Environment Async) (file.System Async) (//.Repository Async)) (implementation (def description - (..root program fs)) + (..root environment fs)) (def download - (|>> (..absolute_path program fs) + (|>> (..absolute_path environment fs) (at fs read))) (def (upload uri content) (do [! async.monad] - [.let [absolute_path (..absolute_path program fs uri)] + [.let [absolute_path (..absolute_path environment fs uri)] ? (at fs file? absolute_path) _ (is (Async (Try Any)) (if ? diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux index 20d270008..db9e662df 100644 --- a/stdlib/source/program/aedifex/runtime.lux +++ b/stdlib/source/program/aedifex/runtime.lux @@ -5,7 +5,7 @@ [equivalence (.only Equivalence)]] [data ["[0]" product] - ["[0]" text + ["[0]" text (.only) ["%" \\format (.only format)]] [collection ["[0]" list (.use "[1]#[0]" monoid)] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 3b5150c7e..3f3009b67 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -133,7 +133,7 @@ (with_expansions [ (these anchor expression artifact)] (def .public (compiler lux_compiler file_context - expander host_analysis platform generation_bundle host_declaration_bundle program anchorT,expressionT,declarationT extender + expander host_analysis platform generation_bundle host_declaration_bundle program global anchorT,expressionT,declarationT extender service packager,package) (All (_ ) @@ -144,7 +144,7 @@ (IO (Platform )) (generation.Bundle ) (-> phase.Wrapper (declaration.Bundle )) - (Program expression artifact) + (Program expression artifact) (-> Archive Symbol (generation.Operation expression)) [Type Type Type] (-> phase.Wrapper Extender) Service @@ -157,23 +157,44 @@ (<| (or_crash! "Compilation failed:") ..timed (do (try.with async.monad) - [.let [[compilation_host_dependencies compilation_libraries compilation_compilers compilation_sources compilation_target compilation_module compilation_configuration] compilation] - import (import.import (the platform.#file_system platform) compilation_libraries) + [import (import.import (the platform.#file_system platform) (the cli.#libraries compilation)) [state archive phase_wrapper] (sharing [] (is (Platform ) platform) (is (Async (Try [(declaration.State+ ) Archive phase.Wrapper])) - (as_expected (platform.initialize file_context compilation_module expander host_analysis platform generation_bundle host_declaration_bundle program anchorT,expressionT,declarationT extender - import compilation_sources compilation_configuration)))) + (as_expected (platform.initialize file_context + (the cli.#module compilation) + expander + host_analysis + platform + generation_bundle + host_declaration_bundle + program + anchorT,expressionT,declarationT + extender + import + (the cli.#sources compilation) + (the cli.#configuration compilation))))) [archive state] (sharing [] (is (Platform ) platform) (is (Async (Try [Archive (declaration.State+ )])) - (as_expected (platform.compile lux_compiler phase_wrapper import file_context expander platform compilation [archive state])))) + (as_expected (platform.compile program + global + lux_compiler + phase_wrapper + import + file_context + expander + platform + compilation + [archive state])))) _ (cache.cache! (the platform.#file_system platform) file_context archive) - host_dependencies (..load_host_dependencies (the platform.#file_system platform) compilation_host_dependencies) + host_dependencies (..load_host_dependencies (the platform.#file_system platform) + (the cli.#host_dependencies compilation)) + _ (..package! (for @.old (file.async file.default) @.jvm (file.async file.default) ... TODO: Handle this in a safer manner. diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 790b09bdc..f30ec52c0 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - [program (.only program:)] + [program (.only program)] ["_" test (.only Test)] [control ["[0]" io]]]] @@ -54,8 +54,9 @@ /runtime.test )) -(program: args - (<| io.io - _.run! - (_.times 100) - ..test)) +(def _ + (program args + (<| io.io + _.run! + (_.times 100) + ..test))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 04d1ca0f9..74983c2a1 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,7 +1,7 @@ (.`` (.`` (.require [library ["/" lux (.except) - [program (.only program:)] + [program (.only program)] ["_" test (.only Test)] [abstract [monad (.only do)]] @@ -1212,15 +1212,16 @@ /ffi.test )))) -(program: args - (let [times (for @.old 100 - @.jvm 100 - @.js 10 - @.python 1 - @.lua 1 - @.ruby 1 - 100)] - (<| io.io - _.run! - (_.times times) - ..test))) +(def _ + (program args + (let [times (for @.old 100 + @.jvm 100 + @.js 10 + @.python 1 + @.lua 1 + @.ruby 1 + 100)] + (<| io.io + _.run! + (_.times times) + ..test)))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cli.lux b/stdlib/source/test/lux/meta/compiler/meta/cli.lux index 28bc83c3b..156804e1a 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cli.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cli.lux @@ -40,6 +40,7 @@ libraries (random.list amount (random.lower_case 3)) target (random.lower_case 4) module (random.lower_case 5) + program (random.lower_case 6) compilers (random.list amount $/compiler.random) configuration ($configuration.random 5) .let [compilation' (all list#composite @@ -128,6 +129,7 @@ /.#sources sources /.#target target /.#module module + /.#program {.#Some program} /.#configuration configuration]}] [{/.#Interpretation [/.#host_dependencies host_dependencies /.#libraries libraries @@ -135,6 +137,7 @@ /.#sources sources /.#target target /.#module module + /.#program {.#Some program} /.#configuration configuration]}] [{/.#Export [sources target]}] ))))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 1f31b3874..c2e473f46 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -91,58 +91,48 @@ (!expect {try.#Failure _})))) )))) -(def actual_program - (syntax (_ [actual_program (<| .form - (<>.after (.this_text "lux def program")) - .any)]) - (in (list actual_program)))) - (def .public test Test (<| (_.covering /._) (do random.monad [inputs (random.list 5 (random.upper_case 5))] (all _.and - (_.coverage [/.program:] + (_.coverage [/.program] (let [(open "list#[0]") (list.equivalence text.equivalence)] - (and (with_expansions [ (/.program: all_arguments - (io.io all_arguments))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (same? (is Any inputs) - (io.run! outcome)))) - (with_expansions [ (/.program: [arg/0 \\parser.any - arg/1 \\parser.any - arg/2 \\parser.any - arg/3 \\parser.any - arg/4 \\parser.any] - (io.io (list arg/4 arg/3 arg/2 arg/1 arg/0)))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (list#= (list.reversed inputs) - (as (List Text) (io.run! outcome))))) - (with_expansions [ (/.program: [all_arguments (<>.many \\parser.any)] - (io.io all_arguments))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (list#= inputs - (as (List Text) (io.run! outcome))))) - (with_expansions [ (/.program: [arg/0 \\parser.any - arg/1 \\parser.any - arg/2 \\parser.any - arg/3 \\parser.any] - (io.io []))] - (case (try ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)) - {try.#Success _} - false - - {try.#Failure _} - true))))) + (and (let [outcome ((is /.Program + (/.program all_arguments + (io.io all_arguments))) + inputs)] + (same? (is Any inputs) + (io.run! outcome))) + (let [outcome ((is /.Program + (/.program [arg/0 \\parser.any + arg/1 \\parser.any + arg/2 \\parser.any + arg/3 \\parser.any + arg/4 \\parser.any] + (io.io (list arg/4 arg/3 arg/2 arg/1 arg/0)))) + inputs)] + (list#= (list.reversed inputs) + (as (List Text) (io.run! outcome)))) + (let [outcome ((is /.Program + (/.program [all_arguments (<>.many \\parser.any)] + (io.io all_arguments))) + inputs)] + (list#= inputs + (as (List Text) (io.run! outcome)))) + (case (try ((is /.Program + (/.program [arg/0 \\parser.any + arg/1 \\parser.any + arg/2 \\parser.any + arg/3 \\parser.any] + (io.io []))) + inputs)) + {try.#Success _} + false + + {try.#Failure _} + true)))) ..\\parser )))) -- cgit v1.2.3