From 99361f07e4dd5724611e13a91ba8f14f039cdf0c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 17 Feb 2022 04:41:44 -0400 Subject: Finishing the meta-compiler [Part 3] --- stdlib/source/library/lux/target/python.lux | 12 +- .../library/lux/tool/compiler/default/platform.lux | 119 ++++++++------- .../lux/phase/generation/common_lisp/loop.lux | 1 + .../language/lux/phase/generation/php/loop.lux | 2 + .../tool/compiler/meta/archive/module/document.lux | 16 ++- .../library/lux/tool/compiler/meta/context.lux | 31 ++++ .../library/lux/tool/compiler/meta/io/archive.lux | 160 ++++++++++----------- .../lux/tool/compiler/meta/packager/jvm.lux | 12 +- stdlib/source/program/compositor.lux | 20 ++- stdlib/source/program/compositor/static.lux | 13 -- stdlib/source/test/lux/target/python.lux | 107 ++++++++++++-- stdlib/source/test/lux/tool.lux | 4 +- .../source/test/lux/tool/compiler/meta/context.lux | 45 ++++++ 13 files changed, 348 insertions(+), 194 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/meta/context.lux delete mode 100644 stdlib/source/program/compositor/static.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/context.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 3b2b4bcf7..b574b6688 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -211,13 +211,13 @@ ) (def: .public (slice from to list) - (-> (Expression Any) (Expression Any) (Expression Any) Access) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) (<| :abstraction ... ..expression (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) (def: .public (slice_from from list) - (-> (Expression Any) (Expression Any) Access) + (-> (Expression Any) (Expression Any) (Computation Any)) (<| :abstraction ... ..expression (format (:representation list) "[" (:representation from) ":]"))) @@ -247,7 +247,7 @@ ) (def: .public (the name object) - (-> Text (Expression Any) (Computation Any)) + (-> Text (Expression Any) Access) (:abstraction (format (:representation object) "." name))) (def: .public (do method args object) @@ -255,7 +255,7 @@ (..apply/* (..the method object) args)) (def: .public (item idx array) - (-> (Expression Any) (Expression Any) Location) + (-> (Expression Any) (Expression Any) Access) (:abstraction (format (:representation array) "[" (:representation idx) "]"))) (def: .public (? test then else) @@ -415,8 +415,8 @@ [print "print" ..expression] ) - (def: .public (exec code globals) - (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) + (def: .public (exec globals code) + (-> (Maybe (Expression Any)) (Expression Any) (Statement Any)) (let [extra (case globals {.#Some globals} (.list globals) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index f13ffecd2..57c18e4e1 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -42,16 +42,17 @@ ["$" /] ["[1][0]" version] ["[0]" syntax] - ["[1][0]" analysis - [macro {"+" Expander}] - ["[0]A" module]] ["[1][0]" synthesis] ["[1][0]" generation {"+" Buffer}] ["[1][0]" directive] + ["[1][0]" analysis + [macro {"+" Expander}] + ["[0]A" module]] [phase ["[0]" extension {"+" Extender}]]]] [meta [import {"+" Import}] + ["[0]" context {"+" Context}] [cli {"+" Compilation Library} ["[0]" compiler {"+" Compiler}]] ["[0]" archive {"+" Output Archive} @@ -60,12 +61,10 @@ ["[0]" module ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]]] - [io {"+" Context} - ["[0]" context] - ["ioW" archive]]]]] - [program - [compositor - ["[0]" static {"+" Static}]]]) + ["[0]" io "_" + ["_[1]" /] + ["[1]" context] + ["ioW" archive]]]]]) (with_expansions [ (as_is anchor expression directive) (as_is ///generation.Operation )] @@ -101,16 +100,16 @@ registry.writer )) - (def: (cache_module static platform module_id entry) + (def: (cache_module context platform module_id entry) (All (_ ) - (-> Static module.ID (archive.Entry Any) + (-> Context module.ID (archive.Entry Any) (Async (Try Any)))) (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) (function (_ [artifact_id custom content]) - (ioW.write system static module_id artifact_id content)))] + (ioW.write system context module_id artifact_id content)))] (do [! ..monad] - [_ (ioW.prepare system static module_id) + [_ (ioW.prepare system context module_id) _ (for [@.python (|> entry (value@ archive.#output) sequence.list @@ -129,7 +128,7 @@ (with@ module.#document document)) (value@ archive.#registry entry)] (_.result ..writer) - (ioW.cache system static module_id))))) + (ioW.cache system context module_id))))) ... TODO: Inline ASAP (def: initialize_buffer! @@ -239,10 +238,10 @@ generators (dictionary.merged directives (host_directive_bundle phase_wrapper))]) - (def: .public (initialize static module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + (def: .public (initialize context module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender import compilation_sources) (All (_ ) - (-> Static + (-> Context descriptor.Module Expander ///analysis.Bundle @@ -251,18 +250,18 @@ (-> ///phase.Wrapper (///directive.Bundle )) (Program expression directive) [Type Type Type] (-> ///phase.Wrapper Extender) - Import (List Context) + Import (List _io.Context) (Async (Try [ Archive ///phase.Wrapper])))) (do [! (try.with async.monad)] - [.let [state (//init.state (value@ static.#host static) + [.let [state (//init.state (value@ context.#host context) module expander host_analysis (value@ #host platform) (value@ #phase platform) generation_bundle)] - _ (ioW.enable (value@ #&file_system platform) static) - [archive analysis_state bundles] (ioW.thaw (value@ #host platform) (value@ #&file_system platform) static import compilation_sources) + _ (ioW.enable (value@ #&file_system platform) context) + [archive analysis_state bundles] (ioW.thaw (value@ #host platform) (value@ #&file_system platform) context import compilation_sources) .let [with_missing_extensions (: (All (_ ) (-> (Program expression directive) @@ -285,7 +284,7 @@ [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.result' state) async#in) - _ (..cache_module static platform 0 payload) + _ (..cache_module context platform 0 payload) [phase_wrapper state] (with_missing_extensions platform program state)] (in [state archive phase_wrapper]))))) @@ -660,18 +659,18 @@ (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (value@ #write platform))] (instancer $.key (list)))) - (def: (serial_compiler import static platform compilation_sources compiler) + (def: (serial_compiler import context platform compilation_sources compiler) (All (_ ) - (-> Import Static (List Context) (///.Compiler .Module Any) + (-> Import Context (List _io.Context) (///.Compiler .Module Any) )) (function (_ importer import! module_id [archive state] module) (do [! (try.with async.monad)] - [input (context.read (value@ #&file_system platform) - importer - import - compilation_sources - (value@ static.#host_module_extension static) - module)] + [input (io.read (value@ #&file_system platform) + importer + import + compilation_sources + (value@ context.#host_module_extension context) + module)] (loop [[archive state] [archive (..set_current_module module state)] compilation (compiler input) all_dependencies (: (Set descriptor.Module) @@ -705,7 +704,7 @@ (console.write_line report console))] ))) .let [entry (with@ [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] - _ (..cache_module static platform module_id entry)] + _ (..cache_module context platform module_id entry)] (case (archive.has module entry archive) {try.#Success archive} (in [archive @@ -716,7 +715,7 @@ {try.#Failure error} (do ! - [_ (ioW.freeze (value@ #&file_system platform) static archive)] + [_ (ioW.freeze (value@ #&file_system platform) context archive)] (async#in {try.#Failure error})))))))) (exception: .public (invalid_custom_compiler [definition Symbol @@ -726,35 +725,45 @@ ["Expected Type" (%.type ///.Custom)] ["Actual Type" (%.type type)])) - (def: .public (compile phase_wrapper import static expander platform compilation context) + (def: (custom_compiler importer it) + (All (_ ) + (-> Compiler (Async (Try [ (List Text) ///.Custom])))) + (let [/#definition (value@ compiler.#definition it) + [/#module /#name] /#definition] + (do ..monad + [context (importer descriptor.runtime /#module) + .let [[archive state] context + meta_state (value@ [extension.#state + ///directive.#analysis + ///directive.#state + extension.#state] + state)] + [_ /#type /#value] (|> /#definition + meta.export + (meta.result meta_state) + async#in)] + (async#in (if (check.subsumes? ///.Custom /#type) + (|> /#value + (:as ///.Custom) + [context (value@ compiler.#parameters it)] + {try.#Success}) + (exception.except ..invalid_custom_compiler [/#definition /#type])))))) + + (def: .public (compile phase_wrapper import file_context expander platform compilation context) (All (_ ) - (-> ///phase.Wrapper Import Static Expander Compilation )) + (-> ///phase.Wrapper Import Context Expander Compilation )) (let [[host_dependencies libraries compilers sources target module] compilation - compiler (|> (..compiler phase_wrapper expander platform) - (serial_compiler import static platform sources) + importer (|> (..compiler phase_wrapper expander platform) + (serial_compiler import file_context platform sources) (..parallel context))] (do [! ..monad] [customs (|> compilers (list#each (function (_ it) - (let [/#definition (value@ compiler.#definition it) - [/#module /#name] /#definition - /#parameters (value@ compiler.#parameters it)] - (do ! - [[archive state] (compiler descriptor.runtime /#module) - .let [meta_state (value@ [extension.#state - ///directive.#analysis - ///directive.#state - extension.#state] - state)] - [_ /#type /#value] (|> /#definition - meta.export - (meta.result meta_state) - async#in)] - (async#in (if (check.subsumes? ///.Custom /#type) - (|> /#value - (:as ///.Custom) - (function.on /#parameters)) - (exception.except ..invalid_custom_compiler [/#definition /#type]))))))) + (do ! + [[context parameters custom] (custom_compiler importer it)] + (async#in (|> custom + (:as ///.Custom) + (function.on parameters)))))) (monad.all !))] - (compiler descriptor.runtime module)))) + (importer descriptor.runtime module)))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux index 2354ed15c..acbab199d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux @@ -47,6 +47,7 @@ initsG+ (monad.each ! (expression archive) initsS+) bodyG (/////generation.with_anchor [@scope start] (expression archive bodyS))] + ... TODO: There is a bug in the way the variables are updated. Do a _.multiple_value_setq instead. (in (_.let (|> initsG+ list.enumeration (list#each (function (_ [idx init]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index fdc5d3cf4..7fc0e8c4d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -39,6 +39,7 @@ (def: (setup offset bindings body) (-> Register (List Expression) Statement Statement) + ... TODO: There is a bug in the way the variables are updated. Do it like it's done in either JS or Lua. (|> bindings list.enumeration (list#each (function (_ [register value]) @@ -104,6 +105,7 @@ _ (/////generation.save! loop_artifact directive)] (in (_.apply/* (list) instantiation))))) +... TODO: Stop using a constant hard-coded variable. Generate a new one each time. (def: @temp (_.var "lux_again_values")) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux index b3be41585..144895928 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux @@ -16,7 +16,7 @@ [type {"+" :sharing} abstract]]] [/// - ["[0]" signature {"+" Signature}] + ["[0]" signature {"+" Signature} ("[1]#[0]" equivalence)] ["[0]" key {"+" Key}]]) (exception: .public (invalid_signature [expected Signature @@ -67,8 +67,14 @@ content)] (|>> :representation writer))) - (def: .public parser - (All (_ d) (-> (Parser d) (Parser (Document d)))) - (|>> (<>.and signature.parser) - (# <>.monad each (|>> :abstraction)))) + (def: .public (parser key it) + (All (_ d) (-> (Key d) (Parser d) (Parser (Document d)))) + (do <>.monad + [actual signature.parser + .let [expected (key.signature key)] + _ (if (signature#= expected actual) + (in []) + (<>.lifted (exception.except ..invalid_signature [expected actual]))) + it it] + (in (:abstraction [actual it])))) ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/context.lux b/stdlib/source/library/lux/tool/compiler/meta/context.lux new file mode 100644 index 000000000..8ee5e28a0 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/context.lux @@ -0,0 +1,31 @@ +(.using + [library + [lux "*" + ["@" target {"+" Target}] + [world + [file {"+" Path}]]]]) + +(type: .public Extension + Text) + +(type: .public Context + (Record + [#host Target + #host_module_extension Extension + #target Path + #artifact_extension Extension])) + +(template [ ] + [(def: .public ( target) + (-> Path Context) + [#host + #host_module_extension + #target target + #artifact_extension ])] + + [jvm @.jvm ".jvm" ".class"] + [js @.js ".js" ".js"] + [lua @.lua ".lua" ".lua"] + [python @.python ".py" ".py"] + [ruby @.ruby ".rb" ".rb"] + ) 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 b9b99208f..515e3ff09 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -28,13 +28,11 @@ ["n" nat]]] [world ["[0]" file]]]] - [program - [compositor - ["[0]" static {"+" Static}]]] - ["[0]" // {"+" Context} + ["[0]" // ["[1][0]" context] ["/[1]" // [import {"+" Import}] + ["[0]" context {"+" Context}] ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] ["[0]" unit] @@ -63,36 +61,36 @@ ["Module ID" (%.nat module_id)] ["Error" error])) -(def: (archive fs static) - (All (_ !) (-> (file.System !) Static file.Path)) - (format (value@ static.#target static) +(def: (archive fs context) + (All (_ !) (-> (file.System !) Context file.Path)) + (format (value@ context.#target context) (# fs separator) - (value@ static.#host static))) + (value@ context.#host context))) -(def: (unversioned_lux_archive fs static) - (All (_ !) (-> (file.System !) Static file.Path)) - (format (..archive fs static) +(def: (unversioned_lux_archive fs context) + (All (_ !) (-> (file.System !) Context file.Path)) + (format (..archive fs context) (# fs separator) //.lux_context)) -(def: (versioned_lux_archive fs static) - (All (_ !) (-> (file.System !) Static file.Path)) - (format (..unversioned_lux_archive fs static) +(def: (versioned_lux_archive fs context) + (All (_ !) (-> (file.System !) Context file.Path)) + (format (..unversioned_lux_archive fs context) (# fs separator) (%.nat version.version))) -(def: (module fs static module_id) - (All (_ !) (-> (file.System !) Static module.ID file.Path)) - (format (..versioned_lux_archive fs static) +(def: (module fs context module_id) + (All (_ !) (-> (file.System !) Context module.ID file.Path)) + (format (..versioned_lux_archive fs context) (# fs separator) (%.nat module_id))) -(def: .public (artifact fs static module_id artifact_id) - (All (_ !) (-> (file.System !) Static module.ID artifact.ID file.Path)) - (format (..module fs static module_id) +(def: .public (artifact fs context module_id artifact_id) + (All (_ !) (-> (file.System !) Context module.ID artifact.ID file.Path)) + (format (..module fs context module_id) (# fs separator) (%.nat artifact_id) - (value@ static.#artifact_extension static))) + (value@ context.#artifact_extension context))) (def: (ensure_directory fs path) (-> (file.System Async) file.Path (Async (Try Any))) @@ -102,69 +100,69 @@ (in {try.#Success []}) (# fs make_directory path)))) -(def: .public (prepare fs static module_id) - (-> (file.System Async) Static module.ID (Async (Try Any))) +(def: .public (prepare fs context module_id) + (-> (file.System Async) Context module.ID (Async (Try Any))) (do [! async.monad] - [.let [module (..module fs static module_id)] + [.let [module (..module fs context module_id)] module_exists? (# fs directory? module)] (if module_exists? (in {try.#Success []}) (do (try.with !) - [_ (ensure_directory fs (..unversioned_lux_archive fs static)) - _ (ensure_directory fs (..versioned_lux_archive fs static))] + [_ (ensure_directory fs (..unversioned_lux_archive fs context)) + _ (ensure_directory fs (..versioned_lux_archive fs context))] (|> module (# fs make_directory) (# ! each (|>> (case> {try.#Success output} {try.#Success []} {try.#Failure error} - (exception.except ..cannot_prepare [(..archive fs static) + (exception.except ..cannot_prepare [(..archive fs context) module_id error]))))))))) -(def: .public (write fs static module_id artifact_id content) - (-> (file.System Async) Static module.ID artifact.ID Binary (Async (Try Any))) - (# fs write content (..artifact fs static module_id artifact_id))) +(def: .public (write fs context module_id artifact_id content) + (-> (file.System Async) Context module.ID artifact.ID Binary (Async (Try Any))) + (# fs write content (..artifact fs context module_id artifact_id))) -(def: .public (enable fs static) - (-> (file.System Async) Static (Async (Try Any))) +(def: .public (enable fs context) + (-> (file.System Async) Context (Async (Try Any))) (do (try.with async.monad) - [_ (..ensure_directory fs (value@ static.#target static))] - (..ensure_directory fs (..archive fs static)))) + [_ (..ensure_directory fs (value@ context.#target context))] + (..ensure_directory fs (..archive fs context)))) -(def: (general_descriptor fs static) - (-> (file.System Async) Static file.Path) - (format (..archive fs static) +(def: (general_descriptor fs context) + (-> (file.System Async) Context file.Path) + (format (..archive fs context) (# fs separator) "general_descriptor")) -(def: .public (freeze fs static archive) - (-> (file.System Async) Static Archive (Async (Try Any))) - (# fs write (archive.export ///.version archive) (..general_descriptor fs static))) +(def: .public (freeze fs context archive) + (-> (file.System Async) Context Archive (Async (Try Any))) + (# fs write (archive.export ///.version archive) (..general_descriptor fs context))) (def: module_descriptor_file "module_descriptor") -(def: (module_descriptor fs static module_id) - (-> (file.System Async) Static module.ID file.Path) - (format (..module fs static module_id) +(def: (module_descriptor fs context module_id) + (-> (file.System Async) Context module.ID file.Path) + (format (..module fs context module_id) (# fs separator) ..module_descriptor_file)) -(def: .public (cache fs static module_id content) - (-> (file.System Async) Static module.ID Binary (Async (Try Any))) - (# fs write content (..module_descriptor fs static module_id))) +(def: .public (cache fs context module_id content) + (-> (file.System Async) Context module.ID Binary (Async (Try Any))) + (# fs write content (..module_descriptor fs context module_id))) -(def: (read_module_descriptor fs static module_id) - (-> (file.System Async) Static module.ID (Async (Try Binary))) - (# fs read (..module_descriptor fs static module_id))) +(def: (read_module_descriptor fs context module_id) + (-> (file.System Async) Context module.ID (Async (Try Binary))) + (# fs read (..module_descriptor fs context module_id))) (def: module_parser (Parser (module.Module .Module)) ($_ <>.and .nat descriptor.parser - (document.parser $.parser))) + (document.parser $.key $.parser))) (def: parser (Parser [(module.Module .Module) Registry]) @@ -190,10 +188,10 @@ (archive.archived archive)))] (in (with@ .#modules modules (fresh_analysis_state host))))) -(def: (cached_artifacts fs static module_id) - (-> (file.System Async) Static module.ID (Async (Try (Dictionary Text Binary)))) +(def: (cached_artifacts fs context module_id) + (-> (file.System Async) Context module.ID (Async (Try (Dictionary Text Binary)))) (let [! (try.with async.monad)] - (|> (..module fs static module_id) + (|> (..module fs context module_id) (# fs directory_files) (# ! each (|>> (list#each (function (_ file) [(file.name fs file) file])) @@ -362,26 +360,26 @@ (in [(document.document $.key (with@ .#definitions definitions content)) bundles]))) -(def: (load_definitions fs static module_id host_environment entry) +(def: (load_definitions fs context module_id host_environment entry) (All (_ expression directive) - (-> (file.System Async) Static module.ID (generation.Host expression directive) + (-> (file.System Async) Context module.ID (generation.Host expression directive) (archive.Entry .Module) (Async (Try [(archive.Entry .Module) Bundles])))) (do (try.with async.monad) - [actual (cached_artifacts fs static module_id) + [actual (cached_artifacts fs context module_id) .let [expected (registry.artifacts (value@ archive.#registry entry))] [document bundles output] (|> (value@ [archive.#module module.#document] entry) - (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual) + (loaded_document (value@ context.#artifact_extension context) host_environment module_id expected actual) async#in)] (in [(|> entry (with@ [archive.#module module.#document] document) (with@ archive.#output output)) bundles]))) -(def: (purge! fs static [module_name module_id]) - (-> (file.System Async) Static [descriptor.Module module.ID] (Async (Try Any))) +(def: (purge! fs context [module_name module_id]) + (-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any))) (do [! (try.with async.monad)] - [.let [cache (..module fs static module_id)] + [.let [cache (..module fs context module_id)] _ (|> cache (# fs directory_files) (# ! each (monad.each ! (# fs delete))) @@ -434,29 +432,29 @@ Text "(Lux Caching System)") -(def: (valid_cache fs static import contexts [module_name module_id]) - (-> (file.System Async) Static Import (List Context) +(def: (valid_cache fs context import contexts [module_name module_id]) + (-> (file.System Async) Context Import (List //.Context) [descriptor.Module module.ID] (Async (Try [Bit Cache]))) (with_expansions [ [module_name [module_id [module registry]]]] (do [! (try.with async.monad)] - [data (..read_module_descriptor fs static module_id) + [data (..read_module_descriptor fs context module_id) [module registry] (async#in (.result ..parser data))] (if (text#= descriptor.runtime module_name) (in [true ]) (do ! - [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)] + [input (//context.read fs ..pseudo_module import contexts (value@ context.#host_module_extension context) module_name)] (in [(..valid_cache? (value@ module.#descriptor module) input) ])))))) -(def: (pre_loaded_caches fs static import contexts archive) - (-> (file.System Async) Static Import (List Context) Archive +(def: (pre_loaded_caches fs context import contexts archive) + (-> (file.System Async) Context Import (List //.Context) Archive (Async (Try (List [Bit Cache])))) (do [! (try.with async.monad)] [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. it (|> archive archive.reservations (monad.each ! - (..valid_cache fs static import contexts)))] + (..valid_cache fs context import contexts)))] (in it))) (def: (load_order archive pre_loaded_caches) @@ -474,9 +472,9 @@ (# try.monad each (cache/module.load_order $.key)) (# try.monad conjoint))) -(def: (loaded_caches host_environment fs static purge load_order) +(def: (loaded_caches host_environment fs context purge load_order) (All (_ expression directive) - (-> (generation.Host expression directive) (file.System Async) Static + (-> (generation.Host expression directive) (file.System Async) Context Purge (cache/module.Order .Module) (Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles]))))) (do [! (try.with async.monad)] @@ -485,23 +483,23 @@ (list.only (|>> product.left (dictionary.key? purge) not)) (monad.each ! (function (_ [module_name [module_id entry]]) (do ! - [[entry bundles] (..load_definitions fs static module_id host_environment entry)] + [[entry bundles] (..load_definitions fs context module_id host_environment entry)] (in [[module_name entry] bundles])))))] (in it))) -(def: (load_every_reserved_module host_environment fs static import contexts archive) +(def: (load_every_reserved_module host_environment fs context import contexts archive) (All (_ expression directive) - (-> (generation.Host expression directive) (file.System Async) Static Import (List Context) Archive + (-> (generation.Host expression directive) (file.System Async) Context Import (List //.Context) Archive (Async (Try [Archive .Lux Bundles])))) (do [! (try.with async.monad)] - [pre_loaded_caches (..pre_loaded_caches fs static import contexts archive) + [pre_loaded_caches (..pre_loaded_caches fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) .let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries - (monad.each ! (..purge! fs static))) - loaded_caches (..loaded_caches host_environment fs static purge load_order)] + (monad.each ! (..purge! fs context))) + loaded_caches (..loaded_caches host_environment fs context purge load_order)] (async#in (do [! try.monad] [archive (monad.mix ! @@ -509,7 +507,7 @@ (archive.has module entry archive)) archive loaded_caches) - analysis_state (..analysis_state (value@ static.#host static) archive)] + analysis_state (..analysis_state (value@ context.#host context) archive)] (in [archive analysis_state (list#mix (function (_ [_ [+analysers +synthesizers +generators +directives]] @@ -521,19 +519,19 @@ ..empty_bundles loaded_caches)]))))) -(def: .public (thaw host_environment fs static import contexts) +(def: .public (thaw host_environment fs context import contexts) (All (_ expression directive) - (-> (generation.Host expression directive) (file.System Async) Static Import (List Context) + (-> (generation.Host expression directive) (file.System Async) Context Import (List //.Context) (Async (Try [Archive .Lux Bundles])))) (do async.monad - [binary (# fs read (..general_descriptor fs static))] + [binary (# fs read (..general_descriptor fs context))] (case binary {try.#Success binary} (do (try.with async.monad) [archive (async#in (archive.import ///.version binary))] - (..load_every_reserved_module host_environment fs static import contexts archive)) + (..load_every_reserved_module host_environment fs context import contexts archive)) {try.#Failure error} (in {try.#Success [archive.empty - (fresh_analysis_state (value@ static.#host static)) + (fresh_analysis_state (value@ context.#host context)) ..empty_bundles]})))) 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 f6af3d365..7f672fd92 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -26,11 +26,9 @@ ["[0]" name]]]] [world ["[0]" file]]]] - [program - [compositor - ["[0]" static {"+" Static}]]] ["[0]" // {"+" Packager} [// + ["[0]" context {"+" Context}] ["[0]" archive {"+" Output} ["[0]" artifact] ["[0]" unit] @@ -140,13 +138,13 @@ manifest))) (def: (write_class static module artifact custom content sink) - (-> Static module.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream + (-> Context module.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream (Try java/util/jar/JarOutputStream)) (let [class_path (|> custom (maybe#each (|>> name.internal name.read)) (maybe.else (runtime.class_name [module artifact])) (text.replaced "." "/") - (text.suffix (value@ static.#artifact_extension static)))] + (text.suffix (value@ context.#artifact_extension static)))] (do try.monad [_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)] (in (do_to sink @@ -155,7 +153,7 @@ (java/util/zip/ZipOutputStream::closeEntry)))))) (def: (write_module static necessary_dependencies [module output] sink) - (-> Static (Set unit.ID) [module.ID Output] java/util/jar/JarOutputStream + (-> Context (Set unit.ID) [module.ID Output] java/util/jar/JarOutputStream (Try java/util/jar/JarOutputStream)) (let [! try.monad] (monad.mix try.monad @@ -251,7 +249,7 @@ sink)))))))) (def: .public (package static) - (-> Static Packager) + (-> Context Packager) (function (_ host_dependencies archive program) (do [! try.monad] [.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index b398f85e3..7df24358b 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -42,6 +42,7 @@ [extension {"+" Extender}]]]] [meta [packager {"+" Packager}] + [context {"+" Context}] ["[0]" cli {"+" Service}] ["[0]" import] ["[0]" export] @@ -52,9 +53,7 @@ [io ["ioW" archive]]]] ... ["[0]" interpreter] - ]]] - ["[0]" / "_" - ["[1][0]" static {"+" Static}]]) + ]]]) (def: (or_crash! failure_description action) (All (_ a) @@ -92,8 +91,8 @@ (format "Duration: ")))]] (in output))) -(def: (package! fs host_dependencies [packager package] static archive context) - (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Static Archive unit.ID (Async (Try Any))) +(def: (package! fs host_dependencies [packager package] archive context) + (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Archive unit.ID (Async (Try Any))) (case (packager host_dependencies archive context) {try.#Success content} (case content @@ -129,12 +128,12 @@ (dictionary.has head content output))))))) (with_expansions [ (as_is anchor expression artifact)] - (def: .public (compiler static + (def: .public (compiler file_context expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender service packager,package) (All (_ ) - (-> Static + (-> Context Expander analysis.Bundle (IO (Platform )) @@ -162,15 +161,15 @@ (Async (Try [(directive.State+ ) Archive phase.Wrapper])) - (:expected (platform.initialize static compilation_module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + (:expected (platform.initialize file_context compilation_module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender import compilation_sources))) [archive state] (:sharing [] (Platform ) platform (Async (Try [Archive (directive.State+ )])) - (:expected (platform.compile phase_wrapper import static expander platform compilation [archive state]))) - _ (ioW.freeze (value@ platform.#&file_system platform) static archive) + (:expected (platform.compile phase_wrapper import file_context expander platform compilation [archive state]))) + _ (ioW.freeze (value@ platform.#&file_system platform) file_context archive) program_context (async#in ($/program.context archive)) host_dependencies (..load_host_dependencies (value@ platform.#&file_system platform) compilation_host_dependencies) _ (..package! (for [@.old (file.async file.default) @@ -180,7 +179,6 @@ @.js (maybe.trusted file.default)]) host_dependencies packager,package - static archive program_context)] (in (debug.log! "Compilation complete!")))) diff --git a/stdlib/source/program/compositor/static.lux b/stdlib/source/program/compositor/static.lux deleted file mode 100644 index 840bd3448..000000000 --- a/stdlib/source/program/compositor/static.lux +++ /dev/null @@ -1,13 +0,0 @@ -(.using - [library - [lux "*" - [target {"+" Target}] - [world - [file {"+" Path}]]]]) - -(type: .public Static - (Record - [#host Target - #host_module_extension Text - #target Path - #artifact_extension Text])) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index 45eae7e38..3908f9d3c 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -1,8 +1,9 @@ (.using [library - [lux "*" + [lux {"-" exec} ["_" test {"+" Test}] ["[0]" ffi] + ["[0]" static] [abstract [monad {"+" do}] ["[0]" predicate] @@ -10,6 +11,7 @@ ["$[0]" equivalence] ["$[0]" hash]]] [control + [pipe {"+" case>}] ["[0]" function] ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try} ("[1]#[0]" functor)]] @@ -19,6 +21,8 @@ ["%" format {"+" format}]] [collection ["[0]" list ("[1]#[0]" functor)]]] + [macro + ["[0]" code]] ["[0]" math ["[0]" random {"+" Random} ("[1]#[0]" monad)] [number @@ -27,7 +31,7 @@ ["f" frac] ["[0]" i64]]]]] [\\library - ["[0]" /]]) + ["[0]" / ("[1]#[0]" equivalence)]]) (ffi.import: (eval [Text] "try" "?" Any)) @@ -46,7 +50,7 @@ [bool random.bit float random.frac int random.int - string (random.ascii/upper 5)] + string (random.ascii/upper 1)] ($_ _.and (_.cover [/.none] (|> /.none @@ -257,7 +261,9 @@ float (random.only (|>> f.not_a_number? not) random.frac) string (random.ascii/upper 5) - comment (random.ascii/upper 10)] + comment (random.ascii/upper 10) + $arg/0 (# ! each /.var (random.ascii/lower 10)) + $arg/1 (# ! each /.var (random.ascii/lower 11))] ($_ _.and ..test|bool ..test|float @@ -282,6 +288,16 @@ (expression (|>> (:as Frac) (f.= (math.ceil float))) (|> (/.__import__/1 (/.string "math")) (/.do "ceil" (list (/.float float)))))) + (_.cover [/.is] + (and (expression (|>> (:as Bit)) + (/.apply/* (/.lambda (list $arg/0) + (/.is $arg/0 $arg/0)) + (list (/.string (format string string))))) + (expression (|>> (:as Bit) not) + (/.apply/* (/.lambda (list $arg/0 $arg/1) + (/.is $arg/0 (/.+ $arg/1 $arg/1))) + (list (/.string (format string string)) + (/.string string)))))) ))) (def: test|function @@ -344,13 +360,24 @@ (expression (|>> (:as Frac) (f.= expected/0)) (/.apply/* (/.lambda (list $var) $var) (list (/.float expected/0))))) - (_.cover [/.Poly /.PVar /.poly] - (expression (|>> (:as Frac) (f.= expected/?)) - (/.apply/* (/.lambda (list $choice (/.poly $var)) - (/.item $choice $var)) - (list (/.int (.int poly_choice)) - (/.float expected/0) - (/.float expected/1))))) + (_.for [/.Poly /.PVar] + ($_ _.and + (_.cover [/.poly] + (expression (|>> (:as Frac) (f.= expected/?)) + (/.apply/* (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var)) + (list (/.int (.int poly_choice)) + (/.float expected/0) + (/.float expected/1))))) + (_.cover [/.splat_poly] + (expression (|>> (:as Frac) (f.= expected/?)) + (/.apply/* (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var)) + (list (/.int (.int poly_choice)) + (/.splat_poly + (/.list (list (/.float expected/0) + (/.float expected/1)))))))) + )) (_.for [/.Keyword /.KVar] ($_ _.and (_.cover [/.keyword] @@ -387,18 +414,68 @@ ..test|var) )))) +(ffi.import: Dict + ["[1]::[0]" + (get [ffi.String] Any)]) + +(ffi.import: (dict [] ..Dict)) + +(def: (statement it) + (-> (-> /.SVar (/.Statement Any)) Any) + (let [$output (static.random (|>> %.nat (format "output_") code.text) + random.nat) + environment (..dict [])] + (.exec + ("python exec" (/.code (it (/.var $output))) (:expected environment)) + (Dict::get [$output] environment)))) + +(def: test|statement + Test + (do [! random.monad] + [prefix (# ! each (|>> %.nat (text.enclosed ["def_" "_"])) random.nat) + $input/0 (# ! each (|>> %.nat (format "input_") /.var) random.nat) + expected/0 random.safe_frac + .let [def (: (-> Nat /.SVar) + (|>> %.nat (format prefix) /.var))]] + ($_ _.and + (_.cover [/.def] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.def (def 0) (list $input/0) (/.return $input/0)) + (/.set (list $output) + (/.apply/* (def 0) (list (/.float expected/0))))))) + (:as Frac) + (f.= expected/0))) + ))) + +(def: random_expression + (Random /.Literal) + ($_ random.either + (random#each /.bool random.bit) + (random#each /.float random.frac) + (random#each /.int random.int) + (random#each /.string (random.ascii/lower 1)) + )) + (def: .public test Test (do [! random.monad] - [.let [random (# ! each /.int random.int)]] + [expected ..random_expression] (<| (_.covering /._) - (_.for [/.Code /.code]) + (_.for [/.Code]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence random)) + ($equivalence.spec /.equivalence ..random_expression)) (_.for [/.hash] - ($hash.spec /.hash random)) + ($hash.spec /.hash ..random_expression)) + (_.cover [/.code /.manual] + (|> (/.manual (/.code expected)) + (: /.Expression) + (/#= expected))) (_.for [/.Expression] ..test|expression) + (_.for [/.Statement] + ..test|statement) )))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 8c154b3a0..07824362b 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -25,7 +25,8 @@ ["[1]/[0]" archive] ["[1]/[0]" cli] ["[1]/[0]" export] - ["[1]/[0]" import]] + ["[1]/[0]" import] + ["[1]/[0]" context]] ]]) (def: .public test @@ -40,6 +41,7 @@ /meta/cli.test /meta/export.test /meta/import.test + /meta/context.test /phase/extension.test /phase/analysis/simple.test /phase/analysis/complex.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/context.lux b/stdlib/source/test/lux/tool/compiler/meta/context.lux new file mode 100644 index 000000000..382bd12d6 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/context.lux @@ -0,0 +1,45 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text] + [collection + ["[0]" set] + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Context /.Extension]) + (do [! random.monad] + [target (random.ascii/lower 1)] + ($_ _.and + (_.cover [/.js /.jvm /.lua /.python /.ruby] + (let [contexts (list (/.js target) + (/.jvm target) + (/.lua target) + (/.python target) + (/.ruby target)) + maximum (list.size contexts)] + (`` (and (~~ (template [ ] + [(|> contexts + (list#each (value@ )) + (set.of_list text.hash) + set.size + (n.= ))] + + [maximum /.#host] + [maximum /.#host_module_extension] + [maximum /.#artifact_extension] + [1 /.#target] + )))))) + )))) -- cgit v1.2.3