diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/tool/compiler/default/init.lux | 287 |
1 files changed, 287 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux new file mode 100644 index 000000000..172de25e7 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -0,0 +1,287 @@ +(.module: + [library + [lux (#- Module) + ["@" target (#+ Target)] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + [binary (#+ Binary)] + ["." product] + ["." text ("#\." hash) + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)] + ["." dictionary] + ["." set] + ["." row ("#\." functor)]]] + ["." meta] + [world + ["." file]]]] + ["." // #_ + ["/#" // (#+ Instancer) + ["#." phase] + [language + [lux + [program (#+ Program)] + ["#." version] + ["#." syntax (#+ Aliases)] + ["#." synthesis] + ["#." directive (#+ Requirements)] + ["#." generation] + ["#." analysis + [macro (#+ Expander)] + ["#/." evaluation]] + [phase + [".P" synthesis] + [".P" directive] + [".P" analysis + ["." module]] + ["." extension (#+ Extender) + [".E" analysis] + [".E" synthesis] + [directive + [".D" lux]]]]]] + [meta + ["." archive (#+ Archive) + ["." descriptor (#+ Module)] + ["." artifact] + ["." document]]]]]) + +(def: #export (state target module expander host_analysis host generate generation_bundle) + (All [anchor expression directive] + (-> Target + Module + Expander + ///analysis.Bundle + (///generation.Host expression directive) + (///generation.Phase anchor expression directive) + (///generation.Bundle anchor expression directive) + (///directive.State+ anchor expression directive))) + (let [synthesis_state [synthesisE.bundle ///synthesis.init] + generation_state [generation_bundle (///generation.state host module)] + eval (///analysis/evaluation.evaluator expander synthesis_state generation_state generate) + analysis_state [(analysisE.bundle eval host_analysis) + (///analysis.state (///analysis.info ///version.version target))]] + [extension.empty + {#///directive.analysis {#///directive.state analysis_state + #///directive.phase (analysisP.phase expander)} + #///directive.synthesis {#///directive.state synthesis_state + #///directive.phase synthesisP.phase} + #///directive.generation {#///directive.state generation_state + #///directive.phase generate}}])) + +(def: #export (with_default_directives expander host_analysis program anchorT,expressionT,directiveT extender) + (All [anchor expression directive] + (-> Expander + ///analysis.Bundle + (Program expression directive) + [Type Type Type] + Extender + (-> (///directive.State+ anchor expression directive) + (///directive.State+ anchor expression directive)))) + (function (_ [directive_extensions sub_state]) + [(dictionary.merge directive_extensions + (luxD.bundle expander host_analysis program anchorT,expressionT,directiveT extender)) + sub_state])) + +(type: Reader + (-> Source (Either [Source Text] [Source Code]))) + +(def: (reader current_module aliases [location offset source_code]) + (-> Module Aliases Source (///analysis.Operation Reader)) + (function (_ [bundle state]) + (#try.Success [[bundle state] + (///syntax.parse current_module aliases ("lux text size" source_code))]))) + +(def: (read source reader) + (-> Source Reader (///analysis.Operation [Source Code])) + (function (_ [bundle compiler]) + (case (reader source) + (#.Left [source' error]) + (#try.Failure error) + + (#.Right [source' output]) + (let [[location _] output] + (#try.Success [[bundle (|> compiler + (set@ #.source source') + (set@ #.location location))] + [source' output]]))))) + +(type: (Operation a) + (All [anchor expression directive] + (///directive.Operation anchor expression directive a))) + +(type: (Payload directive) + [(///generation.Buffer directive) + artifact.Registry]) + +(def: (begin dependencies hash input) + (-> (List Module) Nat ///.Input + (All [anchor expression directive] + (///directive.Operation anchor expression directive + [Source (Payload directive)]))) + (do ///phase.monad + [#let [module (get@ #///.module input)] + _ (///directive.set_current_module module)] + (///directive.lift_analysis + (do {! ///phase.monad} + [_ (module.create hash module) + _ (monad.map ! module.import dependencies) + #let [source (///analysis.source (get@ #///.module input) (get@ #///.code input))] + _ (///analysis.set_source_code source)] + (wrap [source [///generation.empty_buffer + artifact.empty]]))))) + +(def: (end module) + (-> Module + (All [anchor expression directive] + (///directive.Operation anchor expression directive [.Module (Payload directive)]))) + (do ///phase.monad + [_ (///directive.lift_analysis + (module.set_compiled module)) + analysis_module (<| (: (Operation .Module)) + ///directive.lift_analysis + extension.lift + meta.current_module) + final_buffer (///directive.lift_generation + ///generation.buffer) + final_registry (///directive.lift_generation + ///generation.get_registry)] + (wrap [analysis_module [final_buffer + final_registry]]))) + +## TODO: Inline ASAP +(def: (get_current_payload _) + (All [directive] + (-> (Payload directive) + (All [anchor expression] + (///directive.Operation anchor expression directive + (Payload directive))))) + (do ///phase.monad + [buffer (///directive.lift_generation + ///generation.buffer) + registry (///directive.lift_generation + ///generation.get_registry)] + (wrap [buffer registry]))) + +## TODO: Inline ASAP +(def: (process_directive archive expander pre_payoad code) + (All [directive] + (-> Archive Expander (Payload directive) Code + (All [anchor expression] + (///directive.Operation anchor expression directive + [Requirements (Payload directive)])))) + (do ///phase.monad + [#let [[pre_buffer pre_registry] pre_payoad] + _ (///directive.lift_generation + (///generation.set_buffer pre_buffer)) + _ (///directive.lift_generation + (///generation.set_registry pre_registry)) + requirements (let [execute! (directiveP.phase expander)] + (execute! archive code)) + post_payload (..get_current_payload pre_payoad)] + (wrap [requirements post_payload]))) + +(def: (iteration archive expander reader source pre_payload) + (All [directive] + (-> Archive Expander Reader Source (Payload directive) + (All [anchor expression] + (///directive.Operation anchor expression directive + [Source Requirements (Payload directive)])))) + (do ///phase.monad + [[source code] (///directive.lift_analysis + (..read source reader)) + [requirements post_payload] (process_directive archive expander pre_payload code)] + (wrap [source requirements post_payload]))) + +(def: (iterate archive expander module source pre_payload aliases) + (All [directive] + (-> Archive Expander Module Source (Payload directive) Aliases + (All [anchor expression] + (///directive.Operation anchor expression directive + (Maybe [Source Requirements (Payload directive)]))))) + (do ///phase.monad + [reader (///directive.lift_analysis + (..reader module aliases source))] + (function (_ state) + (case (///phase.run' state (..iteration archive expander reader source pre_payload)) + (#try.Success [state source&requirements&buffer]) + (#try.Success [state (#.Some source&requirements&buffer)]) + + (#try.Failure error) + (if (exception.match? ///syntax.end_of_file error) + (#try.Success [state #.None]) + (exception.with ///.cannot_compile module (#try.Failure error))))))) + +(def: (default_dependencies prelude input) + (-> Module ///.Input (List Module)) + (list& archive.runtime_module + (if (text\= prelude (get@ #///.module input)) + (list) + (list prelude)))) + +(def: module_aliases + (-> .Module Aliases) + (|>> (get@ #.module_aliases) (dictionary.from_list text.hash))) + +(def: #export (compiler expander prelude write_directive) + (All [anchor expression directive] + (-> Expander Module (-> directive Binary) + (Instancer (///directive.State+ anchor expression directive) .Module))) + (let [execute! (directiveP.phase expander)] + (function (_ key parameters input) + (let [dependencies (default_dependencies prelude input)] + {#///.dependencies dependencies + #///.process (function (_ state archive) + (do {! try.monad} + [#let [hash (text\hash (get@ #///.code input))] + [state [source buffer]] (<| (///phase.run' state) + (..begin dependencies hash input)) + #let [module (get@ #///.module input)]] + (loop [iteration (<| (///phase.run' state) + (..iterate 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.run' state (..end module)) + #let [descriptor {#descriptor.hash hash + #descriptor.name module + #descriptor.file (get@ #///.file input) + #descriptor.references (set.from_list text.hash dependencies) + #descriptor.state #.Compiled + #descriptor.registry final_registry}]] + (wrap [state + (#.Right [descriptor + (document.write key analysis_module) + (row\map (function (_ [artifact_id directive]) + [artifact_id (write_directive directive)]) + final_buffer)])])) + + (#.Some [source requirements temporary_payload]) + (let [[temporary_buffer temporary_registry] temporary_payload] + (wrap [state + (#.Left {#///.dependencies (|> requirements + (get@ #///directive.imports) + (list\map product.left)) + #///.process (function (_ state archive) + (recur (<| (///phase.run' state) + (do {! ///phase.monad} + [analysis_module (<| (: (Operation .Module)) + ///directive.lift_analysis + extension.lift + meta.current_module) + _ (///directive.lift_generation + (///generation.set_buffer temporary_buffer)) + _ (///directive.lift_generation + (///generation.set_registry temporary_registry)) + _ (|> requirements + (get@ #///directive.referrals) + (monad.map ! (execute! archive))) + temporary_payload (..get_current_payload temporary_payload)] + (..iterate archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) + )))))})))) |