From bf0562d72b7d42be2b378a7f312fe48ac1f4284c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 8 Mar 2022 05:06:57 -0400 Subject: Finishing the meta-compiler [Part 6 / Done... for now] --- stdlib/source/library/lux/data/sum.lux | 20 +- stdlib/source/library/lux/tool/compiler.lux | 16 +- .../library/lux/tool/compiler/default/platform.lux | 346 ++++++++++++++------- .../language/lux/phase/extension/analysis/jvm.lux | 4 +- .../lux/phase/extension/generation/jvm/host.lux | 48 +-- .../language/lux/phase/generation/jvm/case.lux | 3 +- .../language/lux/phase/generation/python/case.lux | 3 +- .../compiler/language/lux/phase/synthesis/case.lux | 25 +- .../language/lux/phase/synthesis/variable.lux | 9 +- .../lux/tool/compiler/language/lux/synthesis.lux | 60 +--- .../compiler/language/lux/synthesis/access.lux | 38 +++ .../language/lux/synthesis/access/member.lux | 34 ++ .../language/lux/synthesis/access/side.lux | 34 ++ .../compiler/language/lux/synthesis/member.lux | 34 -- .../tool/compiler/language/lux/synthesis/side.lux | 34 -- .../library/lux/tool/compiler/meta/io/archive.lux | 58 ++-- 16 files changed, 458 insertions(+), 308 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux index ce9003cb6..8d3fe4fc0 100644 --- a/stdlib/source/library/lux/data/sum.lux +++ b/stdlib/source/library/lux/data/sum.lux @@ -1,9 +1,9 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}]]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]]]]) (template [ ] [(def: .public ( value) @@ -82,9 +82,9 @@ (..equivalence (# left &equivalence) (# right &equivalence))) (def: (hash value) - (case value - {.#Left value} - (# left hash value) + (.nat (case value + {.#Left value} + ("lux i64 *" +2 (.int (# left hash value))) - {.#Right value} - (# right hash value))))) + {.#Right value} + ("lux i64 *" +3 (.int (# right hash value)))))))) diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux index f2210209a..b4d956198 100644 --- a/stdlib/source/library/lux/tool/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler.lux @@ -3,10 +3,14 @@ [lux {"-" Module Code} [control ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" binary {"+" Parser}]]] [data [binary {"+" Binary}] - ["[0]" text]] + ["[0]" text] + ["[0]" format "_" + ["[1]" binary {"+" Writer}]]] [world ["[0]" file {"+" Path}]]]] [/ @@ -35,14 +39,18 @@ [#dependencies (List Module) #process (-> s Archive (Try [s (Either (Compilation s d o) - (archive.Entry Any))]))])) + (archive.Entry d))]))])) (type: .public (Compiler s d o) (-> Input (Compilation s d o))) (type: .public Custom (Ex (_ state document object) - (-> (List Text) (Try [state (Compiler state document object)])))) + [state + (Key document) + (Writer document) + (Parser document) + (-> Input (Try (Compilation state document object)))])) (type: .public (Instancer s d o) (-> (Key d) (List Parameter) (Compiler s d o))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index d9d794a7b..6aa9f8b77 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -3,6 +3,7 @@ [lux "*" ["@" target] ["[0]" debug] + ["[0]" static] [abstract ["[0]" monad {"+" Monad do}]] [control @@ -52,14 +53,15 @@ ["[0]" extension {"+" Extender}]]]] [meta [import {"+" Import}] - ["[0]" context {"+" Context}] + ["[0]" context] ["[0]" cache ["[1]/[0]" archive] ["[1]/[0]" module] ["[1]/[0]" artifact]] [cli {"+" Compilation Library} - ["[0]" compiler {"+" Compiler}]] + ["[0]" compiler]] ["[0]" archive {"+" Output Archive} + [key {"+" Key}] ["[0]" registry {"+" Registry}] ["[0]" artifact] ["[0]" module @@ -94,27 +96,29 @@ (as_is (///directive.State+ )) (as_is (///generation.Bundle ))] - (def: writer - (Writer [(module.Module .Module) Registry]) + (def: (writer //) + (All (_ a) + (-> (Writer a) + (Writer [(module.Module a) Registry]))) ($_ _.and ($_ _.and _.nat descriptor.writer - (document.writer $.writer)) + (document.writer //)) registry.writer )) - (def: (cache_module context platform module_id entry) - (All (_ ) - (-> Context module.ID (archive.Entry Any) + (def: (cache_module context platform @module key format entry) + (All (_ document) + (-> context.Context module.ID (Key document) (Writer document) (archive.Entry document) (Async (Try Any)))) (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) (function (_ [artifact_id custom content]) - (cache/artifact.cache! system context module_id artifact_id content)))] + (cache/artifact.cache! system context @module artifact_id content)))] (do [! ..monad] [_ (: (Async (Try Any)) - (cache/module.enable! async.monad system context module_id)) + (cache/module.enable! async.monad system context @module)) _ (for [@.python (|> entry (value@ archive.#output) sequence.list @@ -127,13 +131,13 @@ (monad.each ..monad write_artifact!) (: (Action (List Any))))) document (# async.monad in - (document.marked? $.key (value@ [archive.#module module.#document] entry)))] + (document.marked? key (value@ [archive.#module module.#document] entry)))] (|> [(|> entry (value@ archive.#module) (with@ module.#document document)) (value@ archive.#registry entry)] - (_.result ..writer) - (cache/module.cache! system context module_id))))) + (_.result (..writer format)) + (cache/module.cache! system context @module))))) ... TODO: Inline ASAP (def: initialize_buffer! @@ -246,7 +250,7 @@ (def: .public (initialize context module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender import compilation_sources compilation_configuration) (All (_ ) - (-> Context + (-> context.Context descriptor.Module Expander ///analysis.Bundle @@ -268,7 +272,7 @@ generation_bundle)] _ (: (Async (Try Any)) (cache.enable! async.monad (value@ #&file_system platform) context)) - [archive analysis_state bundles] (ioW.thaw compilation_configuration (value@ #host platform) (value@ #&file_system platform) context import compilation_sources) + [archive analysis_state bundles] (ioW.thaw (list) compilation_configuration (value@ #host platform) (value@ #&file_system platform) context import compilation_sources) .let [with_missing_extensions (: (All (_ ) (-> (Program expression directive) @@ -291,7 +295,7 @@ [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.result' state) async#in) - _ (..cache_module context platform 0 payload) + _ (..cache_module context platform 0 $.key $.writer payload) [phase_wrapper state] (with_missing_extensions platform program state)] (in [state archive phase_wrapper]))))) @@ -457,37 +461,58 @@ state (with_synthesis_extensions from state) state (with_generation_extensions from state)] (with_directive_extensions from state))) + + (type: (Context state) + [Archive state]) + + (type: (Result state) + (Try (Context state))) + + (type: (Return state) + (Async (Result state))) + + (type: (Signal state) + (Resolver (Result state))) + + (type: (Pending state) + [(Return state) + (Signal state)]) + + (type: (Importer state) + (-> (List ///.Custom) descriptor.Module descriptor.Module (Return state))) + + (type: (Compiler state) + (-> (List ///.Custom) descriptor.Module (Importer state) module.ID (Context state) descriptor.Module (Return state))) - (with_expansions [ (as_is [Archive ]) - (as_is (Try )) - (as_is (Async )) - (as_is (Resolver )) - (as_is [ ]) - (as_is (-> descriptor.Module descriptor.Module )) - (as_is (-> descriptor.Module module.ID descriptor.Module ))] + (with_expansions [Lux_Context (..Context ) + Lux_Return (..Return ) + Lux_Signal (..Signal ) + Lux_Pending (..Pending ) + Lux_Importer (..Importer ) + Lux_Compiler (..Compiler )] (def: (parallel initial) (All (_ ) - (-> - (-> ))) + (-> Lux_Context + (-> Lux_Compiler Lux_Importer))) (let [current (stm.var initial) pending (:sharing [] - + Lux_Context initial - (Var (Dictionary descriptor.Module )) + (Var (Dictionary descriptor.Module Lux_Pending)) (:expected (stm.var (dictionary.empty text.hash)))) dependence (: (Var Dependence) (stm.var ..independence))] (function (_ compile) - (function (import! importer module) + (function (import! customs importer module) (do [! async.monad] [[return signal] (:sharing [] - + Lux_Context initial - (Async [ (Maybe [ - module.ID - ])]) + (Async [Lux_Return (Maybe [Lux_Context + module.ID + Lux_Signal])]) (:expected (stm.commit! (do [! stm.monad] @@ -517,22 +542,22 @@ {.#None} (case (if (archive.reserved? archive module) (do try.monad - [module_id (archive.id module archive)] - (in [module_id archive])) + [@module (archive.id module archive)] + (in [@module archive])) (archive.reserve module archive)) - {try.#Success [module_id archive]} + {try.#Success [@module archive]} (do ! [_ (stm.write [archive state] current) .let [[return signal] (:sharing [] - + Lux_Context initial - + Lux_Pending (async.async []))] _ (stm.update (dictionary.has module [return signal]) pending)] (in [return {.#Some [[archive state] - module_id + @module signal]}])) {try.#Failure error} @@ -542,9 +567,9 @@ {.#None} (in []) - {.#Some [context module_id resolver]} + {.#Some [context @module resolver]} (do ! - [result (compile importer import! module_id context module) + [result (compile customs importer import! @module context module) result (case result {try.#Failure error} (in result) @@ -622,33 +647,44 @@ new_dependencies))] [all_dependencies duplicates])) - (def: (after_imports import! module duplicates new_dependencies [archive state]) - (All (_ ) - (-> descriptor.Module (Set descriptor.Module) (List descriptor.Module) )) + (def: (any|after_imports customs import! module duplicates new_dependencies archive) + (All (_ + state document object) + (-> (List ///.Custom) (..Importer state) descriptor.Module (Set descriptor.Module) (List descriptor.Module) Archive + (Async (Try [Archive (List state)])))) (do [! (try.with async.monad)] [] (if (set.empty? duplicates) (case new_dependencies {.#End} - (in [archive state]) + (in [archive (list)]) {.#Item _} (do ! - [archive,document+ (|> new_dependencies - (list#each (import! module)) - (monad.all ..monad)) - .let [archive (|> archive,document+ - (list#each product.left) - (list#mix archive.merged archive))]] - (in [archive (try.trusted - (..updated_state archive - (list#each product.right archive,document+) - state))]))) + [archive,state/* (|> new_dependencies + (list#each (import! customs module)) + (monad.all ..monad))] + (in [(|> archive,state/* + (list#each product.left) + (list#mix archive.merged archive)) + (list#each product.right archive,state/*)]))) (async#in (exception.except ..cannot_import_twice [module duplicates]))))) + (def: (lux|after_imports customs import! module duplicates new_dependencies [archive state]) + (All (_ ) + (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context Lux_Return)) + (do (try.with async.monad) + [[archive state/*] (any|after_imports customs import! module duplicates new_dependencies archive)] + (in [archive (case state/* + {.#End} + state + + {.#Item _} + (try.trusted (..updated_state archive state/* state)))]))) + (def: (next_compilation module [archive state] compilation) (All (_ ) - (-> descriptor.Module (///.Compilation .Module Any) + (-> descriptor.Module Lux_Context (///.Compilation .Module Any) (Try [ (Either (///.Compilation .Module Any) (archive.Entry Any))]))) ((value@ ///.#process compilation) @@ -667,11 +703,116 @@ (let [instancer (//init.compiler phase_wrapper expander syntax.prelude (value@ #write platform))] (instancer $.key (list)))) + (def: (custom_compiler import context platform compilation_sources compiler + custom_key custom_format custom_compilation) + (All (_ + state document object) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (Key document) (Writer document) (///.Compilation state document object) + (-> (List ///.Custom) descriptor.Module Lux_Importer module.ID (..Context state) descriptor.Module (..Return state)))) + (function (_ customs importer import! @module [archive state] module) + (loop [[archive state] [archive state] + compilation custom_compilation + all_dependencies (: (Set descriptor.Module) + (set.of_list text.hash (list)))] + (do [! (try.with async.monad)] + [.let [new_dependencies (value@ ///.#dependencies compilation) + [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] + [archive _] (any|after_imports customs import! module duplicates new_dependencies archive)] + (case ((value@ ///.#process compilation) state archive) + {try.#Success [state more|done]} + (case more|done + {.#Left more} + (let [continue! (:sharing [state document object] + (///.Compilation state document object) + custom_compilation + + (-> (..Context state) (///.Compilation state document object) (Set descriptor.Module) + (..Return state)) + (:expected again))] + (continue! [archive state] more all_dependencies)) + + {.#Right entry} + (do ! + [.let [entry (with@ [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module custom_key custom_format entry)] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive state]))))) + + {try.#Failure error} + (do ! + [_ (cache/archive.cache! (value@ #&file_system platform) context archive)] + (async#in {try.#Failure error}))))))) + + (def: (lux_compiler import context platform compilation_sources compiler compilation) + (All (_ ) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + (///.Compilation .Module Any) + Lux_Compiler)) + (function (_ customs importer import! @module [archive state] module) + (loop [[archive state] [archive (..set_current_module module state)] + compilation compilation + all_dependencies (: (Set descriptor.Module) + (set.of_list text.hash (list)))] + (do [! (try.with async.monad)] + [.let [new_dependencies (value@ ///.#dependencies compilation) + [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] + [archive state] (lux|after_imports customs import! module duplicates new_dependencies [archive state])] + (case (next_compilation module [archive state] compilation) + {try.#Success [state more|done]} + (case more|done + {.#Left more} + (let [continue! (:sharing [] + + platform + + (-> Lux_Context (///.Compilation .Module Any) (Set descriptor.Module) + (Action [Archive ])) + (:expected again))] + (continue! [archive state] more all_dependencies)) + + {.#Right entry} + (do ! + [_ (let [report (..module_compilation_log module state)] + (with_expansions [ (in (debug.log! report))] + (for [@.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console))] + ))) + .let [entry (with@ [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module $.key $.writer (:as (archive.Entry .Module) entry))] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive + (..with_reset_log state)]))))) + + {try.#Failure error} + (do ! + [_ (cache/archive.cache! (value@ #&file_system platform) context archive)] + (async#in {try.#Failure error}))))))) + + (for [@.old (as_is (def: Fake_State + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) + + (def: Fake_Document + Type + {.#Primitive (%.nat (static.random_nat)) (list)}) + + (def: Fake_Object + Type + {.#Primitive (%.nat (static.random_nat)) (list)}))] + (as_is)) + (def: (serial_compiler import context platform compilation_sources compiler) (All (_ ) - (-> Import Context (List _io.Context) (///.Compiler .Module Any) - )) - (function (_ importer import! module_id [archive state] module) + (-> Import context.Context (List _io.Context) (///.Compiler .Module Any) + Lux_Compiler)) + (function (_ all_customs importer import! @module [archive lux_state] module) (do [! (try.with async.monad)] [input (io.read (value@ #&file_system platform) importer @@ -679,67 +820,44 @@ 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) - (set.of_list text.hash (list)))] - (do ! - [.let [new_dependencies (value@ ///.#dependencies compilation) - [all_dependencies duplicates] (with_new_dependencies new_dependencies all_dependencies)] - [archive state] (after_imports import! module duplicates new_dependencies [archive state])] - (case (next_compilation module [archive state] compilation) - {try.#Success [state more|done]} - (case more|done - {.#Left more} - (let [continue! (:sharing [] - - platform - - (-> (///.Compilation .Module Any) (Set descriptor.Module) - (Action [Archive ])) - (:expected again))] - (continue! [archive state] more all_dependencies)) - - {.#Right entry} - (do ! - [_ (let [report (..module_compilation_log module state)] - (with_expansions [ (in (debug.log! report))] - (for [@.js (case console.default - {.#None} - - - {.#Some console} - (console.write_line report console))] - ))) - .let [entry (with@ [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] - _ (..cache_module context platform module_id entry)] - (case (archive.has module entry archive) - {try.#Success archive} - (in [archive - (..with_reset_log state)]) - - {try.#Failure error} - (async#in {try.#Failure error})))) - - {try.#Failure error} + (loop [customs (for [@.old (:as (List (///.Custom Fake_State Fake_Document Fake_Object)) + all_customs)] + all_customs)] + (case customs + {.#End} + ((..lux_compiler import context platform compilation_sources compiler (compiler input)) + all_customs importer import! @module [archive lux_state] module) + + {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} + (case (custom_compiler input) + {try.#Failure _} + (again tail) + + {try.#Success custom_compilation} (do ! - [_ (cache/archive.cache! (value@ #&file_system platform) context archive)] - (async#in {try.#Failure error})))))))) + [[archive' custom_state'] ((..custom_compiler import context platform compilation_sources compiler + custom_key custom_format custom_compilation) + all_customs importer import! @module [archive custom_state] module)] + (in [archive' lux_state])))))))) + + (def: .public Custom + Type + (type (-> (List Text) (Try ///.Custom)))) (exception: .public (invalid_custom_compiler [definition Symbol type Type]) (exception.report ["Definition" (%.symbol definition)] - ["Expected Type" (%.type ///.Custom)] + ["Expected Type" (%.type ..Custom)] ["Actual Type" (%.type type)])) - (def: (custom_compiler importer it) + (def: (custom import! it) (All (_ ) - (-> Compiler (Async (Try [ (List Text) Any])))) + (-> Lux_Importer compiler.Compiler (Async (Try [Lux_Context (List Text) Any])))) (let [/#definition (value@ compiler.#definition it) [/#module /#name] /#definition] (do ..monad - [context (importer descriptor.runtime /#module) + [context (import! (list) descriptor.runtime /#module) .let [[archive state] context meta_state (value@ [extension.#state ///directive.#analysis @@ -750,25 +868,25 @@ meta.export (meta.result meta_state) async#in)] - (async#in (if (check.subsumes? ///.Custom /#type) + (async#in (if (check.subsumes? ..Custom /#type) {try.#Success [context (value@ 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) (All (_ ) - (-> (-> Any ///.Custom) ///phase.Wrapper Import Context Expander Compilation )) + (-> (-> Any ..Custom) ///phase.Wrapper Import context.Context Expander Compilation Lux_Context Lux_Return)) (let [[host_dependencies libraries compilers sources target module configuration] compilation - importer (|> (..compiler phase_wrapper expander platform) - (serial_compiler import file_context platform sources) - (..parallel context))] + import! (|> (..compiler phase_wrapper expander platform) + (serial_compiler import file_context platform sources) + (..parallel context))] (do [! ..monad] [customs (|> compilers (list#each (function (_ it) (do ! - [[context parameters custom] (custom_compiler importer it)] + [[context parameters custom] (..custom import! it)] (async#in (|> custom lux_compiler (function.on parameters)))))) (monad.all !))] - (importer descriptor.runtime module)))) + (import! customs descriptor.runtime module)))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index df3c8bd71..8e12692c9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -2172,7 +2172,7 @@ bodyA 2 - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] {/////analysis.#Case (/////analysis.unit) [[/////analysis.#when {pattern.#Bind 2} @@ -2182,7 +2182,7 @@ (list)]}) _ - (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices arity)))] + (let [forced_refencing (/////analysis.tuple (list#each (|>> /////analysis.local) (list.indices (++ arity))))] {/////analysis.#Case (/////analysis.unit) [[/////analysis.#when {pattern.#Complex diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 296f0394b..cb078ad43 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -11,7 +11,8 @@ ["<[0]>" synthesis {"+" Parser}]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format]] [collection ["[0]" list ("[1]#[0]" monad mix monoid)] ["[0]" dictionary {"+" Dictionary}] @@ -848,28 +849,29 @@ (def: .public (hidden_method_body arity body) (-> Nat Synthesis Synthesis) - (case [arity body] - (^or [0 _] - [1 _]) - body - - (^ [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}]) - hidden - - [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}] - (loop [path (: Path path)] - (case path - {//////synthesis.#Seq _ next} - (again next) - - (^ {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))}) - hidden - - _ - (undefined))) - - _ - (undefined))) + (with_expansions [ (panic! (%.format (%.nat arity) " " (//////synthesis.%synthesis body)))] + (case [arity body] + (^or [0 _] + [1 _]) + body + + (^ [2 {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Let _ 2 (//////synthesis.tuple (list _ hidden))}}}]) + hidden + + [_ {//////synthesis.#Control {//////synthesis.#Branch {//////synthesis.#Case _ path}}}] + (loop [path (: Path path)] + (case path + {//////synthesis.#Seq _ next} + (again next) + + (^ {//////synthesis.#Then (//////synthesis.tuple (list _ hidden))}) + hidden + + _ + )) + + _ + ))) (def: overriden_method_definition (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index e2e1df881..325700c72 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -30,7 +30,8 @@ [//// ["[0]" generation] ["[0]" synthesis {"+" Path Fork Synthesis} - ["[0]" member {"+" Member}]] + [access + ["[0]" member {"+" Member}]]] [/// ["[0]" phase ("operation#[0]" monad)] [reference diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 1e285ebb2..8b10f2833 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -27,7 +27,8 @@ ["/[1]" // "_" ["[1][0]" generation] ["[1][0]" synthesis {"+" Synthesis Path} - ["[0]" member {"+" Member}]] + [access + ["[0]" member {"+" Member}]]] ["//[1]" /// "_" [reference ["[1][0]" variable {"+" Register}]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 5441ec92f..ebab6fe8a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -25,8 +25,9 @@ ["[2][0]" complex] ["[2][0]" pattern {"+" Pattern}]] ["/" synthesis {"+" Path Synthesis Operation Phase} - ["[1][0]" side] - ["[1][0]" member {"+" Member}]] + ["[1][0]" access + ["[2][0]" side] + ["[2][0]" member {"+" Member}]]] [/// ["[1]" phase ("[1]#[0]" monad)] ["[1][0]" reference @@ -68,8 +69,8 @@ thenC) {///pattern.#Complex {///complex.#Variant [lefts right? value_pattern]}} - (<| (///#each (|>> {/.#Seq {/.#Access {/.#Side [/side.#lefts lefts - /side.#right? right?]}}})) + (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Side [/side.#lefts lefts + /side.#right? right?]}}})) (path' value_pattern end?) (when> [(new> (not end?) [])] [(///#each ..clean_up)]) thenC) @@ -84,10 +85,10 @@ _ (let [right? (n.= tuple::last tuple::lefts) end?' (and end? right?)] - (<| (///#each (|>> {/.#Seq {/.#Access {/.#Member [/member.#lefts (if right? - (-- tuple::lefts) - tuple::lefts) - /member.#right? right?]}}})) + (<| (///#each (|>> {/.#Seq {/.#Access {/access.#Member [/member.#lefts (if right? + (-- tuple::lefts) + tuple::lefts) + /member.#right? right?]}}})) (path' tuple::member end?') (when> [(new> (not end?') [])] [(///#each ..clean_up)]) nextC)))) @@ -182,11 +183,11 @@ (if (n.= newL oldL) old )]) - ([/.#Side #0 /side.#lefts /side.#right?] - [/.#Side #1 /side.#lefts /side.#right?] + ([/access.#Side #0 /side.#lefts /side.#right?] + [/access.#Side #1 /side.#lefts /side.#right?] - [/.#Member #0 /member.#lefts /member.#right?] - [/.#Member #1 /member.#lefts /member.#right?]) + [/access.#Member #0 /member.#lefts /member.#right?] + [/access.#Member #1 /member.#lefts /member.#right?]) [{/.#Bind newR} {/.#Bind oldR}] (if (n.= newR oldR) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index ba6f29f89..74abfe432 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -19,9 +19,10 @@ [number ["n" nat]]]]] [//// - ["/" synthesis {"+" Path Synthesis}] ["[0]" analysis ["[1]/[0]" complex]] + ["/" synthesis {"+" Path Synthesis} + ["[1][0]" access]] [/// [arity {"+" Arity}] ["[0]" reference @@ -49,17 +50,17 @@ register)} (again post)}) - (^or {/.#Seq {/.#Access {/.#Member member}} + (^or {/.#Seq {/.#Access {/access.#Member member}} {/.#Seq {/.#Bind register} post}} ... This alternative form should never occur in practice. ... Yet, it is "technically" possible to construct it. - {/.#Seq {/.#Seq {/.#Access {/.#Member member}} + {/.#Seq {/.#Seq {/.#Access {/access.#Member member}} {/.#Bind register}} post}) (if (n.= redundant register) (again post) - {/.#Seq {/.#Access {/.#Member member}} + {/.#Seq {/.#Access {/access.#Member member}} {/.#Seq {/.#Bind (if (n.> redundant register) (-- register) register)} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index a5767f301..819c44a5f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -26,8 +26,9 @@ ["f" frac]]]]] ["[0]" / "_" ["[1][0]" simple {"+" Simple}] - ["[1][0]" side {"+" Side}] - ["[1][0]" member {"+" Member}] + ["[1][0]" access {"+" Access} + ["[2][0]" side {"+" Side}] + ["[2][0]" member {"+" Member}]] [// ["[0]" analysis {"+" Environment Analysis} ["[1]/[0]" complex {"+" Complex}]] @@ -57,11 +58,6 @@ [#locals 0 #currying? false]) -(type: .public Access - (Variant - {#Side Side} - {#Member Member})) - (type: .public (Fork value next) [[value next] (List [value next])]) @@ -152,8 +148,8 @@ {} content)])] - [path/side ..#Side] - [path/member ..#Member] + [path/side /access.#Side] + [path/member /access.#Member] ) (template [ ] @@ -163,8 +159,8 @@ [ lefts right?])])] - [side ..#Side /side.#lefts /side.#right?] - [member ..#Member /member.#lefts /member.#right?] + [side /access.#Side /side.#lefts /side.#right?] + [member /access.#Member /member.#lefts /member.#right?] ) (template [ ] @@ -303,13 +299,8 @@ [#F64_Fork %.frac] [#Text_Fork %.text]) - {#Access access} - (case access - {#Side it} - (/side.format it) - - {#Member it} - (/member.format it)) + {#Access it} + (/access.format it) {#Bind register} (format "(@ " (%.nat register) ")") @@ -381,7 +372,7 @@ {#Get members record} (|> (format (%.list (%path' %synthesis) - (list#each (|>> {#Member} {#Access}) members)) + (list#each (|>> {/access.#Member} {#Access}) members)) " " (%synthesis record)) (text.enclosed ["{#get " "}"])) @@ -416,33 +407,6 @@ (Format Path) (%path' %synthesis)) -(implementation: .public access_equivalence - (Equivalence Access) - - (def: (= reference sample) - (case [reference sample] - (^template [ ] - [[{ reference} { sample}] - (# = reference sample)]) - ([#Side /side.equivalence] - [#Member /member.equivalence]) - - _ - false))) - -(implementation: access_hash - (Hash Access) - - (def: &equivalence ..access_equivalence) - - (def: (hash value) - (case value - (^template [ ] - [{ value} - (# hash value)]) - ([#Side /side.hash] - [#Member /member.hash])))) - (implementation: .public (path'_equivalence equivalence) (All (_ a) (-> (Equivalence a) (Equivalence (Path' a)))) @@ -470,7 +434,7 @@ (^template [ ] [[{ reference'} { sample'}] (# = reference' sample')]) - ([#Access ..access_equivalence] + ([#Access /access.equivalence] [#Then equivalence]) [{#Bind reference'} {#Bind sample'}] @@ -498,7 +462,7 @@ 2 {#Access access} - (n.* 3 (# ..access_hash hash access)) + (n.* 3 (# /access.hash hash access)) {#Bind register} (n.* 5 (# n.hash hash register)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux new file mode 100644 index 000000000..cb3e3f50a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux @@ -0,0 +1,38 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" sum] + [text + ["%" format {"+" Format}]]]]] + ["[0]" / "_" + ["[1][0]" side {"+" Side}] + ["[1][0]" member {"+" Member}]]) + +(type: .public Access + (Variant + {#Side Side} + {#Member Member})) + +(def: .public (format it) + (Format Access) + (case it + {#Side it} + (/side.format it) + + {#Member it} + (/member.format it))) + +(def: .public hash + (Hash Access) + ($_ sum.hash + /side.hash + /member.hash + )) + +(def: .public equivalence + (Equivalence Access) + (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux new file mode 100644 index 000000000..4e1ed910b --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux @@ -0,0 +1,34 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" product] + ["[0]" bit] + [text + ["%" format]]] + [math + [number + ["[0]" nat]]]]]) + +(type: .public Member + (Record + [#lefts Nat + #right? Bit])) + +(def: .public (format it) + (%.Format Member) + (%.format "[" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "]")) + +(def: .public hash + (Hash Member) + ($_ product.hash + nat.hash + bit.hash + )) + +(def: .public equivalence + (Equivalence Member) + (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux new file mode 100644 index 000000000..dd9bf4223 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux @@ -0,0 +1,34 @@ +(.using + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [hash {"+" Hash}]] + [data + ["[0]" product] + ["[0]" bit] + [text + ["%" format]]] + [math + [number + ["[0]" nat]]]]]) + +(type: .public Side + (Record + [#lefts Nat + #right? Bit])) + +(def: .public (format it) + (%.Format Side) + (%.format "{" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "}")) + +(def: .public hash + (Hash Side) + ($_ product.hash + nat.hash + bit.hash + )) + +(def: .public equivalence + (Equivalence Side) + (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux deleted file mode 100644 index 4e1ed910b..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/member.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}]] - [data - ["[0]" product] - ["[0]" bit] - [text - ["%" format]]] - [math - [number - ["[0]" nat]]]]]) - -(type: .public Member - (Record - [#lefts Nat - #right? Bit])) - -(def: .public (format it) - (%.Format Member) - (%.format "[" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "]")) - -(def: .public hash - (Hash Member) - ($_ product.hash - nat.hash - bit.hash - )) - -(def: .public equivalence - (Equivalence Member) - (# ..hash &equivalence)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux deleted file mode 100644 index dd9bf4223..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/side.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [hash {"+" Hash}]] - [data - ["[0]" product] - ["[0]" bit] - [text - ["%" format]]] - [math - [number - ["[0]" nat]]]]]) - -(type: .public Side - (Record - [#lefts Nat - #right? Bit])) - -(def: .public (format it) - (%.Format Side) - (%.format "{" (%.nat (value@ #lefts it)) " " (%.bit (value@ #right? it)) "}")) - -(def: .public hash - (Hash Side) - ($_ product.hash - nat.hash - bit.hash - )) - -(def: .public equivalence - (Equivalence Side) - (# ..hash &equivalence)) 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 f625ba952..212006bbe 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -1,7 +1,7 @@ (.using [library [lux "*" - [target {"+" Target}] + ["@" target {"+" Target}] [abstract ["[0]" monad {"+" Monad do}]] [control @@ -31,6 +31,7 @@ [import {"+" Import}] ["[0]" context {"+" Context}] ["[0]" archive {"+" Output Archive} + [key {"+" Key}] ["[0]" registry {"+" Registry}] ["[0]" unit] ["[0]" artifact {"+" Artifact} @@ -44,7 +45,7 @@ ["[1]/[0]" purge {"+" Cache Purge}] ["[0]" dependency "_" ["[1]" module]]] - [// + [// {"+" Custom} [language ["$" lux ["[0]" analysis] @@ -53,17 +54,19 @@ ["[0]" directive] ["[1]/[0]" program]]]]]]) -(def: module_parser - (Parser (module.Module .Module)) +(def: (module_parser key parser) + (All (_ document) + (-> (Key document) (Parser document) (Parser (module.Module document)))) ($_ <>.and .nat descriptor.parser - (document.parser $.key $.parser))) + (document.parser key parser))) -(def: parser - (Parser [(module.Module .Module) Registry]) +(def: (parser key parser) + (All (_ document) + (-> (Key document) (Parser document) (Parser [(module.Module document) Registry]))) ($_ <>.and - ..module_parser + (..module_parser key parser) registry.parser)) (def: (fresh_analysis_state host configuration) @@ -262,30 +265,43 @@ Text "(Lux Caching System)") -(def: (valid_cache fs context import contexts [module_name @module]) - (-> (file.System Async) Context Import (List //.Context) +(def: (cache_parser customs) + (-> (List Custom) (Parser [(module.Module Any) Registry])) + (case (for [@.old (:as (List (Custom Any Any Any)) + customs)] + customs) + {.#End} + (..parser $.key $.parser) + + {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} + ($_ <>.either + (..parser custom_key custom_parser) + (cache_parser tail) + ))) + +(def: (valid_cache customs fs context import contexts [module_name @module]) + (-> (List Custom) (file.System Async) Context Import (List //.Context) [descriptor.Module module.ID] (Async (Try Cache))) (with_expansions [ (as_is module_name @module module registry)] (do [! (try.with async.monad)] [data (: (Async (Try Binary)) (cache/module.cache fs context @module)) - [module registry] (async#in (.result ..parser data))] + [module registry] (async#in (.result (..cache_parser customs) data))] (if (text#= descriptor.runtime module_name) (in [true ]) (do ! [input (//context.read fs ..pseudo_module import contexts (value@ context.#host_module_extension context) module_name)] (in [(cache/purge.valid? (value@ module.#descriptor module) input) ])))))) -(def: (pre_loaded_caches fs context import contexts archive) - (-> (file.System Async) Context Import (List //.Context) Archive +(def: (pre_loaded_caches customs fs context import contexts archive) + (-> (List Custom) (file.System Async) Context Import (List //.Context) Archive (Async (Try (List 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 context import contexts)))] + (monad.each ! (..valid_cache customs fs context import contexts)))] (in it))) (def: (load_order archive pre_loaded_caches) @@ -319,12 +335,12 @@ bundles])))))] (in it))) -(def: (load_every_reserved_module configuration host_environment fs context import contexts archive) +(def: (load_every_reserved_module customs configuration host_environment fs context import contexts archive) (All (_ expression directive) - (-> Configuration (generation.Host expression directive) (file.System Async) Context Import (List //.Context) Archive + (-> (List Custom) Configuration (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 context import contexts archive) + [pre_loaded_caches (..pre_loaded_caches customs fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) .let [purge (cache/purge.purge pre_loaded_caches load_order)] _ (|> purge @@ -350,9 +366,9 @@ ..empty_bundles loaded_caches)]))))) -(def: .public (thaw configuration host_environment fs context import contexts) +(def: .public (thaw customs configuration host_environment fs context import contexts) (All (_ expression directive) - (-> Configuration (generation.Host expression directive) (file.System Async) Context Import (List //.Context) + (-> (List Custom) Configuration (generation.Host expression directive) (file.System Async) Context Import (List //.Context) (Async (Try [Archive .Lux Bundles])))) (do async.monad [binary (# fs read (cache/archive.descriptor fs context))] @@ -360,7 +376,7 @@ {try.#Success binary} (do (try.with async.monad) [archive (async#in (archive.import ///.version binary))] - (..load_every_reserved_module configuration host_environment fs context import contexts archive)) + (..load_every_reserved_module customs configuration host_environment fs context import contexts archive)) {try.#Failure error} (in {try.#Success [archive.empty -- cgit v1.2.3