aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2022-02-24 17:47:27 -0400
committerEduardo Julian2022-02-24 17:47:27 -0400
commit08518ba37d9094c5cc8683fc404c349e534b8dc9 (patch)
treedc1f68559982af895a8b9a3c4055959a0f98e267 /stdlib
parentf27a91a7b67790272578692ea20e2d875dbb3d35 (diff)
Finishing the meta-compiler [Part 4]
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux.lux17
-rw-r--r--stdlib/source/library/lux/control/concurrency/atom.lux10
-rw-r--r--stdlib/source/library/lux/ffi.jvm.lux38
-rw-r--r--stdlib/source/library/lux/target/python.lux27
-rw-r--r--stdlib/source/library/lux/tool/compiler/default/platform.lux18
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux.lux36
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux22
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux62
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux67
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux23
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux7
-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
-rw-r--r--stdlib/source/library/lux/type/check.lux6
-rw-r--r--stdlib/source/program/compositor.lux9
-rw-r--r--stdlib/source/test/lux/target/python.lux212
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux3
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/cache.lux8
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/cache/module.lux92
35 files changed, 654 insertions, 368 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index 20122f66c..e46090db0 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -3910,12 +3910,17 @@
[[t_module t_name]
["" (..module_alias (list t_name) alias)]])
tags)
- pattern (|> locals
- (list#each (function (_ [slot binding])
- (list (symbol$ slot)
- (symbol$ binding))))
- list#conjoint
- tuple$)]
+ pattern (case locals
+ (^ (list [slot binding]))
+ (symbol$ binding)
+
+ _
+ (|> locals
+ (list#each (function (_ [slot binding])
+ (list (symbol$ slot)
+ (symbol$ binding))))
+ list#conjoint
+ tuple$))]
(do meta_monad
[enhanced_target (monad#mix meta_monad
(function (_ [[_ m_local] m_type] enhanced_target)
diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux
index c865b8e33..5685495a2 100644
--- a/stdlib/source/library/lux/control/concurrency/atom.lux
+++ b/stdlib/source/library/lux/control/concurrency/atom.lux
@@ -18,7 +18,7 @@
(with_expansions [<jvm> (as_is (ffi.import: (java/util/concurrent/atomic/AtomicReference a)
["[1]::[0]"
(new [a])
- (get [] a)
+ (get [] "io" a)
(compareAndSet [a a] boolean)]))]
(for [@.old <jvm>
@.jvm <jvm>]
@@ -61,10 +61,10 @@
(def: .public (read! atom)
(All (_ a) (-> (Atom a) (IO a)))
- (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))]
- (for [@.old <jvm>
- @.jvm <jvm>]
- (<read> 0 (:representation atom))))))
+ (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))]
+ (for [@.old <jvm>
+ @.jvm <jvm>]
+ (io.io (<read> 0 (:representation atom))))))
(def: .public (compare_and_swap! current new atom)
(All (_ a) (-> a a (Atom a) (IO Bit)))
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 8439ae24a..ff3550fde 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1,7 +1,7 @@
(.using
[library
["[0]" lux {"-" Primitive Type type int char :as}
- ["[1]_[0]" type ("[1]#[0]" equivalence)]
+ ["[0]" meta]
[abstract
["[0]" monad {"+" Monad do}]
["[0]" enum]]
@@ -25,7 +25,6 @@
[syntax {"+" syntax:}]
["[0]" code]
["[0]" template]]
- ["[0]" meta]
[target
[jvm
[encoding
@@ -36,7 +35,9 @@
["[0]" descriptor]
["[0]" signature]
["[0]" reflection]
- ["[0]" parser]]]]]])
+ ["[0]" parser]]]]
+ ["[1]_[0]" type ("[1]#[0]" equivalence)
+ ["[0]" check]]]])
(def: internal
(-> External Text)
@@ -1699,8 +1700,8 @@
["Lux Type" (%.type type)]))
(with_expansions [<failure> (as_is (meta.failure (exception.error ..cannot_convert_to_jvm_type [type])))]
- (def: (lux_type->jvm_type type)
- (-> .Type (Meta (Type Value)))
+ (def: (lux_type->jvm_type context type)
+ (-> Type_Context .Type (Meta (Type Value)))
(if (lux_type#= .Any type)
(# meta.monad in $Object)
(case type
@@ -1745,7 +1746,7 @@
(case params
{.#Item elementLT {.#End}}
(# meta.monad each type.array
- (lux_type->jvm_type elementLT))
+ (lux_type->jvm_type context elementLT))
_
<failure>)
@@ -1755,7 +1756,7 @@
{.#End}
(let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))]
(# meta.monad each type.array
- (lux_type->jvm_type {.#Primitive unprefixed (list)})))
+ (lux_type->jvm_type context {.#Primitive unprefixed (list)})))
_
<failure>)
@@ -1766,7 +1767,7 @@
(monad.each meta.monad
(function (_ paramLT)
(do meta.monad
- [paramJT (lux_type->jvm_type paramLT)]
+ [paramJT (lux_type->jvm_type context paramLT)]
(case (parser.parameter? paramJT)
{.#Some paramJT}
(in paramJT)
@@ -1781,10 +1782,18 @@
<failure>
{.#Some type'}
- (lux_type->jvm_type type'))
+ (lux_type->jvm_type context type'))
{.#Named _ type'}
- (lux_type->jvm_type type')
+ (lux_type->jvm_type context type')
+
+ {.#Var @it}
+ (case (check.result context (check.peek @it))
+ {try.#Success {.#Some :it:}}
+ (lux_type->jvm_type context :it:)
+
+ _
+ <failure>)
_
<failure>))))
@@ -1794,7 +1803,8 @@
[_ {.#Symbol array_name}]
(do meta.monad
[array_type (meta.type array_name)
- array_jvm_type (lux_type->jvm_type array_type)
+ context meta.type_context
+ array_jvm_type (lux_type->jvm_type context array_type)
.let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>]
[(# type.equivalence =
(type.array <primitive>)
@@ -1829,7 +1839,8 @@
[_ {.#Symbol array_name}]
(do meta.monad
[array_type (meta.type array_name)
- array_jvm_type (lux_type->jvm_type array_type)
+ context meta.type_context
+ array_jvm_type (lux_type->jvm_type context array_type)
.let [g!idx (` (.|> (~ idx)
(.: .Nat)
(.:as (.Primitive (~ (code.text box.long))))
@@ -1867,7 +1878,8 @@
[_ {.#Symbol array_name}]
(do meta.monad
[array_type (meta.type array_name)
- array_jvm_type (lux_type->jvm_type array_type)
+ context meta.type_context
+ array_jvm_type (lux_type->jvm_type context array_type)
.let [g!idx (` (.|> (~ idx)
(.: .Nat)
(.:as (.Primitive (~ (code.text box.long))))
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index 1e0d3a59b..8f1c1fddf 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -226,8 +226,8 @@
(-> (List [(Expression Any) (Expression Any)]) (Computation Any))
(composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v)))))
- (def: .public (apply/* func args)
- (-> (Expression Any) (List (Expression Any)) (Computation Any))
+ (def: .public (apply/* args func)
+ (-> (List (Expression Any)) (Expression Any) (Computation Any))
(<| :abstraction
... ..expression
(format (:representation func)
@@ -252,7 +252,9 @@
(def: .public (do method args object)
(-> Text (List (Expression Any)) (Expression Any) (Computation Any))
- (..apply/* (..the method object) args))
+ (|> object
+ (..the method)
+ (..apply/* args)))
(def: .public (item idx array)
(-> (Expression Any) (Expression Any) Access)
@@ -292,6 +294,8 @@
[or "or"]
[and "and"]
+
+ [in? "in"]
)
(template [<name> <unary>]
@@ -456,20 +460,19 @@
(in (list.repeated arity (` (Expression Any)))))
(template [<arity> <function>+]
- [(with_expansions [<apply> (template.symbol ["apply/" <arity>])
- <inputs> (arity_inputs <arity>)
- <types> (arity_types <arity>)
+ [(with_expansions [<inputs> (arity_inputs <arity>)
<definitions> (template.spliced <function>+)]
- (def: .public (<apply> function <inputs>)
- (-> (Expression Any) <types> (Computation Any))
- (..apply/* function (.list <inputs>)))
-
(template [<function>]
- [(`` (def: .public (~~ (template.symbol [<function> "/" <arity>]))
- (<apply> (..var <function>))))]
+ [(`` (def: .public ((~~ (template.symbol [<function> "/" <arity>])) <inputs>)
+ (-> (~~ (arity_types <arity>)) (Computation Any))
+ (..apply/* (.list <inputs>) (..var <function>))))]
<definitions>))]
+ [0
+ [["locals"]
+ ["globals"]]]
+
[1
[["str"]
["ord"]
diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux
index f489c1fb8..752d3fe65 100644
--- a/stdlib/source/library/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux
@@ -53,7 +53,8 @@
[meta
[import {"+" Import}]
["[0]" context {"+" Context}]
- ["[0]" cache]
+ ["[0]" cache
+ ["[1]/[0]" module]]
[cli {"+" Compilation Library}
["[0]" compiler {"+" Compiler}]]
["[0]" archive {"+" Output Archive}
@@ -110,7 +111,7 @@
(function (_ [artifact_id custom content])
(ioW.write system context module_id artifact_id content)))]
(do [! ..monad]
- [_ (ioW.prepare system context module_id)
+ [_ (cache/module.enable! system context module_id)
_ (for [@.python (|> entry
(value@ archive.#output)
sequence.list
@@ -729,7 +730,7 @@
(def: (custom_compiler importer it)
(All (_ <type_vars>)
- (-> <Importer> Compiler (Async (Try [<Context> (List Text) ///.Custom]))))
+ (-> <Importer> Compiler (Async (Try [<Context> (List Text) Any]))))
(let [/#definition (value@ compiler.#definition it)
[/#module /#name] /#definition]
(do ..monad
@@ -745,15 +746,12 @@
(meta.result meta_state)
async#in)]
(async#in (if (check.subsumes? ///.Custom /#type)
- (|> /#value
- (:as ///.Custom)
- [context (value@ compiler.#parameters it)]
- {try.#Success})
+ {try.#Success [context (value@ compiler.#parameters it) /#value]}
(exception.except ..invalid_custom_compiler [/#definition /#type]))))))
- (def: .public (compile phase_wrapper import file_context expander platform compilation context)
+ (def: .public (compile lux_compiler phase_wrapper import file_context expander platform compilation context)
(All (_ <type_vars>)
- (-> ///phase.Wrapper Import Context Expander <Platform> Compilation <Context> <Return>))
+ (-> (-> Any ///.Custom) ///phase.Wrapper Import Context Expander <Platform> Compilation <Context> <Return>))
(let [[host_dependencies libraries compilers sources target module configuration] compilation
importer (|> (..compiler phase_wrapper expander platform)
(serial_compiler import file_context platform sources)
@@ -764,7 +762,7 @@
(do !
[[context parameters custom] (custom_compiler importer it)]
(async#in (|> custom
- (:as ///.Custom)
+ lux_compiler
(function.on parameters))))))
(monad.all !))]
(importer descriptor.runtime module))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux
index faf7f3b90..d5b883eed 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux
@@ -3,7 +3,7 @@
[lux "*"
[control
["<>" parser
- ["<b>" binary {"+" Parser}]]]
+ ["<[0]>" binary {"+" Parser}]]]
[data
[format
["_" binary {"+" Writer}]]]
@@ -55,18 +55,32 @@
(def: .public parser
(Parser .Module)
(let [definition (: (Parser Definition)
- ($_ <>.and <b>.bit <b>.type <b>.any))
+ ($_ <>.and
+ <binary>.bit
+ <binary>.type
+ <binary>.any))
labels (: (Parser [Text (List Text)])
- (<>.and <b>.text (<b>.list <b>.text)))
+ ($_ <>.and
+ <binary>.text
+ (<binary>.list <binary>.text)))
global_type (: (Parser [Bit Type (Either [Text (List Text)]
[Text (List Text)])])
- ($_ <>.and <b>.bit <b>.type (<b>.or labels labels)))
+ ($_ <>.and
+ <binary>.bit
+ <binary>.type
+ (<binary>.or labels labels)))
global_label (: (Parser .Label)
- ($_ <>.and <b>.bit <b>.type (<b>.list <b>.text) <b>.nat))
+ ($_ <>.and
+ <binary>.bit
+ <binary>.type
+ (<binary>.list <binary>.text)
+ <binary>.nat))
alias (: (Parser Alias)
- (<>.and <b>.text <b>.text))
+ ($_ <>.and
+ <binary>.text
+ <binary>.text))
global (: (Parser Global)
- ($_ <b>.or
+ ($_ <binary>.or
definition
global_type
global_label
@@ -74,13 +88,13 @@
alias))]
($_ <>.and
... #module_hash
- <b>.nat
+ <binary>.nat
... #module_aliases
- (<b>.list alias)
+ (<binary>.list alias)
... #definitions
- (<b>.list (<>.and <b>.text global))
+ (<binary>.list (<>.and <binary>.text global))
... #imports
- (<b>.list <b>.text)
+ (<binary>.list <binary>.text)
... #module_state
(# <>.monad in {.#Cached}))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
index db622ca0c..0ac407738 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux
@@ -114,21 +114,17 @@
(All (_ a) (-> (-> [check.Var Type] (Operation a))
(Operation a)))
(do phase.monad
- [var (..check check.var)
- .let [[@it :it:] var]
- it (it var)
+ [@it,:it: (..check check.var)
+ it (it @it,:it:)
+ .let [[@it :it:] @it,:it:]
_ (..check (check.forget! @it))]
(in it)))
(def: .public (inferring action)
(All (_ a) (-> (Operation a) (Operation [Type a])))
- (do phase.monad
- [[@it :it:] (..check check.var)
- it (..expecting :it: action)
- :it: (..check (check.clean (list) :it:))
- ... :it: (..check (do check.monad
- ... [:it: (check.identity (list) @it)
- ... _ (check.forget! @it)]
- ... (in :it:)))
- ]
- (in [:it: it])))
+ (<| ..with_var
+ (function (_ [@it :it:]))
+ (do phase.monad
+ [it (..expecting :it: action)
+ :it: (..check (check.identity (list) @it))]
+ (in [:it: it]))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
index 2c957abe7..fa5dd353a 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -146,23 +146,23 @@
_
(# check.monad in [(list) (..quantified envs :it:)]))))
-(def: (simple_pattern_analysis type inputT location output next)
+(def: (simple_pattern_analysis type :input: location output next)
(All (_ a) (-> Type Type Location Pattern (Operation a) (Operation [Pattern a])))
(/.with_location location
(do ///.monad
- [_ (/type.check (check.check inputT type))
+ [_ (/type.check (check.check :input: type))
outputA next]
(in [output outputA]))))
-(def: (tuple_pattern_analysis pattern_analysis inputT sub_patterns next)
+(def: (tuple_pattern_analysis pattern_analysis :input: sub_patterns next)
(All (_ a)
(-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))
Type (List Code) (Operation a) (Operation [Pattern a])))
(do [! ///.monad]
- [[@ex_var+ inputT'] (/type.check (..tuple inputT))]
- (.case inputT'
+ [[@ex_var+ :input:'] (/type.check (..tuple :input:))]
+ (.case :input:'
{.#Product _}
- (let [matches (loop [types (type.flat_tuple inputT')
+ (let [matches (loop [types (type.flat_tuple :input:')
patterns sub_patterns
output (: (List [Type Code])
{.#End})]
@@ -203,7 +203,7 @@
thenA])))
_
- (/.except ..mismatch [inputT' (code.tuple sub_patterns)]))))
+ (/.except ..mismatch [:input:' (code.tuple sub_patterns)]))))
... This function handles several concerns at once, but it must be that
... way because those concerns are interleaved when doing
@@ -221,20 +221,20 @@
... body expressions.
... That is why the body must be analysed in the context of the
... pattern, and not separately.
-(def: (pattern_analysis num_tags inputT pattern next)
+(def: (pattern_analysis num_tags :input: pattern next)
(All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
(.case pattern
[location {.#Symbol ["" name]}]
(/.with_location location
(do ///.monad
- [outputA (/scope.with_local [name inputT]
+ [outputA (/scope.with_local [name :input:]
next)
idx /scope.next]
(in [{/pattern.#Bind idx} outputA])))
(^template [<type> <input> <output>]
[[location <input>]
- (simple_pattern_analysis <type> inputT location {/pattern.#Simple <output>} next)])
+ (simple_pattern_analysis <type> :input: location {/pattern.#Simple <output>} next)])
([Bit {.#Bit pattern_value} {/simple.#Bit pattern_value}]
[Nat {.#Nat pattern_value} {/simple.#Nat pattern_value}]
[Int {.#Int pattern_value} {/simple.#Int pattern_value}]
@@ -244,7 +244,7 @@
[Any {.#Tuple {.#End}} {/simple.#Unit}])
(^ [location {.#Tuple (list singleton)}])
- (pattern_analysis {.#None} inputT singleton next)
+ (pattern_analysis {.#None} :input: singleton next)
[location {.#Tuple sub_patterns}]
(/.with_location location
@@ -260,29 +260,33 @@
(.case record_size,members,recordT
{.#Some [record_size members recordT]}
(do !
- [_ (.case inputT
- {.#Var _id}
- (/type.check (check.check inputT recordT))
+ [_ (.case :input:
+ {.#Var @input}
+ (/type.check (do check.monad
+ [? (check.bound? @input)]
+ (if ?
+ (in [])
+ (check.check :input: recordT))))
_
(in []))]
(.case members
(^ (list singleton))
- (pattern_analysis {.#None} inputT singleton next)
+ (pattern_analysis {.#None} :input: singleton next)
_
- (..tuple_pattern_analysis pattern_analysis inputT members next)))
+ (..tuple_pattern_analysis pattern_analysis :input: members next)))
{.#None}
- (..tuple_pattern_analysis pattern_analysis inputT sub_patterns next))))
+ (..tuple_pattern_analysis pattern_analysis :input: sub_patterns next))))
(^ [location {.#Variant (list& [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}])
(/.with_location location
(do ///.monad
- [[@ex_var+ inputT'] (/type.check (..tuple inputT))]
- (.case inputT'
+ [[@ex_var+ :input:'] (/type.check (..tuple :input:))]
+ (.case :input:'
{.#Sum _}
- (let [flat_sum (type.flat_variant inputT')
+ (let [flat_sum (type.flat_variant :input:')
size_sum (list.size flat_sum)
num_cases (maybe.else size_sum num_tags)
idx (/complex.tag right? lefts)]
@@ -302,29 +306,29 @@
nextA]))
_
- (/.except ..sum_has_no_case [idx inputT])))
+ (/.except ..sum_has_no_case [idx :input:])))
{.#UnivQ _}
(do ///.monad
[[ex_id exT] (/type.check check.existential)
it (pattern_analysis num_tags
- (maybe.trusted (type.applied (list exT) inputT'))
+ (maybe.trusted (type.applied (list exT) :input:'))
pattern
next)
_ (/type.check (monad.each check.monad check.forget! @ex_var+))]
(in it))
_
- (/.except ..mismatch [inputT' pattern]))))
+ (/.except ..mismatch [:input:' pattern]))))
(^ [location {.#Variant (list& [_ {.#Symbol tag}] values)}])
(/.with_location location
(do ///.monad
[tag (///extension.lifted (meta.normal tag))
[idx group variantT] (///extension.lifted (meta.tag tag))
- _ (/type.check (check.check inputT variantT))
+ _ (/type.check (check.check :input: variantT))
.let [[lefts right?] (/complex.choice (list.size group) idx)]]
- (pattern_analysis {.#Some (list.size group)} inputT (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) next)))
+ (pattern_analysis {.#Some (list.size group)} :input: (` {(~ (code.nat lefts)) (~ (code.bit right?)) (~+ values)}) next)))
_
(/.except ..invalid [pattern])
@@ -335,12 +339,12 @@
(.case branches
{.#Item [patternH bodyH] branchesT}
(do [! ///.monad]
- [[inputT inputA] (/type.inferring
- (analyse archive inputC))
- outputH (pattern_analysis {.#None} inputT patternH (analyse archive bodyH))
+ [[:input: inputA] (<| /type.inferring
+ (analyse archive inputC))
+ outputH (pattern_analysis {.#None} :input: patternH (analyse archive bodyH))
outputT (monad.each !
(function (_ [patternT bodyT])
- (pattern_analysis {.#None} inputT patternT (analyse archive bodyT)))
+ (pattern_analysis {.#None} :input: patternT (analyse archive bodyT)))
branchesT)
outputHC (|> outputH product.left /coverage.coverage /.of_try)
outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index 54b2cf1dd..669f4f59a 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -243,8 +243,7 @@
_
... Must infer...
(do !
- [membersTA (monad.each ! (|>> (analyse archive) /type.inferring)
- membersC)
+ [membersTA (monad.each ! (|>> (analyse archive) /type.inferring) membersC)
_ (/type.check (check.check expectedT
(type.tuple (list#each product.left membersTA))))]
(in (/.tuple (list#each product.right membersTA))))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 540e38eb0..22e29dd08 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -537,11 +537,18 @@
{.#Named name anonymous}
(check_parameter anonymous)
- (^template [<tag>]
- [{<tag> id}
- (phase#in (jvm.class ..object_class (list)))])
- ([.#Var]
- [.#Ex])
+ {.#Var @var}
+ (do phase.monad
+ [:var: (typeA.check (check.peek @var))]
+ (case :var:
+ {.#Some :var:}
+ (check_parameter :var:)
+
+ {.#None}
+ (in (jvm.class ..object_class (list)))))
+
+ {.#Ex id}
+ (phase#in (jvm.class ..object_class (list)))
(^template [<tag>]
[{<tag> env unquantified}
@@ -629,13 +636,32 @@
_
(check_parameter objectT)))
+(template [<name> <category> <parser>]
+ [(def: .public (<name> mapping typeJ)
+ (-> Mapping (Type <category>) (Operation .Type))
+ (case (|> typeJ ..signature (<text>.result (<parser> mapping)))
+ {try.#Success check}
+ (typeA.check check)
+
+ {try.#Failure error}
+ (phase.failure error)))]
+
+ [boxed_reflection_type Value luxT.boxed_type]
+ [reflection_type Value luxT.type]
+ [boxed_reflection_return Return luxT.boxed_return]
+ [reflection_return Return luxT.return]
+ )
+
(def: (check_object objectT)
- (-> .Type (Operation External))
+ (-> .Type (Operation [External .Type]))
(do [! phase.monad]
- [name (# ! each ..reflection (check_jvm objectT))]
+ [:object: (check_jvm objectT)
+ .let [name (..reflection :object:)]]
(if (dictionary.key? ..boxes name)
(/////analysis.except ..primitives_are_not_objects [name])
- (phase#in name))))
+ (do !
+ [:object: (reflection_type luxT.fresh :object:)]
+ (phase#in [name :object:])))))
(def: (check_return type)
(-> .Type (Operation (Type Return)))
@@ -786,7 +812,8 @@
(^ (list))
(do phase.monad
[expectedT (///.lifted meta.expected_type)
- _ (check_object expectedT)]
+ [_ :object:] (check_object expectedT)
+ _ (typeA.inference :object:)]
(in {/////analysis.#Extension extension_name (list)}))
_
@@ -798,7 +825,7 @@
(case args
(^ (list objectC))
(do phase.monad
- [_ (typeA.inference Bit)
+ [_ (typeA.inference .Bit)
[objectT objectA] (typeA.inferring
(analyse archive objectC))
_ (check_object objectT)]
@@ -831,7 +858,7 @@
[_ (typeA.inference Nothing)
[exceptionT exceptionA] (typeA.inferring
(analyse archive exceptionC))
- exception_class (check_object exceptionT)
+ [exception_class _] (check_object exceptionT)
? (phase.lifted (reflection!.sub? class_loader "java.lang.Throwable" exception_class))
_ (: (Operation Any)
(if ?
@@ -871,28 +898,12 @@
_ (typeA.inference Bit)
[objectT objectA] (typeA.inferring
(analyse archive objectC))
- object_class (check_object objectT)
+ [object_class _] (check_object objectT)
? (phase.lifted (reflection!.sub? class_loader object_class sub_class))]
(if ?
(in {/////analysis.#Extension extension_name (list (/////analysis.text sub_class) objectA)})
(/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))]))
-(template [<name> <category> <parser>]
- [(def: .public (<name> mapping typeJ)
- (-> Mapping (Type <category>) (Operation .Type))
- (case (|> typeJ ..signature (<text>.result (<parser> mapping)))
- {try.#Success check}
- (typeA.check check)
-
- {try.#Failure error}
- (phase.failure error)))]
-
- [boxed_reflection_type Value luxT.boxed_type]
- [reflection_type Value luxT.type]
- [boxed_reflection_return Return luxT.boxed_return]
- [reflection_return Return luxT.return]
- )
-
(def: (class_candidate_parents class_loader source_name fromT target_name target_class)
(-> java/lang/ClassLoader External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit])))
(do [! phase.monad]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index b0660d074..8a2acf43e 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -60,7 +60,8 @@
["[0]" artifact]
["[0]" unit]]
["[0]" cache "_"
- ["[1]" artifact]]]
+ [dependency
+ ["[1]" artifact]]]]
[language
[lux
["[0]" synthesis {"+" Synthesis}]
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 87812e7be..241b28a2b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -52,7 +52,8 @@
["[0]" module]
["[0]" unit]]
["[0]" cache "_"
- ["[1]/[0]" artifact]]]]]]])
+ [dependency
+ ["[1]/[0]" artifact]]]]]]]])
(def: .public (custom [syntax handler])
(All (_ anchor expression directive s)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index 23a64f59c..944cac7a8 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -74,7 +74,8 @@
["[0]" artifact]
["[0]" unit]]
["[0]" cache "_"
- ["[1]/[0]" artifact]]]]]]])
+ [dependency
+ ["[1]/[0]" artifact]]]]]]]])
(template [<name> <0>]
[(def: <name>
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
index f1ea553f8..c4be93d94 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux
@@ -181,7 +181,7 @@
(/.install "+" (binary (product.uncurried (..capped _.+))))
(/.install "-" (binary (product.uncurried (..capped _.-))))
(/.install "*" (binary (product.uncurried (..capped _.*))))
- (/.install "/" (binary (product.uncurried //runtime.i64::division)))
+ (/.install "/" (binary (product.uncurried //runtime.i64#/)))
(/.install "%" (binary (product.uncurried //runtime.i64::remainder)))
(/.install "f64" (unary _.float/1))
(/.install "char" (unary //runtime.i64::char))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
index d7998be17..6a9b7bf4b 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
@@ -35,7 +35,8 @@
[meta
["[0]" archive {"+" Archive}]
["[0]" cache "_"
- ["[1]/[0]" artifact]]]]]]]
+ [dependency
+ ["[1]/[0]" artifact]]]]]]]]
["[0]" / "_"
["[1][0]" abstract]
[field
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
index db2b87ba7..b9f8d24e1 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux
@@ -34,7 +34,8 @@
[meta
[archive {"+" Archive}]
["[0]" cache "_"
- ["[1]" artifact]]]]]]]])
+ [dependency
+ ["[1]" artifact]]]]]]]]])
(def: .public (symbol prefix)
(-> Text (Operation SVar))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
index 3578fbeaa..a164ccd5e 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux
@@ -31,7 +31,8 @@
[archive {"+" Archive}
["[0]" artifact]]
["[0]" cache "_"
- ["[1]" artifact]]]]]]])
+ [dependency
+ ["[1]" artifact]]]]]]]])
(def: .public (apply expression archive [functionS argsS+])
(Generator (Reification Synthesis))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
index d1a33d54d..aecb9b4dd 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux
@@ -30,7 +30,8 @@
["[1][0]" phase]
[meta
["[0]" cache "_"
- ["[1]" artifact]]]
+ [dependency
+ ["[1]" artifact]]]]
[reference
["[1][0]" variable {"+" Register}]]]]]]])
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
index 7449d550b..12a2cc5d4 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux
@@ -1,7 +1,6 @@
(.using
[library
[lux {"-" ++}
- ["[0]" meta]
[abstract
["[0]" monad {"+" do}]]
[control
@@ -24,12 +23,13 @@
[number {"+" hex}
["f" frac]
["[0]" i64]]]
+ ["[0]" meta
+ ["[0]" version]]
["@" target
["_" python {"+" Expression SVar Computation Literal Statement}]]]]
["[0]" /// "_"
["[1][0]" reference]
["//[1]" /// "_"
- ["$" version]
["[1][0]" synthesis {"+" Synthesis}]
["[1][0]" generation]
["//[1]" ///
@@ -101,7 +101,7 @@
(def: (runtime_name name)
(-> Text SVar)
(let [symbol (format ..prefix
- "_" (%.nat $.version)
+ "_" (%.nat version.latest)
"_" (%.nat (text#hash name)))]
(_.var symbol)))
@@ -313,7 +313,7 @@
..as_nat
(_.bit_shr param))))))
-(runtime: (i64::division param subject)
+(runtime: (i64#/ param subject)
(with_vars [floored]
($_ _.then
(_.set (list floored) (_.// param subject))
@@ -322,13 +322,16 @@
(_.% param)
(_.= (_.int +0))
_.not)]
- (_.? (_.and potentially_floored?
- inexact?)
- (_.+ (_.int +1) floored)
- floored))))))
+ (<| (_.? (_.and potentially_floored?
+ inexact?)
+ (_.+ (_.int +1) floored))
+ (_.? (_.= (_.manual "+9223372036854775808")
+ floored)
+ (_.manual "-9223372036854775808"))
+ floored))))))
(runtime: (i64::remainder param subject)
- (_.return (_.- (|> subject (..i64::division param) (_.* param))
+ (_.return (_.- (|> subject (..i64#/ param) (_.* param))
subject)))
(template [<runtime> <host>]
@@ -357,7 +360,7 @@
@i64::64
@i64::left_shifted
@i64::right_shifted
- @i64::division
+ @i64#/
@i64::remainder
@i64::and
@i64::or
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux
index 937ead1dc..2ef214588 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux
@@ -4,9 +4,10 @@
["@" target]
[data
[text
- ["%" format {"+" format}]]]]]
+ ["%" format {"+" format}]]]
+ [meta
+ ["[0]" version]]]]
["[0]" //// "_"
- ["[0]" version]
["[1][0]" generation]
["//[1]" /// "_"
["[0]" phase ("[1]#[0]" monad)]
@@ -40,7 +41,7 @@
(def: .public (artifact [module artifact])
(-> unit.ID Text)
- (format "l" (%.nat version.version)
+ (format "l" (%.nat version.latest)
..universe_label
"m" (%.nat module)
"a" (%.nat artifact)))
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]]
[//
diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux
index 984456187..785e321fb 100644
--- a/stdlib/source/library/lux/type/check.lux
+++ b/stdlib/source/library/lux/type/check.lux
@@ -787,11 +787,11 @@
(check#each (|>> {<tag> leftT'}))))])
([.#Sum] [.#Product] [.#Function] [.#Apply])
- {.#Var @}
+ {.#Var @it}
(case aliases
(^ (list))
(do ..monad
- [?actualT (peek @)]
+ [?actualT (..peek @it)]
(case ?actualT
{.#Some actualT}
(clean aliases actualT)
@@ -801,7 +801,7 @@
_
(do ..monad
- [:it: (..try (..identity aliases @))]
+ [:it: (..try (..identity aliases @it))]
(case :it:
{try.#Success :it:}
(case :it:
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 250f184bd..cad7bf352 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -26,7 +26,7 @@
["[0]" console]
["[1]/[0]" program]]
[tool
- [compiler
+ ["[0]" compiler
["[0]" phase]
[default
["[0]" platform {"+" Platform}]]
@@ -128,12 +128,13 @@
(dictionary.has head content output)))))))
(with_expansions [<parameters> (as_is anchor expression artifact)]
- (def: .public (compiler file_context
+ (def: .public (compiler lux_compiler file_context
expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender
service
packager,package)
(All (_ <parameters>)
- (-> Context
+ (-> (-> Any compiler.Custom)
+ Context
Expander
analysis.Bundle
(IO (Platform <parameters>))
@@ -168,7 +169,7 @@
platform
(Async (Try [Archive (directive.State+ <parameters>)]))
- (:expected (platform.compile phase_wrapper import file_context expander platform compilation [archive state])))
+ (:expected (platform.compile lux_compiler phase_wrapper import file_context expander platform compilation [archive state])))
_ (ioW.freeze (value@ platform.#&file_system platform) file_context archive)
program_context (async#in ($/program.context archive))
host_dependencies (..load_host_dependencies (value@ platform.#&file_system platform) compilation_host_dependencies)
diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux
index bb601a007..0d9fb493a 100644
--- a/stdlib/source/test/lux/target/python.lux
+++ b/stdlib/source/test/lux/target/python.lux
@@ -248,6 +248,11 @@
(_.cover [/.dict]
(expression (|>> (:as Frac) (f.= expected))
(/.item field (/.dict (list [field (/.float expected)])))))
+ (_.cover [/.in?]
+ (and (expression (|>> (:as Bit) not)
+ (/.in? (/.dict (list)) field))
+ (expression (|>> (:as Bit))
+ (/.in? (/.dict (list [field (/.float expected)])) field))))
)))
(def: test|computation
@@ -290,14 +295,14 @@
(/.do "ceil" (list (/.float float))))))
(_.cover [/.is]
(and (expression (|>> (:as Bit))
- (/.apply/* (/.lambda (list $arg/0)
- (/.is $arg/0 $arg/0))
- (list (/.string (format string string)))))
+ (/.apply/* (list (/.string (format string string)))
+ (/.lambda (list $arg/0)
+ (/.is $arg/0 $arg/0))))
(expression (|>> (:as Bit) not)
- (/.apply/* (/.lambda (list $arg/0 $arg/1)
- (/.is $arg/0 (/.+ $arg/1 $arg/1)))
- (list (/.string (format string string))
- (/.string string))))))
+ (/.apply/* (list (/.string (format string string))
+ (/.string string))
+ (/.lambda (list $arg/0 $arg/1)
+ (/.is $arg/0 (/.+ $arg/1 $arg/1)))))))
)))
(def: test|function
@@ -312,32 +317,14 @@
($_ _.and
(_.cover [/.lambda]
(expression (|>> (:as Frac) (f.= float/0))
- (/.apply/* (/.lambda (list)
- (/.float float/0))
- (list))))
- (_.cover [/.apply/1]
- (expression (|>> (:as Frac) (f.= float/0))
- (/.apply/1 (/.lambda (list $arg/0)
- $arg/0)
- (/.float float/0))))
- (_.cover [/.apply/2]
- (expression (|>> (:as Frac) (f.= ($_ f.+ float/0 float/1)))
- (/.apply/2 (/.lambda (list $arg/0 $arg/1)
- ($_ /.+ $arg/0 $arg/1))
- (/.float float/0)
- (/.float float/1))))
- (_.cover [/.apply/3]
- (expression (|>> (:as Frac) (f.= ($_ f.+ float/0 float/1 float/2)))
- (/.apply/3 (/.lambda (list $arg/0 $arg/1 $arg/2)
- ($_ /.+ $arg/0 $arg/1 $arg/2))
- (/.float float/0)
- (/.float float/1)
- (/.float float/2))))
+ (/.apply/* (list)
+ (/.lambda (list)
+ (/.float float/0)))))
(_.cover [/.apply/*]
(expression (|>> (:as Frac) (f.= ($_ f.+ float/0 float/1 float/2)))
- (/.apply/* (/.lambda (list $arg/0 $arg/1 $arg/2)
- ($_ /.+ $arg/0 $arg/1 $arg/2))
- (list (/.float float/0) (/.float float/1) (/.float float/2)))))
+ (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2))
+ (/.lambda (list $arg/0 $arg/1 $arg/2)
+ ($_ /.+ $arg/0 $arg/1 $arg/2)))))
)))
(def: test|var
@@ -358,44 +345,44 @@
($_ _.and
(_.cover [/.Single /.SVar /.var]
(expression (|>> (:as Frac) (f.= expected/0))
- (/.apply/* (/.lambda (list $var) $var)
- (list (/.float expected/0)))))
+ (/.apply/* (list (/.float expected/0))
+ (/.lambda (list $var) $var))))
(_.for [/.Poly /.PVar]
($_ _.and
(_.cover [/.poly]
(expression (|>> (:as Frac) (f.= expected/?))
- (/.apply/* (/.lambda (list $choice (/.poly $var))
- (/.item $choice $var))
- (list (/.int (.int poly_choice))
+ (/.apply/* (list (/.int (.int poly_choice))
(/.float expected/0)
- (/.float expected/1)))))
+ (/.float expected/1))
+ (/.lambda (list $choice (/.poly $var))
+ (/.item $choice $var)))))
(_.cover [/.splat_poly]
(expression (|>> (:as Frac) (f.= expected/?))
- (/.apply/* (/.lambda (list $choice (/.poly $var))
- (/.item $choice $var))
- (list (/.int (.int poly_choice))
+ (/.apply/* (list (/.int (.int poly_choice))
(/.splat_poly
(/.list (list (/.float expected/0)
- (/.float expected/1))))))))
+ (/.float expected/1)))))
+ (/.lambda (list $choice (/.poly $var))
+ (/.item $choice $var)))))
))
(_.for [/.Keyword /.KVar]
($_ _.and
(_.cover [/.keyword]
(expression (|>> (:as Nat) (n.= 2))
- (/.apply/* (/.lambda (list $choice (/.keyword $var))
- (/.len/1 $var))
- (list keyword_choice
+ (/.apply/* (list keyword_choice
(/.splat_keyword
(/.dict (list [keyword/0 (/.float expected/0)]
- [keyword/1 (/.float expected/1)])))))))
+ [keyword/1 (/.float expected/1)]))))
+ (/.lambda (list $choice (/.keyword $var))
+ (/.len/1 $var)))))
(_.cover [/.splat_keyword]
(expression (|>> (:as Frac) (f.= expected/?))
- (/.apply/* (/.lambda (list $choice (/.keyword $var))
- (/.item $choice $var))
- (list keyword_choice
+ (/.apply/* (list keyword_choice
(/.splat_keyword
(/.dict (list [keyword/0 (/.float expected/0)]
- [keyword/1 (/.float expected/1)])))))))
+ [keyword/1 (/.float expected/1)]))))
+ (/.lambda (list $choice (/.keyword $var))
+ (/.item $choice $var)))))
))
)))
@@ -429,6 +416,123 @@
("python exec" (/.code (it (/.var $output))) (:expected environment))
(Dict::get [$output] environment))))
+(def: test|access
+ Test
+ (do [! random.monad]
+ [$var/0 (# ! each (|>> %.nat (format "v0_") /.var) random.nat)
+ expected/0 random.safe_frac
+ dummy/0 random.safe_frac
+ field (# ! each /.string (random.ascii/upper 1))]
+ ($_ _.and
+ (_.cover [/.item]
+ (`` (and (~~ (template [<seq>]
+ [(expression (|>> (:as Frac) (f.= expected/0))
+ (/.item (/.int +0)
+ (<seq> (list (/.float expected/0)))))]
+
+ [/.list]
+ [/.tuple]
+ ))
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.list (list (/.float dummy/0))))
+ (/.set (list (/.item (/.int +0) $var/0)) (/.float expected/0))
+ (/.set (list $output) (/.item (/.int +0) $var/0)))))
+ (:as Frac)
+ (f.= expected/0))
+
+ (expression (|>> (:as Frac) (f.= expected/0))
+ (/.item field (/.dict (list [field (/.float expected/0)]))))
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.dict (list [field (/.float dummy/0)])))
+ (/.set (list (/.item field $var/0)) (/.float expected/0))
+ (/.set (list $output) (/.item field $var/0)))))
+ (:as Frac)
+ (f.= expected/0)))))
+ )))
+
+(def: test|location
+ Test
+ (do [! random.monad]
+ [$var/0 (# ! each (|>> %.nat (format "v0_") /.var) random.nat)
+ $var/1 (# ! each (|>> %.nat (format "v1_") /.var) random.nat)
+ expected/0 random.safe_frac
+ expected/1 random.safe_frac
+ dummy/0 random.safe_frac
+ field/0 (# ! each /.string (random.ascii/upper 1))]
+ ($_ _.and
+ (_.cover [/.set]
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.float expected/0))
+ (/.set (list $output) $var/0))))
+ (:as Frac)
+ (f.= expected/0)))
+ (_.cover [/.multi]
+ (`` (and (~~ (template [<var> <value>]
+ [(|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0 $var/1) (/.multi (list (/.float expected/0) (/.float expected/1))))
+ (/.set (list $output) <var>))))
+ (:as Frac)
+ (f.= <value>))]
+
+ [$var/0 expected/0]
+ [$var/1 expected/1]
+ )))))
+ (_.cover [/.delete]
+ (and (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0))))
+ (/.delete (/.item (/.int +0) $var/0))
+ (/.set (list $output) (/.item (/.int +0) $var/0)))))
+ (:as Frac)
+ (f.= expected/0))
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0))))
+ (/.delete (/.slice (/.int +0) (/.int +1) $var/0))
+ (/.set (list $output) (/.item (/.int +0) $var/0)))))
+ (:as Frac)
+ (f.= expected/0))
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float dummy/0))))
+ (/.delete (/.slice_from (/.int +0) $var/0))
+ (/.statement (/.do "append" (list (/.float expected/0)) $var/0))
+ (/.set (list $output) (/.item (/.int +0) $var/0)))))
+ (:as Frac)
+ (f.= expected/0))
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.dict (list [field/0 (/.float dummy/0)])))
+ (/.delete (/.item field/0 $var/0))
+ (/.set (list $output) (/.in? $var/0 field/0)))))
+ (:as Bit)
+ not)
+ (|> (..statement
+ (function (_ $output)
+ ($_ /.then
+ (/.set (list $var/0) (/.float dummy/0))
+ (/.delete $var/0)
+ (/.set (list $output) (/.or (/.in? /.locals/0 (/.string (/.code $var/0)))
+ (/.in? /.globals/0 (/.string (/.code $var/0))))))))
+ (:as Bit)
+ not)
+ ))
+ (_.for [/.Access]
+ ..test|access)
+ )))
+
(def: test|statement
Test
(do [! random.monad]
@@ -446,7 +550,7 @@
($_ /.then
(/.def $def (list $input/0)
(/.return $input/0))
- (/.set (list $output) (/.apply/* $def (list (/.float expected/0)))))))
+ (/.set (list $output) (/.apply/* (list (/.float expected/0)) $def)))))
(:as Frac)
(f.= expected/0)))
(_.cover [/.if]
@@ -457,7 +561,7 @@
(/.if (/.bool test)
(/.return (/.float then))
(/.return (/.float else))))
- (/.set (list $output) (/.apply/* $def (list))))))
+ (/.set (list $output) (/.apply/* (list) $def)))))
(:as Frac)
(f.= expected/?)))
(_.cover [/.when /.then]
@@ -469,7 +573,7 @@
(/.when (/.bool test)
(/.return (/.float then)))
(/.return (/.float else))))
- (/.set (list $output) (/.apply/* $def (list))))))
+ (/.set (list $output) (/.apply/* (list) $def)))))
(:as Frac)
(f.= expected/?)))
(_.cover [/.statement]
@@ -480,9 +584,11 @@
($_ /.then
(/.statement (/.+ (/.float expected/0) (/.float expected/0)))
(/.return (/.float expected/0))))
- (/.set (list $output) (/.apply/* $def (list))))))
+ (/.set (list $output) (/.apply/* (list) $def)))))
(:as Frac)
(f.= expected/0)))
+ (_.for [/.Location]
+ ..test|location)
)))
(def: random_expression
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
index e7f6a5093..546aa1c39 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux
@@ -369,7 +369,8 @@
(do !
[_ (//type.inference (Tuple type/0 type/1 varT))]
(/.product ..analysis archive.empty
- (list term/0 term/1 term/2 term/2 term/2))))]
+ (list term/0 term/1 term/2 term/2 term/2))))
+ :inferred: (//type.check (check.clean (list @var) :inferred:))]
(in (case analysis
(^ (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4)))))
(and (type#= (Tuple type/0 type/1 type/2 type/2 type/2)
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
index 9ffcd4ada..d1c3c9249 100644
--- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux
@@ -14,8 +14,10 @@
["[0]" file]]]]
[\\library
["[0]" /]]
- ["$[0]" // "_"
- ["[1][0]" context]])
+ ["[0]" / "_"
+ ["[1][0]" module]
+ ["$/[1]" // "_"
+ ["[1][0]" context]]])
(def: .public test
Test
@@ -41,4 +43,6 @@
post/0
post/1))))
+
+ /module.test
))))
diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux
new file mode 100644
index 000000000..98415b367
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux
@@ -0,0 +1,92 @@
+(.using
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ [monad {"+" do}]]
+ [control
+ ["[0]" try]
+ ["[0]" exception]
+ [concurrency
+ ["[0]" async {"+" Async} ("[1]#[0]" monad)]]]
+ [math
+ ["[0]" random]]
+ [world
+ ["[0]" file]]]]
+ [\\library
+ ["[0]" /]]
+ ["$[0]" /// "_"
+ ["[1][0]" context]])
+
+(`` (implementation: (bad it)
+ (-> (file.System Async) (file.System Async))
+
+ (~~ (template [<name>]
+ [(def: <name>
+ (# it <name>))]
+
+ [separator]
+ [file?]
+ [directory?]
+ [modify]
+ [write]
+ [append]
+ [move]
+ [directory_files]
+ [sub_directories]
+ [file_size]
+ [last_modified]
+ [can_execute?]
+ [read]
+ [delete]
+ ))
+
+ (def: (make_directory path)
+ (async#in {try.#Failure ""}))
+ ))
+
+(def: .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [.let [/ "/"
+ fs (file.mock /)]
+ context $///context.random
+ @module random.nat]
+ ($_ _.and
+ (in (do async.monad
+ [pre/0 (# fs directory? (/.path fs context @module))
+ pre/1 (/.enabled? fs context @module)
+ outcome (/.enable! fs context @module)
+ post/0 (# fs directory? (/.path fs context @module))
+ post/1 (/.enabled? fs context @module)]
+ (_.cover' [/.path /.enabled? /.enable!]
+ (and (not pre/0)
+ (not pre/1)
+
+ (case outcome
+ {try.#Success _} true
+ {try.#Failure _} false)
+
+ post/0
+ post/1))))
+ (in (do async.monad
+ [pre/0 (# fs directory? (/.path fs context @module))
+ pre/1 (/.enabled? fs context @module)
+ outcome (/.enable! (..bad fs) context @module)
+ post/0 (# fs directory? (/.path fs context @module))
+ post/1 (/.enabled? fs context @module)]
+ (_.cover' [/.cannot_enable]
+ (and (not pre/0)
+ (not pre/1)
+
+ (case outcome
+ {try.#Success _}
+ false
+
+ {try.#Failure error}
+ (exception.match? /.cannot_enable error))
+
+ (not post/0)
+ (not post/1)))))
+ ))))