aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/tool/compiler.lux13
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux124
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux104
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux4
-rw-r--r--stdlib/source/program/compositor.lux10
7 files changed, 183 insertions, 132 deletions
diff --git a/stdlib/source/lux/tool/compiler.lux b/stdlib/source/lux/tool/compiler.lux
index ca9ea4a0e..867fb4012 100644
--- a/stdlib/source/lux/tool/compiler.lux
+++ b/stdlib/source/lux/tool/compiler.lux
@@ -4,9 +4,10 @@
["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
+ [binary (#+ Binary)]
["." text]
[collection
- ["." dictionary (#+ Dictionary)]]]
+ ["." row (#+ Row)]]]
[world
["." file (#+ Path)]]]
[/
@@ -28,18 +29,14 @@
#hash Nat
#code Code})
-(type: #export (Output o)
- (Dictionary Text o))
-
-(def: #export empty-output
- Output
- (dictionary.new text.hash))
+(type: #export Output
+ (Row [Text Binary]))
(type: #export (Compilation s d o)
{#dependencies (List Module)
#process (-> s Archive
(Try [s (Either (Compilation s d o)
- [[Descriptor (Document d)] (Output o)])]))})
+ [[Descriptor (Document d)] Output])]))})
(type: #export (Compiler s d o)
(-> Input (Compilation s d o)))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index baf1501aa..05293ad5a 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -6,17 +6,21 @@
["." try (#+ Try)]
["ex" exception (#+ exception:)]]
[data
+ [binary (#+ Binary)]
["." product]
- ["." text ("#@." hash)]
+ ["." text ("#@." hash)
+ ["%" format (#+ format)]]
[collection
["." list ("#@." functor)]
["." dictionary]
- ["." set]]]
+ ["." set]
+ ["." row ("#@." functor)]]]
["." macro]
[world
["." file]]]
["." // #_
["/#" // (#+ Instancer)
+ ["#." phase]
[language
[lux
["#." version]
@@ -36,9 +40,7 @@
[".E" analysis]
[".E" synthesis]
[directive
- [".D" lux]]]]
- [///
- ["#." phase]]]]
+ [".D" lux]]]]]]
[meta
[archive
["." signature]
@@ -121,12 +123,19 @@
(wrap [source ///generation.empty-buffer]))))
(def: (end module)
- (-> Module (Operation Any))
+ (-> Module
+ (All [anchor expression directive]
+ (///directive.Operation anchor expression directive [.Module (///generation.Buffer directive)])))
(do ///phase.monad
[_ (///directive.lift-analysis
- (module.set-compiled module))]
- (///directive.lift-generation
- (///generation.save-buffer! module))))
+ (module.set-compiled module))
+ final-buffer (///directive.lift-generation
+ (///generation.save-buffer! module))
+ analysis-module (<| (: (Operation .Module))
+ ///directive.lift-analysis
+ extension.lift
+ macro.current-module)]
+ (wrap [analysis-module final-buffer])))
## TODO: Inline ASAP
(def: (get-current-buffer old-buffer)
@@ -194,9 +203,9 @@
(-> .Module Aliases)
(|>> (get@ #.module-aliases) (dictionary.from-list text.hash)))
-(def: #export (compiler expander prelude)
- (-> Expander Module
- (All [anchor expression directive]
+(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)
@@ -211,17 +220,11 @@
(loop [iteration (<| (///phase.run' state)
(..iterate expander module source buffer ///syntax.no-aliases))]
(do @
- [[state ?source&requirements&buffer] iteration]
- (case ?source&requirements&buffer
+ [[state ?source&requirements&temporary-buffer] iteration]
+ (case ?source&requirements&temporary-buffer
#.None
(do @
- [[state analysis-module] (<| (///phase.run' state)
- (do ///phase.monad
- [_ (..end module)]
- (<| (: (Operation .Module))
- ///directive.lift-analysis
- extension.lift
- macro.current-module)))
+ [[state [analysis-module final-buffer]] (///phase.run' state (..end module))
#let [descriptor {#descriptor.hash hash
#descriptor.name module
#descriptor.file (get@ #///.file input)
@@ -229,9 +232,12 @@
#descriptor.state #.Compiled}]]
(wrap [state
(#.Right [[descriptor (document.write key analysis-module)]
- (dictionary.new text.hash)])]))
+ (|> final-buffer
+ (row@map (function (_ [name directive])
+ [(product.right name)
+ (write-directive directive)])))])]))
- (#.Some [source requirements buffer])
+ (#.Some [source requirements temporary-buffer])
(wrap [state
(#.Left {#///.dependencies (|> requirements
(get@ #///directive.imports)
@@ -244,10 +250,10 @@
extension.lift
macro.current-module)
_ (///directive.lift-generation
- (///generation.set-buffer buffer))
+ (///generation.set-buffer temporary-buffer))
_ (monad.map @ execute! (get@ #///directive.referrals requirements))
- buffer (..get-current-buffer buffer)]
- (..iterate expander module source buffer (..module-aliases analysis-module))))))})])
+ temporary-buffer (..get-current-buffer temporary-buffer)]
+ (..iterate expander module source temporary-buffer (..module-aliases analysis-module))))))})])
)))))}))))
(def: #export key
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 36fc26363..a5e97d4b9 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -1,24 +1,27 @@
(.module:
[lux (#- Module)
[type (#+ :share)]
+ ["@" target (#+ Host)]
[abstract
["." monad (#+ Monad do)]]
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]]
[data
+ [binary (#+ Binary)]
["." bit]
["." product]
- [text
+ ["." text
["%" format (#+ format)]]
[collection
- ["." list]]]
+ ["." list]
+ ["." row ("#@." functor)]]]
[world
- ["." file (#+ File)]]]
+ ["." file (#+ Path)]]]
["." // #_
["#." init]
- ["/#" //
+ ["/#" // (#+ Output)
["#." phase]
[language
[lux
@@ -36,7 +39,8 @@
["." archive (#+ Archive)
[descriptor (#+ Module)]]
[io
- ["." context]]]]]
+ ["." context]
+ ["ioW" archive]]]]]
[program
[compositor
["." cli (#+ Configuration)]]])
@@ -45,22 +49,38 @@
{#&file-system (file.System Promise)
#host (///generation.Host expression directive)
#phase (///generation.Phase anchor expression directive)
- #runtime (///generation.Operation anchor expression directive Any)})
-
-## (def: (write-module target-dir file-name module-name module outputs)
-## (-> File Text Text Module Outputs (Process Any))
-## (do (try.with io.monad)
-## [_ (monad.map @ (product.uncurry (&io.write target-dir))
-## (dictionary.entries outputs))]
-## (&io.write target-dir
-## (format module-name "/" cache.descriptor-name)
-## (encoding.to-utf8 (%.code (cache/description.write file-name module))))))
+ #runtime (///generation.Operation anchor expression directive Any)
+ #write (-> directive Binary)})
(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))]
+ (def: (cache-module platform host target-dir module-file-name module-name output ## module
+ )
+ (All <type-vars>
+ (-> <Platform> Host Path Path Text Output ## Module
+ (Promise (Try Any))))
+ (let [system (get@ #&file-system platform)
+ write-artifact! (: (-> [Text Binary] (Promise (Try Any)))
+ (function (_ [name content])
+ (ioW.write system host target-dir module-name name content)))]
+ (do (try.with promise.monad)
+ [_ (ioW.prepare system host target-dir module-name)
+ _ (|> output
+ row.to-list
+ (monad.map promise.monad
+ write-artifact!)
+ (: (Promise (List (Try Any))))
+ (promise@map (monad.seq try.monad))
+ (: (Promise (Try (List Any)))))]
+ (wrap [])
+ ## (&io.write target-dir
+ ## (format module-name "/" cache.descriptor-name)
+ ## (encoding.to-utf8 (%.code (cache/description.write module-file-name module))))
+ )))
+
(def: pause-context
(All <type-vars>
(-> <State+> ///generation.Context))
@@ -90,10 +110,21 @@
(All <type-vars>
(///generation.Operation anchor expression directive (Buffer directive)))
(///generation.save-buffer! ""))
+
+ (def: (ensure-target! platform target host)
+ (All <type-vars>
+ (-> <Platform> Path Host (Promise (Try Any))))
+ (let [system (get@ #&file-system platform)
+ mkdir (: (-> Path (Promise (Try Any)))
+ (file.get-directory promise.monad system))]
+ (do (try.with promise.monad)
+ [_ (mkdir target)]
+ (mkdir (ioW.archive system host target)))))
- (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)
+ (def: #export (initialize target host expander host-analysis platform generation-bundle host-directive-bundle program extender)
(All <type-vars>
- (-> Text
+ (-> Path
+ Host
Expander
///analysis.Bundle
<Platform>
@@ -102,7 +133,7 @@
(-> expression directive)
Extender
(Promise (Try <State+>))))
- (let [state (//init.state target
+ (let [state (//init.state host
expander
host-analysis
(get@ #host platform)
@@ -111,14 +142,17 @@
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)))
+ (do (try.with promise.monad)
+ [_ (..ensure-target! platform target host)]
+ (|> (do ///phase.monad
+ [_ ..initialize-buffer!
+ _ (..compile-runtime! platform)
+ buffer ..save-runtime-buffer!]
+ (wrap []))
+ ///directive.lift-generation
+ (///phase.run' state)
+ (:: try.functor map product.left)
+ promise@wrap)))
## (case (runtimeT.generate ## (initL.compiler (io.run js.init))
## (initL.compiler (io.run hostL.init-host))
@@ -146,19 +180,19 @@
## (io.fail error))
)
- (def: #export (compile partial-host-extension expander platform configuration archive state)
+ (def: #export (compile target partial-host-extension expander platform host configuration archive state)
(All <type-vars>
- (-> Text Expander <Platform> Configuration Archive <State+> (Promise (Try [Archive <State+>]))))
+ (-> Text Text Expander <Platform> Host Configuration Archive <State+> (Promise (Try [Archive <State+>]))))
(let [source-module (get@ #cli.module configuration)
compiler (:share <type-vars>
{<State+>
state}
{(///.Compiler <State+> .Module Any)
- ((//init.compiler expander syntax.prelude) //init.key (list))})]
+ ((//init.compiler expander syntax.prelude (get@ #write platform)) //init.key (list))})]
(loop [module source-module
[archive state] [archive state]]
(if (archive.archived? archive module)
- (:: promise.monad wrap (#try.Success [archive state]))
+ (promise@wrap (#try.Success [archive state]))
(let [import! (:share <type-vars>
{<Platform>
platform}
@@ -169,10 +203,7 @@
[input (context.read (get@ #&file-system platform)
(get@ #cli.sources configuration)
partial-host-extension
- module)
- ## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
- ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs)
- ]
+ module)]
(loop [archive archive
state (..resume-context (///generation.fresh-context module) state)
compilation (compiler (:coerce ///.Input input))]
@@ -216,13 +247,22 @@
(continue! archive state more)
(#.Right [descriptor+document output])
- (case (archive.add module descriptor+document archive)
- (#try.Success archive)
- (wrap [archive state])
-
- (#try.Failure error)
- (:: promise.monad wrap (#try.Failure error))))
+ (do (try.with promise.monad)
+ [_ (..cache-module platform
+ host
+ target
+ (get@ #///.file input)
+ module
+ output
+ ## module
+ )]
+ (case (archive.add module descriptor+document archive)
+ (#try.Success archive)
+ (wrap [archive state])
+
+ (#try.Failure error)
+ (promise@wrap (#try.Failure error)))))
(#try.Failure error)
- (:: promise.monad wrap (#try.Failure error)))))))))))
+ (promise@wrap (#try.Failure error)))))))))))
)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index 334be5331..80e5f37e3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -261,7 +261,7 @@
(extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
#.None
- (phase.throw no-buffer-for-saving-code name))))
+ (phase.throw ..no-buffer-for-saving-code name))))
(def: #export (save-buffer! target)
(All [anchor expression directive]
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 5b33e60a3..abb8b75c6 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -1,72 +1,78 @@
(.module:
[lux (#- Module)
+ ["@" target (#+ Host)]
+ [abstract
+ [monad (#+ do)]]
[control
- monad
- ["." try]
- ["ex" exception (#+ exception:)]]
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability (#+ capability:)]]]
[data
+ [binary (#+ Binary)]
["." text
["%" format (#+ format)]]]
[world
- ["." file (#+ File System)]
- [binary (#+ Binary)]]]
- ["." // (#+ Module)
- [///
- ["." host]]])
+ ["." file (#+ Path File System)]]]
+ ["." // (#+ Module)])
-(type: #export Document File)
+(exception: #export (cannot-prepare {archive Path}
+ {module Module}
+ {error Text})
+ (exception.report
+ ["Archive" archive]
+ ["Module" module]
+ ["Error" error]))
-(exception: #export (cannot-prepare {archive File} {module Module})
- (ex.report ["Archive" archive]
- ["Module" module]))
+(def: #export (archive system host root)
+ (-> (System Promise) Host Path Path)
+ (format root (:: system separator) host))
-(def: #export (archive System<m> root)
- (All [m] (-> (System m) File File))
- (<| (format root (:: System<m> separator))
- (`` (for {(~~ (static host.common-lisp)) host.common-lisp
- (~~ (static host.js)) host.js
- (~~ (static host.old)) host.jvm
- (~~ (static host.jvm)) host.jvm
- (~~ (static host.lua)) host.lua
- (~~ (static host.php)) host.php
- (~~ (static host.python)) host.python
- (~~ (static host.r)) host.r
- (~~ (static host.ruby)) host.ruby
- (~~ (static host.scheme)) host.scheme}))))
+(def: #export (document system host root module)
+ (-> (System Promise) Host Path Module Path)
+ (format (..archive system host root)
+ (:: system separator)
+ (//.sanitize system module)))
-(def: #export (document System<m> root module)
- (All [m] (-> (System m) File Module Document))
- (let [archive (..archive System<m> root)]
- (|> module
- (//.sanitize System<m>)
- (format archive (:: System<m> separator)))))
+(def: #export (artifact system host root module name)
+ (-> (System Promise) Host Path Module Text Path)
+ (format (document system host root module)
+ (:: system separator)
+ (//.sanitize system name)))
-(def: #export (prepare System<m> root module)
- (All [m] (-> (System m) File Module (m Any)))
- (do (:: System<m> &monad)
- [#let [archive (..archive System<m> root)
- document (..document System<m> root module)]
- document-exists? (file.exists? System<m> document)]
+(def: #export (prepare system host root module)
+ (-> (System Promise) Host Path Module (Promise (Try Any)))
+ (do promise.monad
+ [#let [document (..document system host root module)]
+ document-exists? (file.exists? promise.monad system document)]
(if document-exists?
- (wrap [])
+ (wrap (#try.Success []))
(do @
- [outcome (:: System<m> try (:: System<m> make-directory document))]
+ [outcome (!.use (:: system create-directory) document)]
(case outcome
(#try.Success output)
- (wrap output)
+ (wrap (#try.Success []))
- (#try.Failure _)
- (:: System<m> throw cannot-prepare [archive module]))))))
+ (#try.Failure error)
+ (wrap (exception.throw ..cannot-prepare [(..archive system host root)
+ module
+ error])))))))
-(def: #export (write System<m> root content name)
- (All [m] (-> (System m) File Binary Text (m Any)))
- (:: System<m> write content (..document System<m> root name)))
+(def: #export (write system host root module name content)
+ (-> (System Promise) Host Path Module Text Binary (Promise (Try Any)))
+ (do (try.with promise.monad)
+ [artifact (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad system
+ (..artifact system host root module name)))]
+ (!.use (:: artifact over-write) content)))
-(def: #export (module System<m> root document)
- (All [m] (-> (System m) File Document (Maybe Module)))
- (case (text.split-with (..archive System<m> root) document)
+(def: #export (module system host root document)
+ (-> (System Promise) Host Path Path (Maybe Module))
+ (case (text.split-with (..archive system host root) document)
(#.Some ["" post])
- (let [raw (text.replace-all (:: System<m> separator) "/" post)]
+ (let [raw (text.replace-all (:: system separator) "/" post)]
(if (text.starts-with? "/" raw)
(text.clip' 1 raw)
(#.Some raw)))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 1313386d5..dddac7e49 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -18,10 +18,10 @@
[world
["." file (#+ Path File)]]]
["." // (#+ Context Code)
- ["#/" // #_
+ ["/#" // #_
[archive
[descriptor (#+ Module)]]
- ["#/" // (#+ Input)]]])
+ ["/#" // (#+ Input)]]])
(template [<name>]
[(exception: #export (<name> {module Module})
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 7bcc07d7c..43e58cf50 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
[type (#+ :share)]
+ ["@" target (#+ Host)]
[abstract
[monad (#+ do)]]
[control
@@ -87,15 +88,16 @@
(:: promise.monad wrap (#try.Failure error)))))
(def: #export (compiler target partial-host-extension
- expander host-analysis platform generation-bundle host-directive-bundle program extender
+ expander host-analysis platform host generation-bundle host-directive-bundle program extender
service
packager,package)
(All [<parameters>]
- (-> Text
+ (-> Path
Text
Expander
analysis.Bundle
(IO (Platform <parameters>))
+ Host
(generation.Bundle <parameters>)
(directive.Bundle <parameters>)
(-> expression artifact)
@@ -116,12 +118,12 @@
{(Platform <parameters>)
platform}
{(Promise (Try (directive.State+ <parameters>)))
- (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
+ (platform.initialize target host 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)})
+ (platform.compile target partial-host-extension expander platform host configuration archive.empty state)})
_ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
## _ (cache/io.clean target ...)
]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 00:54:41 +0000