diff options
40 files changed, 698 insertions, 393 deletions
diff --git a/documentation/bookmark/game/engine.md b/documentation/bookmark/game/engine.md new file mode 100644 index 000000000..53d2e2d56 --- /dev/null +++ b/documentation/bookmark/game/engine.md @@ -0,0 +1,10 @@ +# Exemplar + +## General + +0. [Open 3D Engine](https://www.o3de.org/) + +## Specialized + +0. [RPG Paper Maker](http://rpg-paper-maker.com/) + diff --git a/documentation/bookmark/memory_management.md b/documentation/bookmark/memory_management.md index a555926ef..2fc8b3606 100644 --- a/documentation/bookmark/memory_management.md +++ b/documentation/bookmark/memory_management.md @@ -23,6 +23,7 @@ # Garbage collection +0. [Destroy All Values: Designing Deinitialization in Programming Languages](https://gankra.github.io/blah/deinitialize-me-maybe/) 0. [Deconstructing the Garbage-First Collector](https://users.cecs.anu.edu.au/~steveb/pubs/papers/g1-vee-2020.pdf) 0. [The Garbage Collection Handbook](http://gchandbook.org/) 0. [Baby's First Garbage Collector](http://journal.stuffwithstuff.com/2013/12/08/babys-first-garbage-collector/) diff --git a/documentation/bookmark/state/world.md b/documentation/bookmark/state/world.md new file mode 100644 index 000000000..4c361b8a2 --- /dev/null +++ b/documentation/bookmark/state/world.md @@ -0,0 +1,4 @@ +# Reference + +0. [Worlds: Controlling the Scope of Side Effects](http://www.vpri.org/pdf/tr2010001_worlds.pdf) + diff --git a/documentation/bookmark/tool/instrumentation.md b/documentation/bookmark/tool/instrumentation.md new file mode 100644 index 000000000..e63803000 --- /dev/null +++ b/documentation/bookmark/tool/instrumentation.md @@ -0,0 +1,4 @@ +# Reference + +0. [Pin: Building Customized Program Analysis Tools with Dynamic Instrumentation](https://www.cin.ufpe.br/~rmfl/ADS_MaterialDidatico/PDFs/profiling/PIN%20Building%20Customized%20Program%20Analysis%20Tools%20with%20Dynamic%20Instrumentation.pdf) + diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 4e02af260..bd2e74788 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -138,33 +138,33 @@ (def: (read_tuple read host_object) (-> Translator Translator) - (let [size (|> host_object org/python/core/PyObject::__len__ .nat)] + (let [size (|> host_object org/python/core/PyObject::__len__ ffi.of_int .nat)] (loop [idx 0 output (:as (Array Any) (array.empty size))] (if (n.< size idx) - (case (org/python/core/PyObject::__getitem__ (.int idx) host_object) - {try.#Failure try} - {try.#Failure try} - + (case (org/python/core/PyObject::__getitem__ (ffi.as_int (.int idx)) host_object) {try.#Success value} (case (read value) - {try.#Failure try} - {try.#Failure try} - {try.#Success lux_value} - (again (++ idx) (array.write! idx lux_value output)))) + (again (++ idx) (array.write! idx lux_value output)) + + failure + failure) + + failure + failure) {try.#Success output})))) (exception: (unknown_kind_of_object [object java/lang/Object]) (exception.report - ["Object" (java/lang/Object::toString object)])) + ["Object" (ffi.of_string (java/lang/Object::toString object))])) (def: (read_variant read host_object) (-> Translator Translator) - (case [(org/python/core/PyObject::__getitem__ +0 host_object) - (org/python/core/PyObject::__getitem__ +1 host_object) - (org/python/core/PyObject::__getitem__ +2 host_object)] + (case [(org/python/core/PyObject::__getitem__ (ffi.as_int +0) host_object) + (org/python/core/PyObject::__getitem__ (ffi.as_int +1) host_object) + (org/python/core/PyObject::__getitem__ (ffi.as_int +2) host_object)] (^or [{try.#Failure try} _ _] [_ {try.#Failure try} _] [_ _ {try.#Failure try}]) @@ -327,7 +327,7 @@ [(case (ffi.check <jvm> (:as java/lang/Object it)) {.#Some it} (:as org/python/core/PyObject - (<python> [(:expected it)])) + (<python> [it])) {.#None})] @@ -361,8 +361,8 @@ (exception: (cannot_apply_a_non_function [object java/lang/Object]) (exception.report - ["Object" (java/lang/Object::toString object)] - ["Class" (java/lang/Class::getName (java/lang/Object::getClass object))])) + ["Object" (ffi.of_string (java/lang/Object::toString object))] + ["Class" (ffi.of_string (java/lang/Class::getName (java/lang/Object::getClass object)))])) (def: (expander macro inputs lux) Expander @@ -379,7 +379,7 @@ {try.#Failure error}) {.#None} - (exception.except ..cannot_apply_a_non_function (:as java/lang/Object macro)))))] + (exception.except ..cannot_apply_a_non_function [(:as java/lang/Object macro)]))))] (for [@.old (as_is <jvm>) @.jvm (as_is <jvm>) @@ -391,14 +391,14 @@ (with_expansions [<jvm> (def: host (IO (Host (_.Expression Any) (_.Statement Any))) (io (let [interpreter (org/python/util/PythonInterpreter::new) - evaluate! (: (-> unit.ID (_.Expression Any) (Try Any)) - (function (evaluate! context input) + evaluate! (: (-> unit.ID [(Maybe unit.ID) (_.Expression Any)] (Try Any)) + (function (evaluate! context [_ input]) (do try.monad - [output (org/python/util/PythonInterpreter::eval (_.code input) interpreter)] + [output (org/python/util/PythonInterpreter::eval (ffi.as_string (_.code input)) interpreter)] (..read output)))) execute! (: (-> (_.Statement Any) (Try Any)) (function (execute! input) - (case (org/python/util/PythonInterpreter::exec (_.code input) interpreter) + (case (org/python/util/PythonInterpreter::exec (ffi.as_string (_.code input)) interpreter) {try.#Failure error} (if (text.contains? "maximum recursion depth exceeded" error) (execute! input) @@ -410,14 +410,14 @@ (implementation (def: evaluate evaluate!) (def: execute execute!) - (def: (define context custom input) + (def: (define context custom [@def input]) (let [global (maybe.else (reference.artifact context) custom) @global (_.var global)] (do try.monad [.let [definition (_.set (list @global) input)] _ (execute! definition) - value (evaluate! context @global)] + value (evaluate! context [@def @global])] (in [global value definition])))) (def: (ingest context content) @@ -432,7 +432,7 @@ (def: (re_load context custom content) (do try.monad [_ (execute! content)] - (evaluate! context (_.var (reference.artifact context))))))))))] + (evaluate! context [{.#None} (_.var (reference.artifact context))]))))))))] (for [@.old <jvm> @.jvm <jvm> @@ -492,7 +492,7 @@ (do try.monad [handler (try.of_maybe (..python_function! handler)) output (org/python/core/PyFunction::__call__ (|> (ffi.array org/python/core/PyObject 5) - (ffi.write! 0 (:as org/python/core/PyObject (org/python/core/PyString::new name))) + (ffi.write! 0 (:as org/python/core/PyObject (org/python/core/PyString::new (ffi.as_string name)))) (ffi.write! 1 (:as org/python/core/PyObject (phase_wrapper phase))) (ffi.write! 2 (..to_host archive)) (ffi.write! 3 (..to_host parameters)) 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))))) + )))) |