aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library')
-rw-r--r--stdlib/source/library/lux/target/python.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux13
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux131
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux131
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache.lux18
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux24
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux4
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/cache/module.lux57
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux101
9 files changed, 255 insertions, 227 deletions
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index 45430e7e9..bd3d68711 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -1,6 +1,6 @@
(.using
[library
- [lux {"-" Location Code Label not or and list if int comment exec try}
+ [lux {"-" Location Code not or and list if int comment exec try}
["@" target]
["[0]" ffi]
[abstract
@@ -99,7 +99,6 @@
[Literal Computation]
[Access Location]
[Loop Statement]
- [Label Code]
)
(template [<var> <brand>]
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index 787866710..d9d794a7b 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -54,6 +54,7 @@
[import {"+" Import}]
["[0]" context {"+" Context}]
["[0]" cache
+ ["[1]/[0]" archive]
["[1]/[0]" module]
["[1]/[0]" artifact]]
[cli {"+" Compilation Library}
@@ -110,9 +111,10 @@
(let [system (value@ #&file_system platform)
write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any))
(function (_ [artifact_id custom content])
- (cache/artifact.write! system context module_id artifact_id content)))]
+ (cache/artifact.cache! system context module_id artifact_id content)))]
(do [! ..monad]
- [_ (cache/module.enable! system context module_id)
+ [_ (: (Async (Try Any))
+ (cache/module.enable! async.monad system context module_id))
_ (for [@.python (|> entry
(value@ archive.#output)
sequence.list
@@ -131,7 +133,7 @@
(with@ module.#document document))
(value@ archive.#registry entry)]
(_.result ..writer)
- (ioW.cache system context module_id)))))
+ (cache/module.cache! system context module_id)))))
... TODO: Inline ASAP
(def: initialize_buffer!
@@ -264,7 +266,8 @@
(value@ #host platform)
(value@ #phase platform)
generation_bundle)]
- _ (cache.enable! (value@ #&file_system platform) context)
+ _ (: (Async (Try Any))
+ (cache.enable! async.monad (value@ #&file_system platform) context))
[archive analysis_state bundles] (ioW.thaw compilation_configuration (value@ #host platform) (value@ #&file_system platform) context import compilation_sources)
.let [with_missing_extensions
(: (All (_ <type_vars>)
@@ -720,7 +723,7 @@
{try.#Failure error}
(do !
- [_ (ioW.freeze (value@ #&file_system platform) context archive)]
+ [_ (cache/archive.cache! (value@ #&file_system platform) context archive)]
(async#in {try.#Failure error}))))))))
(exception: .public (invalid_custom_compiler [definition Symbol
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux
index e074f1f92..7312fb9de 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux
@@ -1,100 +1,105 @@
(.using
- [library
- [lux "*"
- ["[0]" ffi]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["<>" parser
- ["<c>" code {"+" Parser}]]]
- [data
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" dictionary]
- ["[0]" list]]]
- ["[0]" type
- ["[0]" check]]
- ["@" target
- ["_" php]]]]
+ [library
+ [lux "*"
+ ["[0]" ffi]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["<>" parser
+ ["<c>" code {"+" Parser}]]]
+ [data
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" dictionary]
+ ["[0]" list]]]
+ ["[0]" type
+ ["[0]" check]]
+ ["@" target
+ ["_" php]]]]
+ [//
+ ["/" lux {"+" custom}]
[//
- ["/" lux {"+" custom}]
+ ["[0]" bundle]
[//
- ["[0]" bundle]
+ ["[0]" analysis "_"
+ ["[1]/[0]" type]]
[//
- ["[0]" analysis "_"
- ["[1]/[0]" type]]
- [//
- ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}]
- [///
- ["[0]" phase]]]]]])
+ ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}]
+ [///
+ ["[0]" phase]]]]]])
(def: array::new
Handler
(custom
[<c>.any
(function (_ extension phase archive lengthC)
- (do phase.monad
- [lengthA (analysis/type.with_type Nat
- (phase archive lengthC))
- [var_id varT] (analysis/type.with_env check.var)
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list lengthA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [lengthA (analysis/type.with_type Nat
+ (phase archive lengthC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list lengthA)}))))]))
(def: array::length
Handler
(custom
[<c>.any
(function (_ extension phase archive arrayC)
- (do phase.monad
- [[var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer Nat)]
- (in {analysis.#Extension extension (list arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer Nat)]
+ (in {analysis.#Extension extension (list arrayA)}))))]))
(def: array::read
Handler
(custom
[(<>.and <c>.any <c>.any)
(function (_ extension phase archive [indexC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer varT)]
- (in {analysis.#Extension extension (list indexA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer :var:)]
+ (in {analysis.#Extension extension (list indexA arrayA)}))))]))
(def: array::write
Handler
(custom
[($_ <>.and <c>.any <c>.any <c>.any)
(function (_ extension phase archive [indexC valueC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- valueA (analysis/type.with_type varT
- (phase archive valueC))
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list indexA valueA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ valueA (analysis/type.with_type :var:
+ (phase archive valueC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list indexA valueA arrayA)}))))]))
(def: array::delete
Handler
(custom
[($_ <>.and <c>.any <c>.any)
(function (_ extension phase archive [indexC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list indexA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list indexA arrayA)}))))]))
(def: bundle::array
Bundle
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux
index 3dd40cd28..659191e2f 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux
@@ -1,100 +1,105 @@
(.using
- [library
- [lux "*"
- ["[0]" ffi]
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["<>" parser
- ["<c>" code {"+" Parser}]]]
- [data
- [collection
- ["[0]" array {"+" Array}]
- ["[0]" dictionary]
- ["[0]" list]]]
- ["[0]" type
- ["[0]" check]]
- ["@" target
- ["_" scheme]]]]
+ [library
+ [lux "*"
+ ["[0]" ffi]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["<>" parser
+ ["<c>" code {"+" Parser}]]]
+ [data
+ [collection
+ ["[0]" array {"+" Array}]
+ ["[0]" dictionary]
+ ["[0]" list]]]
+ ["[0]" type
+ ["[0]" check]]
+ ["@" target
+ ["_" scheme]]]]
+ [//
+ ["/" lux {"+" custom}]
[//
- ["/" lux {"+" custom}]
+ ["[0]" bundle]
[//
- ["[0]" bundle]
+ ["[0]" analysis "_"
+ ["[1]/[0]" type]]
[//
- ["[0]" analysis "_"
- ["[1]/[0]" type]]
- [//
- ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}]
- [///
- ["[0]" phase]]]]]])
+ ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}]
+ [///
+ ["[0]" phase]]]]]])
(def: array::new
Handler
(custom
[<c>.any
(function (_ extension phase archive lengthC)
- (do phase.monad
- [lengthA (analysis/type.with_type Nat
- (phase archive lengthC))
- [var_id varT] (analysis/type.with_env check.var)
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list lengthA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [lengthA (analysis/type.with_type Nat
+ (phase archive lengthC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list lengthA)}))))]))
(def: array::length
Handler
(custom
[<c>.any
(function (_ extension phase archive arrayC)
- (do phase.monad
- [[var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer Nat)]
- (in {analysis.#Extension extension (list arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer Nat)]
+ (in {analysis.#Extension extension (list arrayA)}))))]))
(def: array::read
Handler
(custom
[(<>.and <c>.any <c>.any)
(function (_ extension phase archive [indexC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer varT)]
- (in {analysis.#Extension extension (list indexA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer :var:)]
+ (in {analysis.#Extension extension (list indexA arrayA)}))))]))
(def: array::write
Handler
(custom
[($_ <>.and <c>.any <c>.any <c>.any)
(function (_ extension phase archive [indexC valueC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- valueA (analysis/type.with_type varT
- (phase archive valueC))
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list indexA valueA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ valueA (analysis/type.with_type :var:
+ (phase archive valueC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list indexA valueA arrayA)}))))]))
(def: array::delete
Handler
(custom
[($_ <>.and <c>.any <c>.any)
(function (_ extension phase archive [indexC arrayC])
- (do phase.monad
- [indexA (analysis/type.with_type Nat
- (phase archive indexC))
- [var_id varT] (analysis/type.with_env check.var)
- arrayA (analysis/type.with_type (type (Array varT))
- (phase archive arrayC))
- _ (analysis/type.infer (type (Array varT)))]
- (in {analysis.#Extension extension (list indexA arrayA)})))]))
+ (<| analysis/type.with_var
+ (function (_ [@var :var:]))
+ (do phase.monad
+ [indexA (analysis/type.with_type Nat
+ (phase archive indexC))
+ arrayA (analysis/type.with_type (type (Array :var:))
+ (phase archive arrayC))
+ _ (analysis/type.infer (type (Array :var:)))]
+ (in {analysis.#Extension extension (list indexA arrayA)}))))]))
(def: bundle::array
Bundle
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache.lux b/stdlib/source/library/lux/tool/compiler/meta/cache.lux
index d9ed86253..6b4194359 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache.lux
@@ -2,11 +2,9 @@
[library
[lux "*"
[abstract
- [monad {"+" do}]]
+ [monad {"+" Monad do}]]
[control
- ["[0]" try {"+" Try}]
- [concurrency
- ["[0]" async {"+" Async}]]]
+ ["[0]" try {"+" Try}]]
[data
[text
["%" format {"+" format}]]]
@@ -25,14 +23,12 @@
/ (version.format //.version))))
(def: .public (enabled? fs context)
- (-> (file.System Async) Context (Async Bit))
- (|> context
- (..path fs)
- (# fs directory?)))
+ (All (_ !) (-> (file.System !) Context (! Bit)))
+ (# fs directory? (..path fs context)))
-(def: .public (enable! fs context)
- (-> (file.System Async) Context (Async (Try Any)))
- (do [! async.monad]
+(def: .public (enable! ! fs context)
+ (All (_ !) (-> (Monad !) (file.System !) Context (! (Try Any))))
+ (do !
[? (..enabled? fs context)]
(if ?
(in {try.#Success []})
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux
new file mode 100644
index 000000000..28abd457a
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux
@@ -0,0 +1,24 @@
+(.using
+ [library
+ [lux "*"
+ [control
+ [try {"+" Try}]]
+ [data
+ [text
+ ["%" format]]]
+ [world
+ ["[0]" file]]]]
+ ["[0]" //
+ ["/[1]" //
+ [context {"+" Context}]
+ ["[0]" archive {"+" Archive}]]])
+
+(def: .public (descriptor fs context)
+ (All (_ !) (-> (file.System !) Context file.Path))
+ (%.format (//.path fs context)
+ (# fs separator)
+ "descriptor"))
+
+(def: .public (cache! fs context it)
+ (All (_ !) (-> (file.System !) Context Archive (! (Try Any))))
+ (# fs write (archive.export ///.version it) (..descriptor fs context)))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
index d294bc51a..fd63495d1 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux
@@ -28,12 +28,12 @@
(%.nat @artifact)
(value@ context.#artifact_extension context)))
-(def: .public (read! fs context @module @artifact)
+(def: .public (cache fs context @module @artifact)
(All (_ !)
(-> (file.System !) Context module.ID artifact.ID (! (Try Binary))))
(# fs read (..path fs context @module @artifact)))
-(def: .public (write! fs context @module @artifact content)
+(def: .public (cache! fs context @module @artifact content)
(All (_ !)
(-> (file.System !) Context module.ID artifact.ID Binary (! (Try Any))))
(# fs write content (..path fs context @module @artifact)))
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 b4c122ec6..143b3bce9 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux
@@ -1,17 +1,21 @@
(.using
[library
[lux "*"
+ ["@" target]
[abstract
- [monad {"+" do}]]
+ ["[0]" monad {"+" Monad do}]]
[control
[pipe {"+" case>}]
["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
- [concurrency
- ["[0]" async {"+" Async}]]]
+ ["[0]" exception {"+" exception:}]]
[data
- [text
- ["%" format {"+" format}]]]
+ [binary {"+" Binary}]
+ ["[0]" product]
+ ["[0]" text ("[1]#[0]" equivalence)
+ ["%" format {"+" format}]]
+ [collection
+ ["[0]" list ("[1]#[0]" functor)]
+ ["[0]" dictionary {"+" Dictionary}]]]
[world
["[0]" file]]]]
["[0]" //
@@ -38,9 +42,9 @@
(All (_ !) (-> (file.System !) Context module.ID (! Bit)))
(# fs directory? (..path fs context @module)))
-(def: .public (enable! fs context @module)
- (-> (file.System Async) Context module.ID (Async (Try Any)))
- (do [! async.monad]
+(def: .public (enable! ! fs context @module)
+ (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try Any))))
+ (do !
[.let [path (..path fs context @module)]
module_exists? (# fs directory? path)]
(if module_exists?
@@ -49,7 +53,7 @@
@module
error])]
(do !
- [? (//.enable! fs context)]
+ [? (//.enable! ! fs context)]
(case ?
{try.#Failure error}
(in <failure>)
@@ -62,3 +66,36 @@
success
success))))))))))
+
+(def: file
+ file.Path
+ "descriptor")
+
+(def: .public (descriptor fs context @module)
+ (All (_ !) (-> (file.System !) Context module.ID file.Path))
+ (format (..path fs context @module)
+ (# fs separator)
+ ..file))
+
+(def: .public (cache! fs context @module content)
+ (All (_ !) (-> (file.System !) Context module.ID Binary (! (Try Any))))
+ (# fs write content (..descriptor fs context @module)))
+
+(def: .public (cache fs context @module)
+ (All (_ !) (-> (file.System !) Context module.ID (! (Try Binary))))
+ (# fs read (..descriptor fs context @module)))
+
+(def: .public (artifacts ! fs context @module)
+ (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try (Dictionary Text Binary)))))
+ (do [! (try.with !)]
+ [files (# fs directory_files (..path fs context @module))
+ pairs (|> files
+ (list#each (function (_ file)
+ [(file.name fs file) file]))
+ (list.only (|>> product.left (text#= ..file) not))
+ (monad.each ! (function (_ [name path])
+ (|> path
+ (# fs read)
+ (# ! each (|>> [name]))))))]
+ (in (dictionary.of_list text.hash (for [@.old (:as (List [Text Binary]) pairs)]
+ pairs)))))
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 5c6340f86..346a05e56 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -6,9 +6,7 @@
[predicate {"+" Predicate}]
["[0]" monad {"+" do}]]
[control
- [pipe {"+" case>}]
["[0]" try {"+" Try}]
- ["[0]" exception {"+" exception:}]
[concurrency
["[0]" async {"+" Async} ("[1]#[0]" monad)]]
["<>" parser
@@ -45,6 +43,7 @@
["[0]" descriptor {"+" Descriptor}]
["[0]" document {"+" Document}]]]
["[0]" cache
+ ["[1]/[0]" archive]
["[1]/[0]" module]
["[0]" dependency "_"
["[1]" module]]]
@@ -57,33 +56,6 @@
["[0]" directive]
["[1]/[0]" program]]]]]])
-(def: (general_descriptor fs context)
- (-> (file.System Async) Context file.Path)
- (format (cache.path fs context)
- (# fs separator)
- "general_descriptor"))
-
-(def: .public (freeze fs context archive)
- (-> (file.System Async) Context Archive (Async (Try Any)))
- (# fs write (archive.export ///.version archive) (..general_descriptor fs context)))
-
-(def: module_descriptor_file
- "module_descriptor")
-
-(def: (module_descriptor fs context module_id)
- (-> (file.System Async) Context module.ID file.Path)
- (format (cache/module.path fs context module_id)
- (# fs separator)
- ..module_descriptor_file))
-
-(def: .public (cache fs context module_id content)
- (-> (file.System Async) Context module.ID Binary (Async (Try Any)))
- (# fs write content (..module_descriptor fs context module_id)))
-
-(def: (read_module_descriptor fs context module_id)
- (-> (file.System Async) Context module.ID (Async (Try Binary)))
- (# fs read (..module_descriptor fs context module_id)))
-
(def: module_parser
(Parser (module.Module .Module))
($_ <>.and
@@ -115,21 +87,6 @@
(archive.archived archive)))]
(in (with@ .#modules modules (fresh_analysis_state host configuration)))))
-(def: (cached_artifacts fs context module_id)
- (-> (file.System Async) Context module.ID (Async (Try (Dictionary Text Binary))))
- (let [! (try.with async.monad)]
- (|> (cache/module.path fs context module_id)
- (# fs directory_files)
- (# ! each (|>> (list#each (function (_ file)
- [(file.name fs file) file]))
- (list.only (|>> product.left (text#= ..module_descriptor_file) not))
- (monad.each ! (function (_ [name path])
- (|> path
- (# fs read)
- (# ! each (|>> [name])))))
- (# ! each (dictionary.of_list text.hash))))
- (# ! conjoint))))
-
(type: Definitions (Dictionary Text Any))
(type: Analysers (Dictionary Text analysis.Handler))
(type: Synthesizers (Dictionary Text synthesis.Handler))
@@ -149,7 +106,7 @@
(dictionary.empty text.hash)
(dictionary.empty text.hash)])
-(def: (loaded_document extension host module_id expected actual document)
+(def: (loaded_document extension host @module expected actual document)
(All (_ expression directive)
(-> Text (generation.Host expression directive) module.ID (Sequence [Artifact (Set unit.ID)]) (Dictionary Text Binary) (Document .Module)
(Try [(Document .Module) Bundles Output])))
@@ -162,15 +119,15 @@
output (: Output sequence.empty)]
(let [[analysers synthesizers generators directives] bundles]
(case input
- {.#Item [[[artifact_id artifact_category mandatory_artifact?] artifact_dependencies] input']}
+ {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']}
(case (do !
- [data (try.of_maybe (dictionary.value (format (%.nat artifact_id) extension) actual))
- .let [context [module_id artifact_id]
+ [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual))
+ .let [context [@module @artifact]
directive (# host ingest context data)]]
(case artifact_category
{category.#Anonymous}
(do !
- [.let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#None} data] output)]
_ (# host re_learn context {.#None} directive)]
(in [definitions
[analysers
@@ -180,7 +137,7 @@
output]))
{category.#Definition [name function_artifact]}
- (let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ (let [output (sequence.suffix [@artifact {.#None} data] output)]
(if (text#= $/program.name name)
(in [definitions
[analysers
@@ -199,7 +156,7 @@
{category.#Analyser extension}
(do !
- [.let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#None} data] output)]
value (# host re_load context {.#None} directive)]
(in [definitions
[(dictionary.has extension (:as analysis.Handler value) analysers)
@@ -210,7 +167,7 @@
{category.#Synthesizer extension}
(do !
- [.let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#None} data] output)]
value (# host re_load context {.#None} directive)]
(in [definitions
[analysers
@@ -221,7 +178,7 @@
{category.#Generator extension}
(do !
- [.let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#None} data] output)]
value (# host re_load context {.#None} directive)]
(in [definitions
[analysers
@@ -232,7 +189,7 @@
{category.#Directive extension}
(do !
- [.let [output (sequence.suffix [artifact_id {.#None} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#None} data] output)]
value (# host re_load context {.#None} directive)]
(in [definitions
[analysers
@@ -243,7 +200,7 @@
{category.#Custom name}
(do !
- [.let [output (sequence.suffix [artifact_id {.#Some name} data] output)]
+ [.let [output (sequence.suffix [@artifact {.#Some name} data] output)]
_ (# host re_learn context {.#Some name} directive)]
(in [definitions
[analysers
@@ -287,26 +244,27 @@
(in [(document.document $.key (with@ .#definitions definitions content))
bundles])))
-(def: (load_definitions fs context module_id host_environment entry)
+(def: (load_definitions fs context @module host_environment entry)
(All (_ expression directive)
(-> (file.System Async) Context module.ID (generation.Host expression directive)
(archive.Entry .Module)
(Async (Try [(archive.Entry .Module) Bundles]))))
(do (try.with async.monad)
- [actual (cached_artifacts fs context module_id)
+ [actual (: (Async (Try (Dictionary Text Binary)))
+ (cache/module.artifacts async.monad fs context @module))
.let [expected (registry.artifacts (value@ archive.#registry entry))]
[document bundles output] (|> (value@ [archive.#module module.#document] entry)
- (loaded_document (value@ context.#artifact_extension context) host_environment module_id expected actual)
+ (loaded_document (value@ context.#artifact_extension context) host_environment @module expected actual)
async#in)]
(in [(|> entry
(with@ [archive.#module module.#document] document)
(with@ archive.#output output))
bundles])))
-(def: (purge! fs context [module_name module_id])
+(def: (purge! fs context [module_name @module])
(-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any)))
(do [! (try.with async.monad)]
- [.let [cache (cache/module.path fs context module_id)]
+ [.let [cache (cache/module.path fs context @module)]
_ (|> cache
(# fs directory_files)
(# ! each (monad.each ! (# fs delete)))
@@ -331,17 +289,17 @@
(def: initial_purge
(-> (List [Bit Cache])
Purge)
- (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]])
+ (|>> (list.all (function (_ [valid_cache? [module_name [@module _]]])
(if valid_cache?
{.#None}
- {.#Some [module_name module_id]})))
+ {.#Some [module_name @module]})))
(dictionary.of_list text.hash)))
(def: (full_purge caches load_order)
(-> (List [Bit Cache])
(dependency.Order .Module)
Purge)
- (list#mix (function (_ [module_name [module_id entry]] purge)
+ (list#mix (function (_ [module_name [@module entry]] purge)
(let [purged? (: (Predicate descriptor.Module)
(dictionary.key? purge))]
(if (purged? module_name)
@@ -350,7 +308,7 @@
(value@ [archive.#module module.#descriptor descriptor.#references])
set.list
(list.any? purged?))
- (dictionary.has module_name module_id purge)
+ (dictionary.has module_name @module purge)
purge))))
(..initial_purge caches)
load_order))
@@ -359,13 +317,14 @@
Text
"(Lux Caching System)")
-(def: (valid_cache fs context import contexts [module_name module_id])
+(def: (valid_cache fs context import contexts [module_name @module])
(-> (file.System Async) Context Import (List //.Context)
[descriptor.Module module.ID]
(Async (Try [Bit Cache])))
- (with_expansions [<cache> [module_name [module_id [module registry]]]]
+ (with_expansions [<cache> [module_name [@module [module registry]]]]
(do [! (try.with async.monad)]
- [data (..read_module_descriptor fs context module_id)
+ [data (: (Async (Try Binary))
+ (cache/module.cache fs context @module))
[module registry] (async#in (<binary>.result ..parser data))]
(if (text#= descriptor.runtime module_name)
(in [true <cache>])
@@ -389,7 +348,7 @@
(Try (dependency.Order .Module)))
(|> pre_loaded_caches
(monad.mix try.monad
- (function (_ [_ [module [module_id [|module| registry]]]] archive)
+ (function (_ [_ [module [@module [|module| registry]]]] archive)
(archive.has module
[archive.#module |module|
archive.#output (: Output sequence.empty)
@@ -408,9 +367,9 @@
[... TODO: Stop needing to wrap this expression in an unnecessary "do" expression.
it (|> load_order
(list.only (|>> product.left (dictionary.key? purge) not))
- (monad.each ! (function (_ [module_name [module_id entry]])
+ (monad.each ! (function (_ [module_name [@module entry]])
(do !
- [[entry bundles] (..load_definitions fs context module_id host_environment entry)]
+ [[entry bundles] (..load_definitions fs context @module host_environment entry)]
(in [[module_name entry]
bundles])))))]
(in it)))
@@ -451,7 +410,7 @@
(-> Configuration (generation.Host expression directive) (file.System Async) Context Import (List //.Context)
(Async (Try [Archive .Lux Bundles]))))
(do async.monad
- [binary (# fs read (..general_descriptor fs context))]
+ [binary (# fs read (cache/archive.descriptor fs context))]
(case binary
{try.#Success binary}
(do (try.with async.monad)