diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 104 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/context.lux | 56 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/program/compositor.lux | 145 |
5 files changed, 156 insertions, 159 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index aea0ca787..753ab8f5c 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -4,7 +4,9 @@ [abstract ["." monad (#+ Monad do)]] [control - ["." try (#+ Try)]] + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]] [data ["." bit] ["." product] @@ -36,9 +38,8 @@ [compositor ["." cli (#+ Configuration)]]]) -(type: #export (Platform ! anchor expression directive) - {#&monad (Monad !) - #&file-system (file.System !) +(type: #export (Platform anchor expression directive) + {#&file-system (file.System Promise) #host (generation.Host expression directive) #phase (generation.Phase anchor expression directive) #runtime (generation.Operation anchor expression directive Any)}) @@ -52,8 +53,8 @@ ## (format module-name "/" cache.descriptor-name) ## (encoding.to-utf8 (%.code (cache/description.write file-name module)))))) -(with-expansions [<type-vars> (as-is [! anchor expression directive]) - <Platform> (as-is (Platform ! anchor expression directive)) +(with-expansions [<type-vars> (as-is [anchor expression directive]) + <Platform> (as-is (Platform anchor expression directive)) <State+> (as-is (///directive.State+ anchor expression directive)) <Bundle> (as-is (generation.Bundle anchor expression directive))] @@ -68,6 +69,24 @@ (set@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context] context state)) + + ## TODO: Inline ASAP + (def: initialize-buffer! + (All <type-vars> + (generation.Operation anchor expression directive Any)) + (generation.set-buffer generation.empty-buffer)) + + ## TODO: Inline ASAP + (def: compile-runtime! + (All <type-vars> + (-> <Platform> (generation.Operation anchor expression directive Any))) + (get@ #runtime)) + + ## TODO: Inline ASAP + (def: save-runtime-buffer! + (All <type-vars> + (generation.Operation anchor expression directive (Buffer directive))) + (generation.save-buffer! "")) (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender) (All <type-vars> @@ -79,39 +98,24 @@ (///directive.Bundle anchor expression directive) (-> expression directive) Extender - (! (Try <State+>)))) - (|> (do ///phase.monad - [_ (:share [anchor expression directive] - {(///directive.Bundle anchor expression directive) - host-directive-bundle} - {(generation.Operation anchor expression directive Any) - (generation.set-buffer (:share [anchor expression directive] - {(///directive.Bundle anchor expression directive) - host-directive-bundle} - {(Buffer directive) - generation.empty-buffer}))}) - _ (:share [anchor expression directive] - {(///directive.Bundle anchor expression directive) - host-directive-bundle} - {(generation.Operation anchor expression directive Any) - (get@ #runtime platform)})] - (:share [anchor expression directive] - {(///directive.Bundle anchor expression directive) - host-directive-bundle} - {(generation.Operation anchor expression directive Any) - (generation.save-buffer! "")})) - ///directive.lift-generation - (///phase.run' (//init.state target - expander - host-analysis - (get@ #host platform) - (get@ #phase platform) - generation-bundle - host-directive-bundle - program - extender)) - (:: try.functor map product.left) - (:: (get@ #&monad platform) wrap)) + (Promise (Try <State+>)))) + (let [state (//init.state target + expander + host-analysis + (get@ #host platform) + (get@ #phase platform) + generation-bundle + host-directive-bundle + program + extender)] + (|> (do ///phase.monad + [_ ..initialize-buffer! + _ (..compile-runtime! platform)] + ..save-runtime-buffer!) + ///directive.lift-generation + (///phase.run' state) + (:: try.functor map product.left) + (:: promise.monad wrap))) ## (case (runtimeT.generate ## (initL.compiler (io.run js.init)) ## (initL.compiler (io.run hostL.init-host)) @@ -141,10 +145,9 @@ (def: #export (compile partial-host-extension expander platform configuration archive state) (All <type-vars> - (-> Text Expander <Platform> Configuration Archive <State+> (! (Try [Archive <State+>])))) - (let [monad (get@ #&monad platform) - source-module (get@ #cli.module configuration) - compiler (:share [anchor expression directive] + (-> Text Expander <Platform> Configuration Archive <State+> (Promise (Try [Archive <State+>])))) + (let [source-module (get@ #cli.module configuration) + compiler (:share <type-vars> {<State+> state} {(///.Compiler <State+> .Module Any) @@ -152,16 +155,15 @@ (loop [module source-module [archive state] [archive state]] (if (archive.archived? archive module) - (:: monad wrap (#try.Success [archive state])) + (:: promise.monad wrap (#try.Success [archive state])) (let [import! (:share <type-vars> {<Platform> platform} {(-> Module [Archive <State+>] - (! (Try [Archive <State+>]))) + (Promise (Try [Archive <State+>]))) recur})] - (do (try.with monad) - [input (context.read monad - (get@ #&file-system platform) + (do (try.with promise.monad) + [input (context.read (get@ #&file-system platform) (get@ #cli.sources configuration) partial-host-extension module) @@ -189,7 +191,7 @@ {<Platform> platform} {(-> Archive <State+> (///.Compilation <State+> .Module Any) - (! (Try [Archive <State+>]))) + (Promise (Try [Archive <State+>]))) recur})]] (case ((get@ #///.process compilation) (case dependencies @@ -216,8 +218,8 @@ (wrap [archive state]) (#try.Failure error) - (:: monad wrap (#try.Failure error)))) + (:: promise.monad wrap (#try.Failure error)))) (#try.Failure error) - (:: monad wrap (#try.Failure error))))))))))) + (:: promise.monad wrap (#try.Failure error))))))))))) ) diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux index cc23f11be..1313386d5 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -7,15 +7,16 @@ ["." try (#+ Try)] ["ex" exception (#+ Exception exception:)] [security - ["!" capability]]] + ["!" capability]] + [concurrency + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] ["." text ("#;." hash) ["%" format (#+ format)] ["." encoding]]] [world - ["." file (#+ Path File)]] - [type (#+ :share)]] + ["." file (#+ Path File)]]] ["." // (#+ Context Code) ["#/" // #_ [archive @@ -42,16 +43,15 @@ (//.sanitize system) (format context (:: system separator)))) -(def: (find-source-file monad system contexts module extension) - (All [!] - (-> (Monad !) (file.System !) (List Context) Module Extension - (! (Try [Path (File !)])))) +(def: (find-source-file system contexts module extension) + (-> (file.System Promise) (List Context) Module Extension + (Promise (Try [Path (File Promise)]))) (case contexts #.Nil - (:: monad wrap (ex.throw ..cannot-find-module [module])) + (:: promise.monad wrap (ex.throw ..cannot-find-module [module])) (#.Cons context contexts') - (do monad + (do promise.monad [#let [path (format (..path system context module) extension)] file (!.use (:: system file) path)] (case file @@ -59,38 +59,26 @@ (wrap (#try.Success [path file])) (#try.Failure _) - (find-source-file monad system contexts' module extension))))) + (find-source-file system contexts' module extension))))) -(def: #export (find-any-source-file monad system contexts partial-host-extension module) - (All [!] - (-> (Monad !) (file.System !) (List Context) Text Module - (! (Try [Path (File !)])))) +(def: #export (find-any-source-file system contexts partial-host-extension module) + (-> (file.System Promise) (List Context) Text Module + (Promise (Try [Path (File Promise)]))) (let [full-host-extension (format partial-host-extension lux-extension)] - (do monad - [outcome (find-source-file monad system contexts module full-host-extension)] + (do promise.monad + [outcome (find-source-file system contexts module full-host-extension)] (case outcome (#try.Success output) (wrap outcome) (#try.Failure _) - (find-source-file monad system contexts module ..lux-extension))))) + (find-source-file system contexts module ..lux-extension))))) -(def: #export (read monad system contexts partial-host-extension module) - (All [!] - (-> (Monad !) (file.System !) (List Context) Text Module - (! (Try Input)))) - (do (try.with monad) - [## TODO: Get rid of both ":share"s ASAP - path,file (:share [!] - {(Monad !) - monad} - {(! (Try [Path (File !)])) - (find-any-source-file monad system contexts partial-host-extension module)}) - #let [[path file] (:share [!] - {(Monad !) - monad} - {[Path (File !)] - path,file})] +(def: #export (read system contexts partial-host-extension module) + (-> (file.System Promise) (List Context) Text Module + (Promise (Try Input))) + (do (try.with promise.monad) + [[path file] (..find-any-source-file system contexts partial-host-extension module) binary (!.use (:: file content) [])] (case (encoding.from-utf8 binary) (#try.Success code) @@ -100,4 +88,4 @@ #////.code code}) (#try.Failure _) - (:: monad wrap (ex.throw ..cannot-read-module [module]))))) + (:: promise.monad wrap (ex.throw ..cannot-read-module [module]))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index 35fa850be..ca2d76965 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -263,10 +263,11 @@ (def: #export (save-buffer! target) (All [anchor expression directive] - (-> Module (Operation anchor expression directive Any))) + (-> Module (Operation anchor expression directive (Buffer directive)))) (do //.monad - [buffer ..buffer] - (extension.update (update@ #output (row.add [target buffer]))))) + [buffer ..buffer + _ (extension.update (update@ #output (row.add [target buffer])))] + (wrap buffer))) (def: #export (remember lux-name) (All [anchor expression directive] diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 6ed752f74..6310a47b9 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -348,7 +348,8 @@ (function (discard _) (!delete path cannot-discard-directory))))) - (structure: #export system (System IO) + (structure: #export system + (System IO) (~~ (template [<name> <method> <capability> <exception>] [(def: <name> (..can-open diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 31f018081..53598f8b5 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -9,7 +9,9 @@ [parser [cli (#+ program:)]] [security - ["!" capability]]] + ["!" capability]] + [concurrency + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] ["." product] @@ -44,84 +46,87 @@ (def: (or-crash! failure-description action) (All [a] - (-> Text (IO (Try a)) (IO a))) - (do io.monad + (-> Text (Promise (Try a)) (Promise a))) + (do promise.monad [?output action] (case ?output (#try.Failure error) (exec (log! (format text.new-line failure-description text.new-line error text.new-line)) - (io.exit +1)) + (io.run (io.exit +1))) (#try.Success output) (wrap output)))) -(def: (save-artifacts! system state [packager package]) - (All [anchor expression directive] - (-> (file.System IO) - (directive.State+ anchor expression directive) - [(-> (generation.Output directive) Binary) Path] - (IO (Try Any)))) - (let [?outcome (phase.run' state - (:share [anchor expression directive] - {(directive.State+ anchor expression directive) - state} - {(directive.Operation anchor expression directive - (generation.Output directive)) - (directive.lift-generation generation.output)}))] - (case ?outcome - (#try.Success [state output]) - (do (try.with io.monad) - [file (: (IO (Try (File IO))) - (file.get-file io.monad system package))] - (!.use (:: file over-write) (packager output))) +(with-expansions [<parameters> (as-is anchor expression artifact)] + (def: (save-artifacts! system state [packager package]) + (All [<parameters>] + (-> (file.System Promise) + (directive.State+ <parameters>) + [(-> (generation.Output artifact) Binary) Path] + (Promise (Try Any)))) + (let [?outcome (phase.run' state + (:share [<parameters>] + {(directive.State+ <parameters>) + state} + {(directive.Operation <parameters> + (generation.Output artifact)) + (directive.lift-generation generation.output)}))] + (case ?outcome + (#try.Success [state output]) + (do (try.with promise.monad) + [file (: (Promise (Try (File Promise))) + (file.get-file promise.monad system package))] + (!.use (:: file over-write) (packager output))) - (#try.Failure error) - (:: io.monad wrap (#try.Failure error))))) + (#try.Failure error) + (:: promise.monad wrap (#try.Failure error))))) -(def: #export (compiler target partial-host-extension - expander host-analysis platform generation-bundle host-directive-bundle program extender - service - packager,package) - (All [anchor expression directive] - (-> Text - Text - Expander - analysis.Bundle - (IO (Platform IO anchor expression directive)) - (generation.Bundle anchor expression directive) - (directive.Bundle anchor expression directive) - (-> expression directive) - Extender - Service - [(-> (generation.Output directive) Binary) Path] - (IO Any))) - (do io.monad - [platform platform - console (:: @ map try.assume console.system)] - (case service - (#cli.Compilation configuration) - (<| (or-crash! "Compilation failed:") - (do (try.with io.monad) - [state (:share [anchor expression directive] - {(Platform IO anchor expression directive) - platform} - {(IO (Try (directive.State+ anchor expression directive))) - (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)}) - [archive state] (:share [anchor expression directive] - {(Platform IO anchor expression directive) - platform} - {(IO (Try [Archive (directive.State+ anchor expression directive)])) - (platform.compile partial-host-extension expander platform configuration archive.empty state)}) - _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package) - ## _ (cache/io.clean target ...) - ] - (wrap (log! "Compilation complete!")))) - - (#cli.Interpretation configuration) - ## TODO: Fix the interpreter... - (undefined) - ## (<| (or-crash! "Interpretation failed:") - ## (interpreter.run (try.with io.monad) console platform configuration generation-bundle)) - ))) + (def: #export (compiler target partial-host-extension + expander host-analysis platform generation-bundle host-directive-bundle program extender + service + packager,package) + (All [<parameters>] + (-> Text + Text + Expander + analysis.Bundle + (IO (Platform <parameters>)) + (generation.Bundle <parameters>) + (directive.Bundle <parameters>) + (-> expression artifact) + Extender + Service + [(-> (generation.Output artifact) Binary) Path] + (Promise Any))) + (do promise.monad + [platform (promise.future platform) + console (|> console.system + promise.future + (:: @ map (|>> try.assume console.async)))] + (case service + (#cli.Compilation configuration) + (<| (or-crash! "Compilation failed:") + (do (try.with promise.monad) + [state (:share [<parameters>] + {(Platform <parameters>) + platform} + {(Promise (Try (directive.State+ <parameters>))) + (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)}) + [archive state] (:share [<parameters>] + {(Platform <parameters>) + platform} + {(Promise (Try [Archive (directive.State+ <parameters>)])) + (platform.compile partial-host-extension expander platform configuration archive.empty state)}) + _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package) + ## _ (cache/io.clean target ...) + ] + (wrap (log! "Compilation complete!")))) + + (#cli.Interpretation configuration) + ## TODO: Fix the interpreter... + (undefined) + ## (<| (or-crash! "Interpretation failed:") + ## (interpreter.run (try.with promise.monad) console platform configuration generation-bundle)) + )))) |