aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/tool/compiler/meta
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/tool/compiler/meta')
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux (renamed from stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux)0
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux99
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/module.lux139
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cli.lux22
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux61
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux5
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux5
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/packager/script.lux5
9 files changed, 184 insertions, 155 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux
index 327cae965..327cae965 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux
new file mode 100644
index 000000000..01c37431f
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux
@@ -0,0 +1,99 @@
+(.using
+ [library
+ [lux "*"
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" maybe ("[1]#[0]" functor)]
+ ["[0]" try {"+" Try}]
+ ["[0]" state]
+ [function
+ ["[0]" memo {"+" Memo}]]]
+ [data
+ ["[0]" text
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor mix)]
+ ["[0]" dictionary {"+" Dictionary}]
+ ["[0]" set {"+" Set}]]]]]
+ [////
+ ["[0]" archive {"+" Output Archive}
+ [key {"+" Key}]
+ ["[0]" module
+ ["[0]" descriptor {"+" Descriptor}]
+ ["[0]" document {"+" Document}]]]])
+
+(type: .public Ancestry
+ (Set descriptor.Module))
+
+(def: fresh
+ Ancestry
+ (set.empty text.hash))
+
+(type: .public Graph
+ (Dictionary descriptor.Module Ancestry))
+
+(def: empty
+ Graph
+ (dictionary.empty text.hash))
+
+(def: .public modules
+ (-> Graph (List descriptor.Module))
+ dictionary.keys)
+
+(type: .public Dependency
+ (Record
+ [#module descriptor.Module
+ #imports Ancestry]))
+
+(def: .public graph
+ (-> (List Dependency) Graph)
+ (list#mix (function (_ [module imports] graph)
+ (dictionary.has module imports graph))
+ ..empty))
+
+(def: (ancestry archive)
+ (-> Archive Graph)
+ (let [memo (: (Memo descriptor.Module Ancestry)
+ (function (_ again module)
+ (do [! state.monad]
+ [.let [parents (case (archive.find module archive)
+ {try.#Success [module output registry]}
+ (value@ [module.#descriptor descriptor.#references] module)
+
+ {try.#Failure error}
+ ..fresh)]
+ ancestors (monad.each ! again (set.list parents))]
+ (in (list#mix set.union parents ancestors)))))
+ ancestry (memo.open memo)]
+ (list#mix (function (_ module memory)
+ (if (dictionary.key? memory module)
+ memory
+ (let [[memory _] (ancestry [memory module])]
+ memory)))
+ ..empty
+ (archive.archived archive))))
+
+(def: (dependency? ancestry target source)
+ (-> Graph descriptor.Module descriptor.Module Bit)
+ (let [target_ancestry (|> ancestry
+ (dictionary.value target)
+ (maybe.else ..fresh))]
+ (set.member? target_ancestry source)))
+
+(type: .public (Order a)
+ (List [descriptor.Module [module.ID (archive.Entry a)]]))
+
+(def: .public (load_order key archive)
+ (All (_ a) (-> (Key a) Archive (Try (Order a))))
+ (let [ancestry (..ancestry archive)]
+ (|> ancestry
+ dictionary.keys
+ (list.sorted (..dependency? ancestry))
+ (monad.each try.monad
+ (function (_ module)
+ (do try.monad
+ [module_id (archive.id module archive)
+ entry (archive.find module archive)
+ document (document.marked? key (value@ [archive.#module module.#document] entry))]
+ (in [module [module_id (with@ [archive.#module module.#document] document entry)]])))))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
index ce408795a..b4c122ec6 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
@@ -2,98 +2,63 @@
[library
[lux "*"
[abstract
- ["[0]" monad {"+" do}]]
+ [monad {"+" do}]]
[control
- ["[0]" maybe ("[1]#[0]" functor)]
+ [pipe {"+" case>}]
["[0]" try {"+" Try}]
- ["[0]" state]
- [function
- ["[0]" memo {"+" Memo}]]]
+ ["[0]" exception {"+" exception:}]
+ [concurrency
+ ["[0]" async {"+" Async}]]]
[data
- ["[0]" text
- ["%" format {"+" format}]]
- [collection
- ["[0]" list ("[1]#[0]" functor mix)]
- ["[0]" dictionary {"+" Dictionary}]
- ["[0]" set {"+" Set}]]]]]
- [///
- ["[0]" archive {"+" Output Archive}
- [key {"+" Key}]
- ["[0]" module
- ["[0]" descriptor {"+" Descriptor}]
- ["[0]" document {"+" Document}]]]])
+ [text
+ ["%" format {"+" format}]]]
+ [world
+ ["[0]" file]]]]
+ ["[0]" //
+ [//
+ [context {"+" Context}]
+ [archive
+ ["[0]" module]]]])
-(type: .public Ancestry
- (Set descriptor.Module))
+(exception: .public (cannot_enable [archive file.Path
+ @module module.ID
+ error Text])
+ (exception.report
+ ["Archive" archive]
+ ["Module ID" (%.nat @module)]
+ ["Error" error]))
-(def: fresh
- Ancestry
- (set.empty text.hash))
+(def: .public (path fs context @module)
+ (All (_ !) (-> (file.System !) Context module.ID file.Path))
+ (format (//.path fs context)
+ (# fs separator)
+ (%.nat @module)))
-(type: .public Graph
- (Dictionary descriptor.Module Ancestry))
+(def: .public (enabled? fs context @module)
+ (All (_ !) (-> (file.System !) Context module.ID (! Bit)))
+ (# fs directory? (..path fs context @module)))
-(def: empty
- Graph
- (dictionary.empty text.hash))
+(def: .public (enable! fs context @module)
+ (-> (file.System Async) Context module.ID (Async (Try Any)))
+ (do [! async.monad]
+ [.let [path (..path fs context @module)]
+ module_exists? (# fs directory? path)]
+ (if module_exists?
+ (in {try.#Success []})
+ (with_expansions [<failure> (exception.except ..cannot_enable [(//.path fs context)
+ @module
+ error])]
+ (do !
+ [? (//.enable! fs context)]
+ (case ?
+ {try.#Failure error}
+ (in <failure>)
+
+ success
+ (|> path
+ (# fs make_directory)
+ (# ! each (|>> (case> {try.#Failure error}
+ <failure>
-(def: .public modules
- (-> Graph (List descriptor.Module))
- dictionary.keys)
-
-(type: .public Dependency
- (Record
- [#module descriptor.Module
- #imports Ancestry]))
-
-(def: .public graph
- (-> (List Dependency) Graph)
- (list#mix (function (_ [module imports] graph)
- (dictionary.has module imports graph))
- ..empty))
-
-(def: (ancestry archive)
- (-> Archive Graph)
- (let [memo (: (Memo descriptor.Module Ancestry)
- (function (_ again module)
- (do [! state.monad]
- [.let [parents (case (archive.find module archive)
- {try.#Success [module output registry]}
- (value@ [module.#descriptor descriptor.#references] module)
-
- {try.#Failure error}
- ..fresh)]
- ancestors (monad.each ! again (set.list parents))]
- (in (list#mix set.union parents ancestors)))))
- ancestry (memo.open memo)]
- (list#mix (function (_ module memory)
- (if (dictionary.key? memory module)
- memory
- (let [[memory _] (ancestry [memory module])]
- memory)))
- ..empty
- (archive.archived archive))))
-
-(def: (dependency? ancestry target source)
- (-> Graph descriptor.Module descriptor.Module Bit)
- (let [target_ancestry (|> ancestry
- (dictionary.value target)
- (maybe.else ..fresh))]
- (set.member? target_ancestry source)))
-
-(type: .public (Order a)
- (List [descriptor.Module [module.ID (archive.Entry a)]]))
-
-(def: .public (load_order key archive)
- (All (_ a) (-> (Key a) Archive (Try (Order a))))
- (let [ancestry (..ancestry archive)]
- (|> ancestry
- dictionary.keys
- (list.sorted (..dependency? ancestry))
- (monad.each try.monad
- (function (_ module)
- (do try.monad
- [module_id (archive.id module archive)
- entry (archive.find module archive)
- document (document.marked? key (value@ [archive.#module module.#document] entry))]
- (in [module [module_id (with@ [archive.#module module.#document] document entry)]])))))))
+ success
+ success))))))))))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli.lux b/stdlib/source/library/lux/tool/compiler/meta/cli.lux
index f13f1596c..a9f5d67a5 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cli.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cli.lux
@@ -84,20 +84,20 @@
(def: .public service
(Parser Service)
- (let [compiler (: (Parser Compilation)
- ($_ <>.and
- (<>.some ..host_dependency_parser)
- (<>.some ..library_parser)
- (<>.some ..compiler_parser)
- (<>.some ..source_parser)
- ..target_parser
- ..module_parser
- ..configuration_parser))]
+ (let [compilation (: (Parser Compilation)
+ ($_ <>.and
+ (<>.some ..host_dependency_parser)
+ (<>.some ..library_parser)
+ (<>.some ..compiler_parser)
+ (<>.some ..source_parser)
+ ..target_parser
+ ..module_parser
+ (<>.else configuration.empty ..configuration_parser)))]
($_ <>.or
(<>.after (<cli>.this "build")
- compiler)
+ compilation)
(<>.after (<cli>.this "repl")
- compiler)
+ compilation)
(<>.after (<cli>.this "export")
($_ <>.and
(<>.some ..source_parser)
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 13e848153..46055f00d 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -45,7 +45,9 @@
["[0]" descriptor {"+" Descriptor}]
["[0]" document {"+" Document}]]]
["[0]" cache
- ["[1]/[0]" module]]
+ ["[1]/[0]" module]
+ ["[0]" dependency "_"
+ ["[1]" module]]]
["/[1]" // {"+" Input}
[language
["$" lux
@@ -55,54 +57,13 @@
["[0]" directive]
["[1]/[0]" program]]]]]])
-(exception: .public (cannot_prepare [archive file.Path
- module_id module.ID
- error Text])
- (exception.report
- ["Archive" archive]
- ["Module ID" (%.nat module_id)]
- ["Error" error]))
-
-(def: (module fs context module_id)
- (All (_ !) (-> (file.System !) Context module.ID file.Path))
- (format (cache.path fs context)
- (# fs separator)
- (%.nat module_id)))
-
(def: .public (artifact fs context module_id artifact_id)
(All (_ !) (-> (file.System !) Context module.ID artifact.ID file.Path))
- (format (..module fs context module_id)
+ (format (cache/module.path fs context module_id)
(# fs separator)
(%.nat artifact_id)
(value@ context.#artifact_extension context)))
-(def: (ensure_directory fs path)
- (-> (file.System Async) file.Path (Async (Try Any)))
- (do async.monad
- [? (# fs directory? path)]
- (if ?
- (in {try.#Success []})
- (# fs make_directory path))))
-
-(def: .public (prepare fs context module_id)
- (-> (file.System Async) Context module.ID (Async (Try Any)))
- (do [! async.monad]
- [.let [module (..module fs context module_id)]
- module_exists? (# fs directory? module)]
- (if module_exists?
- (in {try.#Success []})
- (do (try.with !)
- [_ (cache.enable! fs context)]
- (|> module
- (# fs make_directory)
- (# ! each (|>> (case> {try.#Success output}
- {try.#Success []}
-
- {try.#Failure error}
- (exception.except ..cannot_prepare [(cache.path fs context)
- module_id
- error])))))))))
-
(def: .public (write fs context module_id artifact_id content)
(-> (file.System Async) Context module.ID artifact.ID Binary (Async (Try Any)))
(# fs write content (..artifact fs context module_id artifact_id)))
@@ -122,7 +83,7 @@
(def: (module_descriptor fs context module_id)
(-> (file.System Async) Context module.ID file.Path)
- (format (..module fs context module_id)
+ (format (cache/module.path fs context module_id)
(# fs separator)
..module_descriptor_file))
@@ -168,7 +129,7 @@
(def: (cached_artifacts fs context module_id)
(-> (file.System Async) Context module.ID (Async (Try (Dictionary Text Binary))))
(let [! (try.with async.monad)]
- (|> (..module fs context module_id)
+ (|> (cache/module.path fs context module_id)
(# fs directory_files)
(# ! each (|>> (list#each (function (_ file)
[(file.name fs file) file]))
@@ -356,7 +317,7 @@
(def: (purge! fs context [module_name module_id])
(-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any)))
(do [! (try.with async.monad)]
- [.let [cache (..module fs context module_id)]
+ [.let [cache (cache/module.path fs context module_id)]
_ (|> cache
(# fs directory_files)
(# ! each (monad.each ! (# fs delete)))
@@ -389,7 +350,7 @@
(def: (full_purge caches load_order)
(-> (List [Bit Cache])
- (cache/module.Order .Module)
+ (dependency.Order .Module)
Purge)
(list#mix (function (_ [module_name [module_id entry]] purge)
(let [purged? (: (Predicate descriptor.Module)
@@ -436,7 +397,7 @@
(def: (load_order archive pre_loaded_caches)
(-> Archive (List [Bit Cache])
- (Try (cache/module.Order .Module)))
+ (Try (dependency.Order .Module)))
(|> pre_loaded_caches
(monad.mix try.monad
(function (_ [_ [module [module_id [|module| registry]]]] archive)
@@ -446,13 +407,13 @@
archive.#registry registry]
archive))
archive)
- (# try.monad each (cache/module.load_order $.key))
+ (# try.monad each (dependency.load_order $.key))
(# try.monad conjoint)))
(def: (loaded_caches host_environment fs context purge load_order)
(All (_ expression directive)
(-> (generation.Host expression directive) (file.System Async) Context
- Purge (cache/module.Order .Module)
+ Purge (dependency.Order .Module)
(Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles])))))
(do [! (try.with async.monad)]
[... TODO: Stop needing to wrap this expression in an unnecessary "do" expression.
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
index 94b6f798e..51f9069d0 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
@@ -14,7 +14,8 @@
["[0]" file]]]]
[//
["[0]" cache "_"
- ["[1]/[0]" module]]
+ [dependency
+ ["[1]/[0]" module]]]
["[0]" archive {"+" Archive}
["[0]" artifact]
["[0]" registry]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
index 4b5a82a43..9b84fa64d 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
@@ -35,8 +35,9 @@
["[0]" module
["[0]" descriptor {"+" Module}]]]
["[0]" cache "_"
- ["[1]/[0]" module]
- ["[1]/[0]" artifact]]
+ [dependency
+ ["[1]/[0]" module]
+ ["[1]/[0]" artifact]]]
["[0]" io "_"
["[1]" archive]]
[//
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
index fb4d43410..85eb525cf 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
@@ -35,8 +35,9 @@
["[0]" descriptor]
["[0]" document {"+" Document}]]]
["[0]" cache "_"
- ["[1]/[0]" module {"+" Order}]
- ["[1]/[0]" artifact]]
+ [dependency
+ ["[1]/[0]" module {"+" Order}]
+ ["[1]/[0]" artifact]]]
["[0]" io "_"
["[1]" archive]]
[//
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
index 5843f0670..f3cc4f7a0 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux
@@ -25,8 +25,9 @@
["[0]" module
["[0]" descriptor]]]
["[0]" cache "_"
- ["[1]/[0]" module]
- ["[1]/[0]" artifact]]
+ [dependency
+ ["[1]/[0]" module]
+ ["[1]/[0]" artifact]]]
["[0]" io "_"
["[1]" archive]]
[//
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-18 04:56:23 +0000