diff options
Diffstat (limited to 'stdlib')
32 files changed, 649 insertions, 376 deletions
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 8ecdfb1f7..55cbe77ba 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -490,14 +490,16 @@ (list#each ..decorate_input)))))))) (template [<name> <jvm_op>] - [(def: (<name> class_name method_name arguments self_name) - (-> Text Text (List Argument) Text (Parser Code)) + [(def: (<name> class_vars class_name type_vars method_name arguments self_name) + (-> (List (Type Var)) Text (List (Type Var)) Text (List Argument) Text (Parser Code)) (do <>.monad [.let [dotted_name (format "::" method_name "!")] args (: (Parser (List Code)) (<code>.form (<>.after (<code>.this! (code.symbol ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] - (in (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) + (in (` (<jvm_op> [(~+ (list#each (|>> ..signature code.text) class_vars))] + (~ (code.text class_name)) (~ (code.text method_name)) + [(~+ (list#each (|>> ..signature code.text) type_vars))] (~ (code.local_symbol self_name)) (~+ (|> args (list.zipped/2 (list#each product.right arguments)) @@ -507,8 +509,8 @@ [virtual_method_parser "jvm member invoke virtual"] ) -(def: (method->parser class_name [[method_name _ _] meth_def]) - (-> Text [Member_Declaration Method_Definition] (Parser Code)) +(def: (method->parser class_vars class_name [[method_name _ _] meth_def]) + (-> (List (Type Var)) Text [Member_Declaration Method_Definition] (Parser Code)) (case meth_def {#ConstructorMethod strict? type_vars self_name args constructor_args return_expr exs} (constructor_parser class_name args) @@ -517,16 +519,16 @@ (static_method_parser class_name method_name args) {#VirtualMethod final? strict? type_vars self_name args return_type return_expr exs} - (virtual_method_parser class_name method_name args self_name) + (virtual_method_parser class_vars class_name type_vars method_name args self_name) {#OverridenMethod strict? owner_class type_vars self_name args return_type return_expr exs} - (special_method_parser class_name method_name args self_name) + (special_method_parser class_vars class_name type_vars method_name args self_name) {#AbstractMethod type_vars args return_type exs} - (virtual_method_parser class_name method_name args "") + (virtual_method_parser class_vars class_name type_vars method_name args "") {#NativeMethod type_vars args return_type exs} - (virtual_method_parser class_name method_name args ""))) + (virtual_method_parser class_vars class_name type_vars method_name args ""))) (def: privacy_modifier^ (Parser Privacy) @@ -1129,8 +1131,10 @@ [_ (<code>.this! (' ::super!)) args (<code>.tuple (<>.exactly (list.size arguments) <code>.any))] (in (` ("jvm member invoke special" + [(~+ (list#each (|>> ..signature code.text) (product.right (parser.declaration declaration))))] (~ (code.text (product.left (parser.read_class super_class)))) (~ (code.text name)) + [(~+ (list#each (|>> ..signature code.text) type_vars))] (~ (code.local_symbol self_name)) (~+ (|> args (list.zipped/2 (list#each product.right arguments)) @@ -1206,7 +1210,7 @@ [.let [fully_qualified_class_name full_class_name method_parser (: (Parser Code) (|> methods - (list#each (method->parser fully_qualified_class_name)) + (list#each (method->parser class_vars fully_qualified_class_name)) (list#mix <>.either (<>.failure ""))))]] (in (list (` ("jvm class" (~ (declaration$ (type.declaration full_class_name class_vars))) diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux index c4160aa3c..138f2ccf9 100644 --- a/stdlib/source/library/lux/tool/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler.lux @@ -1,20 +1,21 @@ (.using - [library - [lux {"-" Module Code} - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - [binary {"+" Binary}] - ["[0]" text]] - [world - ["[0]" file {"+" Path}]]]] - [/ - [meta - ["[0]" archive {"+" Output Archive} - [key {"+" Key}] + [library + [lux {"-" Module Code} + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + [binary {"+" Binary}] + ["[0]" text]] + [world + ["[0]" file {"+" Path}]]]] + [/ + [meta + ["[0]" archive {"+" Output Archive} + [key {"+" Key}] + [module [descriptor {"+" Descriptor Module}] - [document {"+" Document}]]]]) + [document {"+" Document}]]]]]) (type: .public Code Text) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index ebdddd347..fc7e1b637 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -47,9 +47,9 @@ [meta ["[0]" archive {"+" Archive} ["[0]" registry {"+" Registry}] - ["[0]" module] - ["[0]" descriptor] - ["[0]" document]]]]]) + ["[0]" module + ["[0]" descriptor] + ["[0]" document]]]]]]) (def: .public (state target module expander host_analysis host generate generation_bundle) (All (_ anchor expression directive) @@ -219,7 +219,7 @@ (def: (default_dependencies prelude input) (-> descriptor.Module ///.Input (List descriptor.Module)) - (list& archive.runtime_module + (list& descriptor.runtime (if (text#= prelude (value@ ///.#module input)) (list) (list prelude)))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index d20a1b7d7..668daffc5 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -52,9 +52,9 @@ ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] ["[0]" artifact] - ["[0]" module] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" document {"+" Document}]] + ["[0]" module + ["[0]" descriptor {"+" Descriptor}] + ["[0]" document {"+" Document}]]] [io {"+" Context} ["[0]" context] ["ioW" archive]]]]] @@ -145,7 +145,7 @@ (def: runtime_descriptor Descriptor [descriptor.#hash 0 - descriptor.#name archive.runtime_module + descriptor.#name descriptor.runtime descriptor.#file "" descriptor.#references (set.empty text.hash) descriptor.#state {.#Compiled}]) @@ -169,11 +169,11 @@ [[registry payload] (///directive.lifted_generation (..compile_runtime! platform)) .let [entry [..runtime_module payload registry]] - archive (///phase.lifted (if (archive.reserved? archive archive.runtime_module) - (archive.has archive.runtime_module entry archive) + archive (///phase.lifted (if (archive.reserved? archive descriptor.runtime) + (archive.has descriptor.runtime entry archive) (do try.monad - [[_ archive] (archive.reserve archive.runtime_module archive)] - (archive.has archive.runtime_module entry archive))))] + [[_ archive] (archive.reserve descriptor.runtime archive)] + (archive.has descriptor.runtime entry archive))))] (in [archive entry]))) (def: (initialize_state extender @@ -275,7 +275,7 @@ analysis_state) (try#each (|>> (//init.with_default_directives expander host_analysis program anchorT,expressionT,directiveT (extender phase_wrapper)) [phase_wrapper])))))))]] - (if (archive.archived? archive archive.runtime_module) + (if (archive.archived? archive descriptor.runtime) (do ! [[phase_wrapper state] (with_missing_extensions platform program state)] (in [state archive phase_wrapper])) @@ -483,7 +483,7 @@ (:expected (stm.commit! (do [! stm.monad] - [dependence (if (text#= archive.runtime_module importer) + [dependence (if (text#= descriptor.runtime importer) (stm.read dependence) (do ! [[_ dependence] (stm.update (..depend importer module) dependence)] @@ -724,5 +724,5 @@ compiler (|> (..compiler phase_wrapper expander platform) (serial_compiler import static platform sources) (..parallel context))] - (compiler archive.runtime_module module))) + (compiler descriptor.runtime module))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux index b4a03855c..94b7a7894 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux @@ -1,24 +1,25 @@ (.using - [library - [lux {"-" Module} - [abstract - [monad {"+" do}]] - [control - ["[0]" try]] - [data - [collection - ["[0]" list ("[1]#[0]" monoid)]]]]] - [// - ["[0]" analysis] - ["[0]" synthesis] - ["[0]" generation] - [phase - ["[0]" extension]] - [/// - ["[0]" phase] - [meta - [archive - [descriptor {"+" Module}]]]]]) + [library + [lux {"-" Module} + [abstract + [monad {"+" do}]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list ("[1]#[0]" monoid)]]]]] + [// + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [meta + [archive + [module + [descriptor {"+" Module}]]]]]]) (type: .public (Component state phase) (Record diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 74580074c..4c810f8c5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -31,11 +31,11 @@ ["[0]" phase] [meta ["[0]" archive {"+" Archive} - ["[0]" descriptor] - ["[0]" module] ["[0]" artifact] ["[0]" registry {"+" Registry}] - ["[0]" unit]]]]]) + ["[0]" unit] + ["[0]" module + ["[0]" descriptor]]]]]]) (type: .public (Buffer directive) (Sequence [artifact.ID (Maybe Text) directive])) 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 b45be6e93..2b146414f 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 @@ -4,7 +4,8 @@ ["[0]" ffi {"+" import:}] ["[0]" meta] [abstract - ["[0]" monad {"+" do}]] + ["[0]" monad {"+" do}] + ["[0]" predicate]] [control pipe ["[0]" maybe] @@ -60,7 +61,8 @@ ["[0]" phase ("[1]#[0]" monad)] [meta [archive {"+" Archive} - [descriptor {"+" Module}]]]]]]]]) + [module + [descriptor {"+" Module}]]]]]]]]]) (import: java/lang/ClassLoader) @@ -80,7 +82,9 @@ ("static" isStatic [int] boolean) ("static" isFinal [int] boolean) ("static" isInterface [int] boolean) - ("static" isAbstract [int] boolean)]) + ("static" isAbstract [int] boolean) + ("static" isPublic [int] boolean) + ("static" isProtected [int] boolean)]) (import: java/lang/annotation/Annotation) @@ -1592,31 +1596,36 @@ (value_analysis argumentJT)))) (template [<name> <only>] - [(def: <name> - (-> (java/lang/Class java/lang/Object) - (Try (List [Text (Type Method)]))) - (|>> java/lang/Class::getDeclaredMethods - (array.list {.#None}) - <only> - (monad.each try.monad - (function (_ method) - (do [! try.monad] - [.let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method) - (array.list {.#None}) - (list#each (|>> java/lang/reflect/TypeVariable::getName - jvm.var)))] - inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) - (array.list {.#None}) - (monad.each ! reflection!.type)) - return (..return_type method) - .let [concrete_exceptions (..concrete_method_exceptions method)] - generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) - (array.list {.#None}) - (monad.each ! reflection!.class))] - (in [(java/lang/reflect/Method::getName method) - (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions) - concrete_exceptions - generic_exceptions)])]))))))] + [(def: (<name> [type class]) + (-> [(Type Class) (java/lang/Class java/lang/Object)] + (Try (List [(Type Class) Text (Type Method)]))) + (|> class + java/lang/Class::getDeclaredMethods + (array.list {.#None}) + (list.only (|>> java/lang/reflect/Method::getModifiers + (predicate.or (|>> java/lang/reflect/Modifier::isPublic) + (|>> java/lang/reflect/Modifier::isProtected)))) + <only> + (monad.each try.monad + (function (_ method) + (do [! try.monad] + [.let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method) + (array.list {.#None}) + (list#each (|>> java/lang/reflect/TypeVariable::getName + jvm.var)))] + inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) + (array.list {.#None}) + (monad.each ! reflection!.type)) + return (..return_type method) + .let [concrete_exceptions (..concrete_method_exceptions method)] + generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) + (array.list {.#None}) + (monad.each ! reflection!.class))] + (in [type + (java/lang/reflect/Method::getName method) + (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions) + concrete_exceptions + generic_exceptions)])]))))))] [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] @@ -1626,8 +1635,12 @@ (template [<name> <methods>] [(def: (<name> class_loader) - (-> java/lang/ClassLoader (List (Type Class)) (Try (List [Text (Type Method)]))) - (|>> (monad.each try.monad (|>> ..reflection (reflection!.load class_loader))) + (-> java/lang/ClassLoader (List (Type Class)) (Try (List [(Type Class) Text (Type Method)]))) + (|>> (monad.each try.monad (function (_ type) + (|> type + ..reflection + (reflection!.load class_loader) + (try#each (|>> [type]))))) (try#each (monad.each try.monad <methods>)) try#conjoint (try#each list#conjoint)))] @@ -1637,12 +1650,14 @@ ) (template [<name>] - [(exception: .public (<name> [methods (List [Text (Type Method)])]) - (exception.report - ["Methods" (exception.listing - (function (_ [name type]) - (format (%.text name) " " (..signature type))) - methods)]))] + [(exception: .public (<name> [expected (List [(Type Class) Text (Type Method)]) + actual (List [(Type Class) Text (Type Method)])]) + (let [%method (: (%.Format [(Type Class) Text (Type Method)]) + (function (_ [super name type]) + (format (..signature super) " :: " (%.text name) " " (..signature type))))] + (exception.report + ["Expected Methods" (exception.listing %method expected)] + ["Actual Methods" (exception.listing %method actual)])))] [missing_abstract_methods] [invalid_overriden_methods] @@ -2166,13 +2181,14 @@ (in [parameterJ parameterT]))))) (def: (mismatched_methods super_set sub_set) - (-> (List [Text (Type Method)]) - (List [Text (Type Method)]) - (List [Text (Type Method)])) - (list.only (function (_ [sub_name subJT]) + (-> (List [(Type Class) Text (Type Method)]) + (List [(Type Class) Text (Type Method)]) + (List [(Type Class) Text (Type Method)])) + (list.only (function (_ [sub sub_name subJT]) (|> super_set - (list.only (function (_ [super_name superJT]) - (and (text#= super_name sub_name) + (list.only (function (_ [super super_name superJT]) + (and (jvm#= super sub) + (text#= super_name sub_name) (jvm#= superJT subJT)))) list.size (n.= 1) @@ -2229,17 +2245,18 @@ body]) (do ! [aliasing (super_aliasing class_loader parent_type)] - (in [method_name (|> (jvm.method [type_vars - (list#each product.right arguments) - return - exceptions]) - (jvm_alias.method aliasing))]))) + (in (|> (jvm.method [type_vars + (list#each product.right arguments) + return + exceptions]) + (jvm_alias.method aliasing) + [parent_type method_name])))) methods) .let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods) invalid_overriden_methods (mismatched_methods available_methods overriden_methods)] - _ (phase.assertion ..missing_abstract_methods missing_abstract_methods + _ (phase.assertion ..missing_abstract_methods [required_abstract_methods missing_abstract_methods] (list.empty? missing_abstract_methods)) - _ (phase.assertion ..invalid_overriden_methods invalid_overriden_methods + _ (phase.assertion ..invalid_overriden_methods [available_methods invalid_overriden_methods] (list.empty? invalid_overriden_methods))] (in []))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index 8062838f7..d27c8ceac 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -1,32 +1,30 @@ (.using - [library - [lux "*" - ["[0]" ffi] - [abstract - ["[0]" monad {"+" do}]] - [control - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - [collection - ["[0]" array {"+" Array}] - ["[0]" dictionary] - ["[0]" list]]] - ["[0]" type - ["[0]" check]] - ["@" target - ["_" python]]]] + [library + [lux "*" + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + [collection + ["[0]" array {"+" Array}] + ["[0]" dictionary] + ["[0]" list]]] + ["[0]" type + ["[0]" check]] + ["@" target + ["_" python]]]] + [// + ["/" lux {"+" custom}] [// - ["/" lux {"+" custom}] - [// - ["[0]" bundle] - [// - ["[0]" analysis "_" - ["[1]/[0]" type]] - [// - ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] - [/// - ["[0]" phase]]]]]]) + ["[0]" bundle] + [/// + ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle} + ["[1]/[0]" type]] + [/// + ["[0]" phase]]]]]) (def: array::new Handler @@ -34,10 +32,10 @@ [<code>.any (function (_ extension phase archive lengthC) (do phase.monad - [lengthA (analysis/type.with_type Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.with_env check.var) - _ (analysis/type.infer (type (Array varT)))] + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + [var_id varT] (analysis/type.check check.var) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list lengthA)})))])) (def: array::length @@ -46,10 +44,10 @@ [<code>.any (function (_ extension phase archive arrayC) (do phase.monad - [[var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer Nat)] + [[var_id varT] (analysis/type.check check.var) + arrayA (analysis/type.expecting (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] (in {analysis.#Extension extension (list arrayA)})))])) (def: array::read @@ -58,12 +56,12 @@ [(<>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer varT)] + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + arrayA (analysis/type.expecting (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.inference varT)] (in {analysis.#Extension extension (list indexA arrayA)})))])) (def: array::write @@ -72,14 +70,14 @@ [($_ <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - valueA (analysis/type.with_type varT - (phase archive valueC)) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + valueA (analysis/type.expecting varT + (phase archive valueC)) + arrayA (analysis/type.expecting (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) (def: array::delete @@ -88,12 +86,12 @@ [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + [var_id varT] (analysis/type.check check.var) + arrayA (analysis/type.expecting (type (Array varT)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array varT)))] (in {analysis.#Extension extension (list indexA arrayA)})))])) (def: bundle::array @@ -133,9 +131,9 @@ [($_ <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad - [objectA (analysis/type.with_type ..Object - (phase archive objectC)) - _ (analysis/type.infer .Any)] + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + _ (analysis/type.inference .Any)] (in {analysis.#Extension extension (list (analysis.text fieldC) objectA)})))])) @@ -145,10 +143,10 @@ [($_ <>.and <code>.text <code>.any (<>.some <code>.any)) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] - [objectA (analysis/type.with_type ..Object - (phase archive objectC)) - inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) - _ (analysis/type.infer .Any)] + [objectA (analysis/type.expecting ..Object + (phase archive objectC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference .Any)] (in {analysis.#Extension extension (list& (analysis.text methodC) objectA inputsA)})))])) @@ -169,7 +167,7 @@ [<code>.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.infer Any)] + [_ (analysis/type.inference Any)] (in {analysis.#Extension extension (list (analysis.text name))})))])) (def: python::import @@ -178,7 +176,7 @@ [<code>.text (function (_ extension phase archive name) (do phase.monad - [_ (analysis/type.infer ..Object)] + [_ (analysis/type.inference ..Object)] (in {analysis.#Extension extension (list (analysis.text name))})))])) (def: python::apply @@ -187,10 +185,10 @@ [($_ <>.and <code>.any (<>.some <code>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] - [abstractionA (analysis/type.with_type ..Function - (phase archive abstractionC)) - inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) - _ (analysis/type.infer Any)] + [abstractionA (analysis/type.expecting ..Function + (phase archive abstractionC)) + inputsA (monad.each ! (|>> (phase archive) (analysis/type.expecting Any)) inputsC) + _ (analysis/type.inference Any)] (in {analysis.#Extension extension (list& abstractionA inputsA)})))])) (def: python::function @@ -200,9 +198,9 @@ (function (_ extension phase archive [arity abstractionC]) (do phase.monad [.let [inputT (type.tuple (list.repeated arity Any))] - abstractionA (analysis/type.with_type (-> inputT Any) - (phase archive abstractionC)) - _ (analysis/type.infer ..Function)] + abstractionA (analysis/type.expecting (-> inputT Any) + (phase archive abstractionC)) + _ (analysis/type.inference ..Function)] (in {analysis.#Extension extension (list (analysis.nat arity) abstractionA)})))])) @@ -212,11 +210,11 @@ [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [codeC globalsC]) (do phase.monad - [codeA (analysis/type.with_type Text - (phase archive codeC)) - globalsA (analysis/type.with_type ..Dict - (phase archive globalsC)) - _ (analysis/type.infer .Any)] + [codeA (analysis/type.expecting Text + (phase archive codeC)) + globalsA (analysis/type.expecting ..Dict + (phase archive globalsC)) + _ (analysis/type.inference .Any)] (in {analysis.#Extension extension (list codeA globalsA)})))])) (def: .public bundle 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 02cf2791f..ffa8e8b03 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 @@ -994,41 +994,60 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: (anonymous_init_method env) - (-> (Environment Synthesis) (Type category.Method)) +(def: (anonymous_init_method env inputsTI) + (-> (Environment Synthesis) (List (Typed (Bytecode Any))) (Type category.Method)) (type.method [(list) - (list.repeated (list.size env) ..$Object) + (list.repeated (n.+ (list.size inputsTI) (list.size env)) ..$Object) type.void (list)])) (def: (with_anonymous_init class env super_class inputsTG) (-> (Type category.Class) (Environment Synthesis) (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) - (let [store_capturedG (|> env + (let [inputs_offset (list.size inputsTG) + inputs! (|> inputsTG + list.enumeration + (list#each (function (_ [register [type term]]) + (let [then! (case (type.primitive? type) + {.#Right type} + (///value.unwrap type) + + {.#Left type} + (_.checkcast type))] + ($_ _.composite + (_.aload (++ register)) + then!)))) + list.reversed + (list#mix _.composite (_#in []))) + store_captured! (|> env list.size list.indices (monad.each _.monad (.function (_ register) ($_ _.composite (_.aload 0) - (_.aload (++ register)) + (_.aload (n.+ inputs_offset (++ register))) (_.putfield class (///reference.foreign_name register) $Object)))))] - (method.method method.public "<init>" (anonymous_init_method env) + (method.method method.public "<init>" (anonymous_init_method env inputsTG) (list) {.#Some ($_ _.composite (_.aload 0) - (monad.each _.monad product.right inputsTG) + inputs! (_.invokespecial super_class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)])) - store_capturedG + store_captured! _.return)}))) -(def: (anonymous_instance generate archive class env) - (-> Phase Archive (Type category.Class) (Environment Synthesis) (Operation (Bytecode Any))) +(def: (anonymous_instance generate archive class env inputsTI) + (-> Phase Archive (Type category.Class) (Environment Synthesis) (List (Typed (Bytecode Any))) (Operation (Bytecode Any))) (do [! //////.monad] [captureG+ (monad.each ! (generate archive) env)] (in ($_ _.composite (_.new class) _.dup + (|> inputsTI + (list#each product.right) + list.reversed + (list#mix _.composite (_#in []))) (monad.all _.monad captureG+) - (_.invokespecial class "<init>" (anonymous_init_method env)))))) + (_.invokespecial class "<init>" (anonymous_init_method env inputsTI)))))) (def: (returnG returnT) (-> (Type Return) (Bytecode Any)) @@ -1236,7 +1255,7 @@ .let [artifact [anonymous_class_name bytecode]] _ (//////generation.execute! artifact) _ (//////generation.save! artifact_id {.#None} artifact)] - (anonymous_instance generate archive class total_environment)))])) + (anonymous_instance generate archive class total_environment inputsTI)))])) (def: bundle::class Bundle 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 4a1e1b205..fd9a3a0cc 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 @@ -21,7 +21,7 @@ ["//[1]" /// "_" [analysis {"+" Environment Abstraction Reification Analysis}] [synthesis {"+" Synthesis}] - ["[1][0]" generation {"+" Context}] + ["[1][0]" generation] ["//[1]" /// "_" [arity {"+" Arity}] ["[1][0]" phase] 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 790853c23..ebe9f4e75 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 @@ -39,7 +39,7 @@ [meta [archive {"+" Output Archive} ["[0]" registry {"+" Registry}] - ["[0]" artifact]]]]]]) + ["[0]" unit]]]]]]) (template [<name> <base>] [(type: .public <name> @@ -452,7 +452,7 @@ [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id {.#None} ..runtime)] (in [(|> registry.empty - (registry.resource true artifact.no_dependencies) + (registry.resource true unit.none) product.right) (sequence.sequence [..module_id {.#None} 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 34ecfcf7a..937ead1dc 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 @@ -1,19 +1,20 @@ (.using - [library - [lux {"-" local} - ["@" target] - [data - [text - ["%" format {"+" format}]]]]] - ["[0]" //// "_" - ["[0]" version] - ["[1][0]" generation {"+" Context}] - ["//[1]" /// "_" - ["[0]" reference {"+" Reference} - ["[0]" variable {"+" Register Variable}]] - ["[0]" phase ("[1]#[0]" monad)] - [meta - [archive {"+" Archive}]]]]) + [library + [lux {"-" local} + ["@" target] + [data + [text + ["%" format {"+" format}]]]]] + ["[0]" //// "_" + ["[0]" version] + ["[1][0]" generation] + ["//[1]" /// "_" + ["[0]" phase ("[1]#[0]" monad)] + ["[0]" reference {"+" Reference} + ["[0]" variable {"+" Register Variable}]] + [meta + [archive {"+" Archive} + ["[0]" unit]]]]]) ... This universe constant is for languages where one can't just turn all compiled definitions ... into the local variables of some scoping function. @@ -38,7 +39,7 @@ ""))) (def: .public (artifact [module artifact]) - (-> Context Text) + (-> unit.ID Text) (format "l" (%.nat version.version) ..universe_label "m" (%.nat module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index d8a683545..fc3e28aa2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -16,9 +16,10 @@ [//// [meta ["[0]" archive {"+" Archive} - ["[0]" descriptor] ["[0]" registry {"+" Registry}] - ["[0]" unit]]]]) + ["[0]" unit] + [module + ["[0]" descriptor]]]]]) (type: .public (Program expression directive) (-> unit.ID expression directive)) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 9f34caa2d..d8347d9fd 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -33,9 +33,9 @@ ["[0]" registry {"+" Registry}] ["[0]" signature {"+" Signature}] ["[0]" key {"+" Key}] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" document {"+" Document}] - ["[0]" module {"+" Module}] + ["[0]" module {"+" Module} + ["[0]" descriptor {"+" Descriptor}] + ["[0]" document {"+" Document}]] [/// [version {"+" Version}]]]) @@ -66,10 +66,6 @@ [module_is_only_reserved] ) -(def: .public runtime_module - descriptor.Module - "") - (type: .public (Entry a) (Record [#module (Module a) @@ -256,37 +252,12 @@ ["Expected" (%.nat expected)] ["Actual" (%.nat actual)])) - (exception: .public corrupt_data) - - (def: (correct_modules? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list#each product.left) - (set.of_list text.hash) - set.size))) - - (def: (correct_ids? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list#each product.right) - (set.of_list n.hash) - set.size))) - - (def: (correct_reservations? reservations) - (-> (List Reservation) Bit) - (and (correct_modules? reservations) - (correct_ids? reservations))) - (def: .public (import expected binary) (-> Version Binary (Try Archive)) (do try.monad [[actual next reservations] (<binary>.result ..reader binary) _ (exception.assertion ..version_mismatch [expected actual] - (n#= expected actual)) - _ (exception.assertion ..corrupt_data [] - (correct_reservations? reservations))] + (n#= expected actual))] (in (:abstraction [#next next #resolver (list#mix (function (_ [module id] archive) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux index 9e6280b25..7004302b8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux @@ -1,7 +1,7 @@ (.using [library [lux {"-" Module}]] - [// + [/ [descriptor {"+" Descriptor}] [document {"+" Document}]]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux index f91f8375f..cc8fbbf2b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -22,6 +22,10 @@ (type: .public Module Text) +(def: .public runtime + Module + "") + (type: .public Descriptor (Record [#name Module diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux index 432e1573c..b3be41585 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux @@ -15,7 +15,7 @@ ["[0]" binary {"+" Writer}]]] [type {"+" :sharing} abstract]]] - [// + [/// ["[0]" signature {"+" Signature}] ["[0]" key {"+" Key}]]) 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 c6c1a7e5e..ce408795a 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -19,9 +19,9 @@ [/// ["[0]" archive {"+" Output Archive} [key {"+" Key}] - ["[0]" module] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" document {"+" Document}]]]) + ["[0]" module + ["[0]" descriptor {"+" Descriptor}] + ["[0]" document {"+" Document}]]]]) (type: .public Ancestry (Set descriptor.Module)) 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 d0498a516..63cae0681 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -37,12 +37,12 @@ ["/[1]" // ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] - ["[0]" module] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" document {"+" Document}] ["[0]" unit] ["[0]" artifact {"+" Artifact} - ["[0]" category {"+" Category}]]] + ["[0]" category {"+" Category}]] + ["[0]" module + ["[0]" descriptor {"+" Descriptor}] + ["[0]" document {"+" Document}]]] ["[0]" cache "_" ["[1]/[0]" module]] ["/[1]" // {"+" Input} @@ -442,7 +442,7 @@ (do [! (try.with async.monad)] [data (..read_module_descriptor fs static module_id) [module registry] (async#in (<binary>.result ..parser data))] - (if (text#= archive.runtime_module module_name) + (if (text#= descriptor.runtime module_name) (in [true <cache>]) (do ! [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index 4416fdb3d..400c9e6d2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -1,35 +1,36 @@ (.using - [library - [lux {"-" Module Code} - ["@" target] - [abstract - [predicate {"+" Predicate}] - ["[0]" monad {"+" Monad do}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - [concurrency - ["[0]" async {"+" Async} ("[1]#[0]" monad)]]] - [data - [binary {"+" Binary}] - ["[0]" text ("[1]#[0]" hash) - ["%" format {"+" format}] - [encoding - ["[0]" utf8]]] - [collection - ["[0]" dictionary {"+" Dictionary}] - ["[0]" list]]] - [world - ["[0]" file]]]] - [program - [compositor - [import {"+" Import}]]] - ["[0]" // {"+" Context Code} - ["/[1]" // "_" - [archive - [descriptor {"+" Module}]] - ["/[1]" // {"+" Input}]]]) + [library + [lux {"-" Module Code} + ["@" target] + [abstract + [predicate {"+" Predicate}] + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + [concurrency + ["[0]" async {"+" Async} ("[1]#[0]" monad)]]] + [data + [binary {"+" Binary}] + ["[0]" text ("[1]#[0]" hash) + ["%" format {"+" format}] + [encoding + ["[0]" utf8]]] + [collection + ["[0]" dictionary {"+" Dictionary}] + ["[0]" list]]] + [world + ["[0]" file]]]] + [program + [compositor + [import {"+" Import}]]] + ["[0]" // {"+" Context Code} + ["/[1]" // "_" + ["/[1]" // {"+" Input}] + [archive + [module + [descriptor {"+" Module}]]]]]) (exception: .public (cannot_find_module [importer Module module Module]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index ea9e446e9..94b6f798e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -18,9 +18,9 @@ ["[0]" archive {"+" Archive} ["[0]" artifact] ["[0]" registry] - ["[0]" module] - ["[0]" descriptor] - ["[0]" unit]]]) + ["[0]" unit] + ["[0]" module + ["[0]" descriptor]]]]) (type: .public Packager (-> (Dictionary file.Path Binary) 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 706db97ff..f6af3d365 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -32,10 +32,10 @@ ["[0]" // {"+" Packager} [// ["[0]" archive {"+" Output} - ["[0]" module] - ["[0]" descriptor {"+" Module}] ["[0]" artifact] - ["[0]" unit]] + ["[0]" unit] + ["[0]" module + ["[0]" descriptor {"+" Module}]]] ["[0]" cache "_" ["[1]/[0]" module] ["[1]/[0]" artifact]] 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 e014c3403..67b7250c3 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -24,8 +24,9 @@ [// ["[0]" archive {"+" Output} ["[0]" artifact] - ["[0]" module] - ["[0]" descriptor]] + ["[0]" unit] + ["[0]" module + ["[0]" descriptor]]] ["[0]" cache "_" ["[1]/[0]" module] ["[1]/[0]" artifact]] @@ -33,12 +34,11 @@ ["[1]" archive]] [// [language - ["$" lux - [generation {"+" Context}]]]]]]) + ["$" lux]]]]]) (def: (write_module necessary_dependencies sequence [module_id output] so_far) (All (_ directive) - (-> (Set Context) (-> directive directive directive) [module.ID Output] directive + (-> (Set unit.ID) (-> directive directive directive) [module.ID Output] directive (Try directive))) (|> output sequence.list diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index bb7c80765..59c53550e 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -42,8 +42,9 @@ [meta [packager {"+" Packager}] [archive {"+" Archive} - [descriptor {"+" Module}] - ["[0]" unit]] + ["[0]" unit] + [module + [descriptor {"+" Module}]]] [io ["ioW" archive]]]] ... ["[0]" interpreter] diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux index e36de7098..1962569b3 100644 --- a/stdlib/source/program/compositor/cli.lux +++ b/stdlib/source/program/compositor/cli.lux @@ -1,17 +1,18 @@ (.using - [library - [lux {"-" Module Source} - [control - [pipe {"+" case>}] - ["<>" parser - ["[0]" cli {"+" Parser}]]] - [tool - [compiler - [meta - [archive - [descriptor {"+" Module}]]]]] - [world - [file {"+" Path}]]]]) + [library + [lux {"-" Module Source} + [control + [pipe {"+" case>}] + ["<>" parser + ["[0]" cli {"+" Parser}]]] + [tool + [compiler + [meta + [archive + [module + [descriptor {"+" Module}]]]]]] + [world + [file {"+" Path}]]]]) (type: .public Source Path) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 484322c8f..9554ec934 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -1,33 +1,34 @@ (.using - [library - [lux {"-" Module} - [abstract - ["[0]" monad {"+" Monad do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - [concurrency - ["[0]" async {"+" Async} ("[1]#[0]" monad)]] - ["<>" parser - ["<[0]>" binary]]] - [data - [binary {"+" Binary}] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence]] - [format - ["[0]" tar]]] - [tool - [compiler - [meta - [archive - [descriptor {"+" Module}]]]]] - [world - ["[0]" file]]]] - [// - [cli {"+" Library}]]) + [library + [lux {"-" Module} + [abstract + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + [concurrency + ["[0]" async {"+" Async} ("[1]#[0]" monad)]] + ["<>" parser + ["<[0]>" binary]]] + [data + [binary {"+" Binary}] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence]] + [format + ["[0]" tar]]] + [tool + [compiler + [meta + [archive + [module + [descriptor {"+" Module}]]]]]] + [world + ["[0]" file]]]] + [// + [cli {"+" Library}]]) (def: Action (type (All (_ a) (Async (Try a))))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c05f16b50..82e92e097 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -19,15 +19,7 @@ ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" - ["[1]/[0]" archive "_" - ["[1]/[0]" signature] - ["[1]/[0]" key] - ["[1]/[0]" artifact] - ["[1]/[0]" registry] - ["[1]/[0]" module] - ["[1]/[0]" document] - ["[1]/[0]" descriptor] - ["[1]/[0]" unit]]] + ["[1]/[0]" archive]] ]]) (def: .public test @@ -38,14 +30,7 @@ /reference.test /phase.test /analysis.test - /meta/archive/signature.test - /meta/archive/key.test - /meta/archive/artifact.test - /meta/archive/registry.test - /meta/archive/module.test - /meta/archive/document.test - /meta/archive/descriptor.test - /meta/archive/unit.test + /meta/archive.test /phase/extension.test /phase/analysis/simple.test ... /syntax.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux new file mode 100644 index 000000000..62dbff389 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux @@ -0,0 +1,258 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list] + ["[0]" set ("[1]#[0]" equivalence)] + ["[0]" sequence]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [meta + ["[0]" symbol "_" + ["$[1]" \\test]]]]] + [\\library + ["[0]" / + ["[1][0]" key] + ["[1][0]" registry] + ["[1][0]" signature] + ["[1][0]" module + ["[2][0]" document] + ["[2][0]" descriptor]]]] + ["$[0]" / "_" + ["[1][0]" signature] + ["[1][0]" key] + ["[1][0]" artifact] + ["[1][0]" registry] + ["[1][0]" module] + ["[1][0]" unit]]) + +(def: (descriptor module hash) + (-> /descriptor.Module Nat /descriptor.Descriptor) + [/descriptor.#name module + /descriptor.#file (format module ".lux") + /descriptor.#hash hash + /descriptor.#state {.#Active} + /descriptor.#references (set.empty text.hash)]) + +(def: test|entry + Test + (do random.monad + [module/0 (random.ascii/lower 1) + module/1 (random.ascii/lower 2) + signature $/signature.random + .let [version (value@ /signature.#version signature)] + fake_version (random.only (|>> (n.= version) not) random.nat) + content/0 random.nat + content/1 (random.only (|>> (n.= content/0) not) random.nat) + hash random.nat + .let [key (/key.key signature content/0)]] + ($_ _.and + (_.cover [/.has /.find] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + entry' (/.find module/0 archive)] + (in (same? entry entry'))) + (try.else false))) + (_.cover [/.module_is_only_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + entry' (/.find module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_is_only_reserved)))) + (_.cover [/.cannot_replace_document] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/0 entry/1 archive)] + (in false)) + (exception.otherwise (exception.match? /.cannot_replace_document)))) + (_.cover [/.module_must_be_reserved_before_it_can_be_added] + (|> (do try.monad + [.let [entry [/.#module [/module.#id 0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry /.empty)] + (in false)) + (exception.otherwise (exception.match? /.module_must_be_reserved_before_it_can_be_added)))) + (_.cover [/.archived?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived? archive module/0) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived? archive module/0)]] + (in (and (not pre) post))) + (try.else false))) + (_.cover [/.unknown_document] + (and (|> (do try.monad + [_ (/.id module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))) + (|> (do try.monad + [_ (/.find module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))))) + (_.cover [/.archived] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived archive) + (^open "list#[0]") (list.equivalence text.equivalence)]] + (in (and (list#= (list) pre) + (list#= (list module/0) post)))) + (try.else false))) + (_.cover [/.entries] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.entries archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive)] + (in (and (list.empty? pre) + (case (/.entries archive) + (^ (list [module/0' @module/0' entry'])) + (and (same? module/0 module/0') + (same? @module/0 @module/0') + (same? entry entry')) + + _ + false)))) + (try.else false))) + (_.cover [/.export /.import] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/1 + /module.#descriptor (..descriptor module/1 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/1 entry/1 archive) + .let [pre (/.reserved archive)] + archive (|> archive + (/.export version) + (/.import version)) + .let [post (/.reserved archive)]] + (in (set#= (set.of_list text.hash pre) + (set.of_list text.hash post)))) + (try.else false))) + (_.cover [/.version_mismatch] + (|> (do try.monad + [archive (|> /.empty + (/.export version) + (/.import fake_version))] + (in false)) + (exception.otherwise (exception.match? /.version_mismatch)))) + ))) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Archive]) + (do random.monad + [module/0 (random.ascii/lower 1) + module/1 (random.ascii/lower 2) + signature $/signature.random + content/0 random.nat + content/1 (random.only (|>> (n.= content/0) not) random.nat) + hash random.nat + .let [key (/key.key signature content/0)]]) + ($_ _.and + (_.cover [/.empty] + (list.empty? (/.entries /.empty))) + (_.cover [/.reserve /.id] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + @module/0' (/.id module/0 archive) + @module/1' (/.id module/1 archive)] + (in (and (same? @module/0 @module/0') + (same? @module/1 @module/1')))) + (try.else false))) + (_.cover [/.reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive)] + (in (set#= (set.of_list text.hash (list module/0 module/1)) + (set.of_list text.hash (/.reserved archive))))) + (try.else false))) + (_.cover [/.reservations] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [hash (product.hash text.hash n.hash)]] + (in (set#= (set.of_list hash (list [module/0 @module/0] [module/1 @module/1])) + (set.of_list hash (/.reservations archive))))) + (try.else false))) + (_.cover [/.module_has_already_been_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + _ (/.reserve module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_has_already_been_reserved)))) + (_.cover [/.reserved?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty)] + (in (and (/.reserved? archive module/0) + (not (/.reserved? archive module/1))))) + (try.else false))) + (_.for [/.Entry] + ..test|entry) + + $/signature.test + $/key.test + $/artifact.test + $/registry.test + $/module.test + $/unit.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux index 3d0bc262e..311f1f80d 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -9,7 +9,10 @@ [number ["n" nat]]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" document] + ["[1][0]" descriptor]]) (def: .public test Test @@ -18,4 +21,7 @@ ($_ _.and (_.cover [/.ID /.runtime] (n.= 0 /.runtime)) + + /document.test + /descriptor.test ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux index d9d0e09a2..95a290b11 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -11,7 +11,7 @@ [parser ["<[0]>" binary]]] [data - ["[0]" text] + ["[0]" text ("[1]#[0]" equivalence)] [format ["[0]" binary]]] [math @@ -40,13 +40,16 @@ (def: .public test Test (<| (_.covering /._) - (_.for [/.Descriptor /.Module]) + (_.for [/.Descriptor]) (do random.monad [expected (..random 5)]) ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (..random 1))) + (_.for [/.Module] + (_.cover [/.runtime] + (text#= "" /.runtime))) (_.cover [/.writer /.parser] (|> expected (binary.result /.writer) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux index 749dcdd09..a73bf751d 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux @@ -19,10 +19,10 @@ ["[0]" nat]]]]] [\\library ["[0]" / - [// + [/// ["[1][0]" signature ("[1]#[0]" equivalence)] ["[1][0]" key]]]] - ["[0]" // "_" + ["[0]" /// "_" ["[1][0]" signature]]) (def: .public test @@ -30,9 +30,9 @@ (<| (_.covering /._) (_.for [/.Document]) (do random.monad - [signature/0 //signature.random + [signature/0 ///signature.random signature/1 (random.only (|>> (/signature#= signature/0) not) - //signature.random) + ///signature.random) .let [key/0 (/key.key signature/0 0) key/1 (/key.key signature/1 0)] expected random.nat] diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux index 948329ada..85c19714c 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux @@ -26,8 +26,8 @@ (Random /.Signature) ($_ random.and ($_ random.and - (random.ascii/upper 5) - (random.ascii/lower 5)) + (random.ascii/upper 1) + (random.ascii/lower 1)) ////version.random )) |