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. --- .../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 +++--- 6 files changed, 144 insertions(+), 157 deletions(-) (limited to 'stdlib/source/library') 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))))))))))))))) -- cgit v1.2.3