From 08518ba37d9094c5cc8683fc404c349e534b8dc9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 24 Feb 2022 17:47:27 -0400 Subject: Finishing the meta-compiler [Part 4] --- stdlib/source/library/lux.lux | 17 +- .../library/lux/control/concurrency/atom.lux | 10 +- stdlib/source/library/lux/ffi.jvm.lux | 38 ++-- stdlib/source/library/lux/target/python.lux | 27 +-- .../library/lux/tool/compiler/default/platform.lux | 18 +- .../library/lux/tool/compiler/language/lux.lux | 36 +++- .../tool/compiler/language/lux/analysis/type.lux | 22 +- .../compiler/language/lux/phase/analysis/case.lux | 62 +++--- .../language/lux/phase/analysis/complex.lux | 3 +- .../language/lux/phase/extension/analysis/jvm.lux | 67 +++--- .../language/lux/phase/extension/directive/jvm.lux | 3 +- .../language/lux/phase/extension/directive/lux.lux | 3 +- .../lux/phase/extension/generation/jvm/host.lux | 3 +- .../phase/extension/generation/python/common.lux | 2 +- .../language/lux/phase/generation/jvm/function.lux | 3 +- .../language/lux/phase/generation/python/case.lux | 3 +- .../lux/phase/generation/python/function.lux | 3 +- .../language/lux/phase/generation/python/loop.lux | 3 +- .../lux/phase/generation/python/runtime.lux | 23 ++- .../language/lux/phase/generation/reference.lux | 7 +- .../lux/tool/compiler/meta/cache/artifact.lux | 228 --------------------- .../compiler/meta/cache/dependency/artifact.lux | 228 +++++++++++++++++++++ .../tool/compiler/meta/cache/dependency/module.lux | 99 +++++++++ .../lux/tool/compiler/meta/cache/module.lux | 139 +++++-------- .../source/library/lux/tool/compiler/meta/cli.lux | 22 +- .../library/lux/tool/compiler/meta/io/archive.lux | 61 +----- .../library/lux/tool/compiler/meta/packager.lux | 3 +- .../lux/tool/compiler/meta/packager/jvm.lux | 5 +- .../lux/tool/compiler/meta/packager/ruby.lux | 5 +- .../lux/tool/compiler/meta/packager/script.lux | 5 +- stdlib/source/library/lux/type/check.lux | 6 +- stdlib/source/program/compositor.lux | 9 +- stdlib/source/test/lux/target/python.lux | 212 ++++++++++++++----- .../language/lux/phase/analysis/complex.lux | 3 +- .../source/test/lux/tool/compiler/meta/cache.lux | 8 +- .../test/lux/tool/compiler/meta/cache/module.lux | 92 +++++++++ 36 files changed, 882 insertions(+), 596 deletions(-) delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/cache/module.lux (limited to 'stdlib/source') 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 [ (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 ] @@ -61,10 +61,10 @@ (def: .public (read! atom) (All (_ a) (-> (Atom a) (IO a))) - (io.io (with_expansions [ (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] - (for [@.old - @.jvm ] - ( 0 (:representation atom)))))) + (with_expansions [ (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] + (for [@.old + @.jvm ] + (io.io ( 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 [ (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)) _ ) @@ -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)}))) _ ) @@ -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 @@ {.#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:) + + _ + ) _ )))) @@ -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 [ ] [(# type.equivalence = (type.array ) @@ -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 [ ] @@ -456,20 +460,19 @@ (in (list.repeated arity (` (Expression Any))))) (template [ +] - [(with_expansions [ (template.symbol ["apply/" ]) - (arity_inputs ) - (arity_types ) + [(with_expansions [ (arity_inputs ) (template.spliced +)] - (def: .public ( function ) - (-> (Expression Any) (Computation Any)) - (..apply/* function (.list ))) - (template [] - [(`` (def: .public (~~ (template.symbol [ "/" ])) - ( (..var ))))] + [(`` (def: .public ((~~ (template.symbol [ "/" ])) ) + (-> (~~ (arity_types )) (Computation Any)) + (..apply/* (.list ) (..var ))))] ))] + [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 (_ ) - (-> Compiler (Async (Try [ (List Text) ///.Custom])))) + (-> Compiler (Async (Try [ (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 (_ ) - (-> ///phase.Wrapper Import Context Expander Compilation )) + (-> (-> Any ///.Custom) ///phase.Wrapper Import Context Expander Compilation )) (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 - ["" binary {"+" Parser}]]] + ["<[0]>" binary {"+" Parser}]]] [data [format ["_" binary {"+" Writer}]]] @@ -55,18 +55,32 @@ (def: .public parser (Parser .Module) (let [definition (: (Parser Definition) - ($_ <>.and .bit .type .any)) + ($_ <>.and + .bit + .type + .any)) labels (: (Parser [Text (List Text)]) - (<>.and .text (.list .text))) + ($_ <>.and + .text + (.list .text))) global_type (: (Parser [Bit Type (Either [Text (List Text)] [Text (List Text)])]) - ($_ <>.and .bit .type (.or labels labels))) + ($_ <>.and + .bit + .type + (.or labels labels))) global_label (: (Parser .Label) - ($_ <>.and .bit .type (.list .text) .nat)) + ($_ <>.and + .bit + .type + (.list .text) + .nat)) alias (: (Parser Alias) - (<>.and .text .text)) + ($_ <>.and + .text + .text)) global (: (Parser Global) - ($_ .or + ($_ .or definition global_type global_label @@ -74,13 +88,13 @@ alias))] ($_ <>.and ... #module_hash - .nat + .nat ... #module_aliases - (.list alias) + (.list alias) ... #definitions - (.list (<>.and .text global)) + (.list (<>.and .text global)) ... #imports - (.list .text) + (.list .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 [ ] [[location ] - (simple_pattern_analysis inputT location {/pattern.#Simple } next)]) + (simple_pattern_analysis :input: location {/pattern.#Simple } 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 [] - [{ 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 [] [{ env unquantified} @@ -629,13 +636,32 @@ _ (check_parameter objectT))) +(template [ ] + [(def: .public ( mapping typeJ) + (-> Mapping (Type ) (Operation .Type)) + (case (|> typeJ ..signature (.result ( 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 [ ] - [(def: .public ( mapping typeJ) - (-> Mapping (Type ) (Operation .Type)) - (case (|> typeJ ..signature (.result ( 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 [ <0>] [(def: 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 [ ] @@ -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/artifact.lux deleted file mode 100644 index 327cae965..000000000 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux +++ /dev/null @@ -1,228 +0,0 @@ -... https://en.wikipedia.org/wiki/Tree_shaking -(.using - [library - [lux "*" - [abstract - [hash {"+" Hash}] - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" monoid mix monad)] - ["[0]" set {"+" Set}] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence]]] - [math - [number - ["[0]" nat]]] - [meta - ["[0]" symbol]] - [tool - [compiler - ["[0]" phase] - ["[0]" reference {"+" Constant}] - [language - [lux - ["[0]" synthesis {"+" Synthesis Path}] - ["[0]" generation {"+" Operation}] - ["[0]" analysis - ["[1]/[0]" complex]]]] - [meta - ["[0]" archive {"+" Archive} - ["[0]" artifact] - ["[0]" registry {"+" Registry}] - ["[0]" unit]]]]]]]) - -(def: (path_references references) - (-> (-> Synthesis (List Constant)) - (-> Path (List Constant))) - (function (again path) - (case path - (^or {synthesis.#Pop} - {synthesis.#Access _} - {synthesis.#Bind _}) - (list) - - (^template [] - [{ left right} - ($_ list#composite - (again left) - (again right))]) - ([synthesis.#Alt] - [synthesis.#Seq]) - - {synthesis.#Bit_Fork when then else} - (case else - {.#Some else} - ($_ list#composite - (again then) - (again else)) - - {.#None} - (again then)) - - (^template [] - [{ fork} - (|> {.#Item fork} - (list#each (|>> product.right again)) - list#conjoint)]) - ([synthesis.#I64_Fork] - [synthesis.#F64_Fork] - [synthesis.#Text_Fork]) - - {synthesis.#Then then} - (references then)))) - -(def: (references value) - (-> Synthesis (List Constant)) - (case value - {synthesis.#Primitive value} - (list) - - {synthesis.#Structure value} - (case value - {analysis/complex.#Variant value} - (|> value - (value@ analysis/complex.#value) - references) - - {analysis/complex.#Tuple value} - (|> value - (list#each references) - list#conjoint)) - - {synthesis.#Reference value} - (case value - {reference.#Variable _} - (list) - - {reference.#Constant value} - (list value)) - - {synthesis.#Control value} - (case value - {synthesis.#Branch value} - (case value - {synthesis.#Exec this that} - ($_ list#composite - (references this) - (references that)) - - {synthesis.#Let input _ body} - ($_ list#composite - (references input) - (references body)) - - {synthesis.#If test then else} - ($_ list#composite - (references test) - (references then) - (references else)) - - {synthesis.#Get _ record} - (references record) - - {synthesis.#Case input path} - ($_ list#composite - (references input) - (path_references references path))) - - {synthesis.#Loop value} - (case value - {synthesis.#Scope value} - (|> value - (value@ synthesis.#iteration) - references) - - {synthesis.#Again value} - (|> value - (list#each references) - list#conjoint)) - - {synthesis.#Function value} - (case value - {synthesis.#Abstraction value} - (|> value - (value@ synthesis.#body) - references) - - {synthesis.#Apply function arguments} - (|> (list& function arguments) - (list#each references) - list#conjoint))) - - {synthesis.#Extension [name parameters]} - (|> parameters - (list#each references) - list#conjoint))) - -(def: .public (dependencies archive value) - (All (_ anchor expression directive) - (-> Archive Synthesis (Operation anchor expression directive (Set unit.ID)))) - (let [! phase.monad] - (|> value - ..references - (set.of_list symbol.hash) - set.list - (monad.each ! (generation.remember archive)) - (# ! each (set.of_list unit.hash))))) - -(def: .public (path_dependencies archive value) - (All (_ anchor expression directive) - (-> Archive Path (Operation anchor expression directive (Set unit.ID)))) - (let [! phase.monad] - (|> value - (..path_references ..references) - (set.of_list symbol.hash) - set.list - (monad.each ! (generation.remember archive)) - (# ! each (set.of_list unit.hash))))) - -(def: .public all - (-> (List (Set unit.ID)) - (Set unit.ID)) - (list#mix set.union unit.none)) - -(def: (immediate_dependencies archive) - (-> Archive [(List unit.ID) - (Dictionary unit.ID (Set unit.ID))]) - (|> archive - archive.entries - (list#each (function (_ [module [module_id [_module output registry]]]) - (|> registry - registry.artifacts - sequence.list - (list#each (function (_ [artifact dependencies]) - [[module_id (value@ artifact.#id artifact)] - (value@ artifact.#mandatory? artifact) - dependencies]))))) - list.together - (list#mix (function (_ [artifact_id mandatory? dependencies] - [mandatory_dependencies - all_dependencies]) - [(if mandatory? - (list& artifact_id mandatory_dependencies) - mandatory_dependencies) - (dictionary.has artifact_id dependencies all_dependencies)]) - [(list) - (dictionary.empty unit.hash)]))) - -(def: .public (necessary_dependencies archive) - (-> Archive (Set unit.ID)) - (let [[mandatory immediate] (immediate_dependencies archive)] - (loop [pending mandatory - minimum unit.none] - (case pending - {.#Item head tail} - (if (set.member? minimum head) - (again tail minimum) - (again (case (dictionary.value head immediate) - {.#Some additional} - (list#composite (set.list additional) tail) - - {.#None} - tail) - (set.has head minimum))) - - {.#End} - minimum)))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux new file mode 100644 index 000000000..327cae965 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux @@ -0,0 +1,228 @@ +... https://en.wikipedia.org/wiki/Tree_shaking +(.using + [library + [lux "*" + [abstract + [hash {"+" Hash}] + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" monoid mix monad)] + ["[0]" set {"+" Set}] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence]]] + [math + [number + ["[0]" nat]]] + [meta + ["[0]" symbol]] + [tool + [compiler + ["[0]" phase] + ["[0]" reference {"+" Constant}] + [language + [lux + ["[0]" synthesis {"+" Synthesis Path}] + ["[0]" generation {"+" Operation}] + ["[0]" analysis + ["[1]/[0]" complex]]]] + [meta + ["[0]" archive {"+" Archive} + ["[0]" artifact] + ["[0]" registry {"+" Registry}] + ["[0]" unit]]]]]]]) + +(def: (path_references references) + (-> (-> Synthesis (List Constant)) + (-> Path (List Constant))) + (function (again path) + (case path + (^or {synthesis.#Pop} + {synthesis.#Access _} + {synthesis.#Bind _}) + (list) + + (^template [] + [{ left right} + ($_ list#composite + (again left) + (again right))]) + ([synthesis.#Alt] + [synthesis.#Seq]) + + {synthesis.#Bit_Fork when then else} + (case else + {.#Some else} + ($_ list#composite + (again then) + (again else)) + + {.#None} + (again then)) + + (^template [] + [{ fork} + (|> {.#Item fork} + (list#each (|>> product.right again)) + list#conjoint)]) + ([synthesis.#I64_Fork] + [synthesis.#F64_Fork] + [synthesis.#Text_Fork]) + + {synthesis.#Then then} + (references then)))) + +(def: (references value) + (-> Synthesis (List Constant)) + (case value + {synthesis.#Primitive value} + (list) + + {synthesis.#Structure value} + (case value + {analysis/complex.#Variant value} + (|> value + (value@ analysis/complex.#value) + references) + + {analysis/complex.#Tuple value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Reference value} + (case value + {reference.#Variable _} + (list) + + {reference.#Constant value} + (list value)) + + {synthesis.#Control value} + (case value + {synthesis.#Branch value} + (case value + {synthesis.#Exec this that} + ($_ list#composite + (references this) + (references that)) + + {synthesis.#Let input _ body} + ($_ list#composite + (references input) + (references body)) + + {synthesis.#If test then else} + ($_ list#composite + (references test) + (references then) + (references else)) + + {synthesis.#Get _ record} + (references record) + + {synthesis.#Case input path} + ($_ list#composite + (references input) + (path_references references path))) + + {synthesis.#Loop value} + (case value + {synthesis.#Scope value} + (|> value + (value@ synthesis.#iteration) + references) + + {synthesis.#Again value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Function value} + (case value + {synthesis.#Abstraction value} + (|> value + (value@ synthesis.#body) + references) + + {synthesis.#Apply function arguments} + (|> (list& function arguments) + (list#each references) + list#conjoint))) + + {synthesis.#Extension [name parameters]} + (|> parameters + (list#each references) + list#conjoint))) + +(def: .public (dependencies archive value) + (All (_ anchor expression directive) + (-> Archive Synthesis (Operation anchor expression directive (Set unit.ID)))) + (let [! phase.monad] + (|> value + ..references + (set.of_list symbol.hash) + set.list + (monad.each ! (generation.remember archive)) + (# ! each (set.of_list unit.hash))))) + +(def: .public (path_dependencies archive value) + (All (_ anchor expression directive) + (-> Archive Path (Operation anchor expression directive (Set unit.ID)))) + (let [! phase.monad] + (|> value + (..path_references ..references) + (set.of_list symbol.hash) + set.list + (monad.each ! (generation.remember archive)) + (# ! each (set.of_list unit.hash))))) + +(def: .public all + (-> (List (Set unit.ID)) + (Set unit.ID)) + (list#mix set.union unit.none)) + +(def: (immediate_dependencies archive) + (-> Archive [(List unit.ID) + (Dictionary unit.ID (Set unit.ID))]) + (|> archive + archive.entries + (list#each (function (_ [module [module_id [_module output registry]]]) + (|> registry + registry.artifacts + sequence.list + (list#each (function (_ [artifact dependencies]) + [[module_id (value@ artifact.#id artifact)] + (value@ artifact.#mandatory? artifact) + dependencies]))))) + list.together + (list#mix (function (_ [artifact_id mandatory? dependencies] + [mandatory_dependencies + all_dependencies]) + [(if mandatory? + (list& artifact_id mandatory_dependencies) + mandatory_dependencies) + (dictionary.has artifact_id dependencies all_dependencies)]) + [(list) + (dictionary.empty unit.hash)]))) + +(def: .public (necessary_dependencies archive) + (-> Archive (Set unit.ID)) + (let [[mandatory immediate] (immediate_dependencies archive)] + (loop [pending mandatory + minimum unit.none] + (case pending + {.#Item head tail} + (if (set.member? minimum head) + (again tail minimum) + (again (case (dictionary.value head immediate) + {.#Some additional} + (list#composite (set.list additional) tail) + + {.#None} + tail) + (set.has head minimum))) + + {.#End} + minimum)))) 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 [ (exception.except ..cannot_enable [(//.path fs context) + @module + error])] + (do ! + [? (//.enable! fs context)] + (case ? + {try.#Failure error} + (in ) + + success + (|> path + (# fs make_directory) + (# ! each (|>> (case> {try.#Failure error} + -(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 (.this "build") - compiler) + compilation) (<>.after (.this "repl") - compiler) + compilation) (<>.after (.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 (|>> { 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 [ (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 (_ ) - (-> Context + (-> (-> Any compiler.Custom) + Context Expander analysis.Bundle (IO (Platform )) @@ -168,7 +169,7 @@ platform (Async (Try [Archive (directive.State+ )])) - (: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 [] + [(expression (|>> (:as Frac) (f.= expected/0)) + (/.item (/.int +0) + ( (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 [ ] + [(|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $var/0 $var/1) (/.multi (list (/.float expected/0) (/.float expected/1)))) + (/.set (list $output) )))) + (:as Frac) + (f.= ))] + + [$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 [] + [(def: + (# it ))] + + [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))))) + )))) -- cgit v1.2.3