aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2019-12-29 23:49:53 -0400
committerEduardo Julian2019-12-29 23:49:53 -0400
commit647d18fde762b0797b5b31b69421d50ed326dcc5 (patch)
treec7749d014047024c9735b9e715ff5f21e53ba346 /stdlib/source
parent55219078698866155d7d3879f1378f75ba2ba3ee (diff)
Committing to Promise as the base monad for the compiler.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux104
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux56
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation.lux7
-rw-r--r--stdlib/source/lux/world/file.lux3
-rw-r--r--stdlib/source/program/compositor.lux145
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))
+ ))))