diff options
Diffstat (limited to '')
21 files changed, 774 insertions, 306 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index a43bc47a5..9d91b6ee8 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -1,26 +1,26 @@ (.using - [library - [lux "*" - ["@" target] - ["[0]" ffi] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["[0]" io {"+" IO io}]] - [data - ["[0]" text] - [collection - ["[0]" list]]] - [math - [number - ["n" nat] - ["f" frac]]] - [time - ["[0]" instant]]]] - [// - ["[0]" atom {"+" Atom}]]) + [library + [lux "*" + ["@" target] + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["[0]" io {"+" IO io}]] + [data + ["[0]" text] + [collection + ["[0]" list]]] + [math + [number + ["n" nat] + ["f" frac]]] + [time + ["[0]" instant]]]] + [// + ["[0]" atom {"+" Atom}]]) (with_expansions [<jvm> (as_is (ffi.import: java/lang/Object) @@ -84,9 +84,12 @@ @.python (as_is)] ... Default - (def: runner - (Atom (List Thread)) - (atom.atom (list))))) + (as_is (def: started? + (Atom Bit) + (atom.atom false)) + (def: runner + (Atom (List Thread)) + (atom.atom (list)))))) (def: (execute! action) (-> (IO Any) Any) @@ -147,27 +150,33 @@ ... Starts the event-loop. (def: .public run! (IO Any) - (loop [_ []] - (do [! io.monad] - [threads (atom.read! ..runner)] - (case threads - ... And... we're done! - {.#End} - (in []) - - _ - (do ! - [now (# ! each (|>> instant.millis .nat) instant.now) - .let [[ready pending] (list.partition (function (_ thread) - (|> (value@ #creation thread) - (n.+ (value@ #delay thread)) - (n.<= now))) - threads)] - swapped? (atom.compare_and_swap! threads pending ..runner)] - (if swapped? - (do ! - [_ (monad.each ! (|>> (value@ #action) ..execute! io.io) ready)] - (again [])) - (panic! (exception.error ..cannot_continue_running_threads [])))) - )))) + (do [! io.monad] + [started? (atom.read! ..started?)] + (if started? + (in []) + (do ! + [_ (atom.write! true ..started?)] + (loop [_ []] + (do ! + [threads (atom.read! ..runner)] + (case threads + ... And... we're done! + {.#End} + (in []) + + _ + (do ! + [now (# ! each (|>> instant.millis .nat) instant.now) + .let [[ready pending] (list.partition (function (_ thread) + (|> (value@ #creation thread) + (n.+ (value@ #delay thread)) + (n.<= now))) + threads)] + swapped? (atom.compare_and_swap! threads pending ..runner)] + (if swapped? + (do ! + [_ (monad.each ! (|>> (value@ #action) ..execute! io.io) ready)] + (again [])) + (panic! (exception.error ..cannot_continue_running_threads [])))) + ))))))) )) diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux index 31b302954..ee6daa975 100644 --- a/stdlib/source/library/lux/target/jvm/field.lux +++ b/stdlib/source/library/lux/target/jvm/field.lux @@ -1,24 +1,24 @@ (.using - [library - [lux {"-" Type static public private} - [abstract - [equivalence {"+" Equivalence}] - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - [format - ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] - [collection - ["[0]" sequence {"+" Sequence}]]]]] - ["[0]" // "_" - ["[0]" modifier {"+" Modifier modifiers:}] - ["[1][0]" constant {"+" UTF8} - ["[1]/[0]" pool {"+" Pool Resource}]] - ["[1][0]" index {"+" Index}] - ["[1][0]" attribute {"+" Attribute}] - ["[1][0]" type {"+" Type} - [category {"+" Value}] - [descriptor {"+" Descriptor}]]]) + [library + [lux {"-" Type static public private} + [abstract + [equivalence {"+" Equivalence}] + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [format + ["[0]F" binary {"+" Writer} ("[1]#[0]" monoid)]] + [collection + ["[0]" sequence {"+" Sequence}]]]]] + ["[0]" // "_" + ["[0]" modifier {"+" Modifier modifiers:}] + ["[1][0]" constant {"+" UTF8} + ["[1]/[0]" pool {"+" Pool Resource}]] + ["[1][0]" index {"+" Index}] + ["[1][0]" attribute {"+" Attribute}] + ["[1][0]" type {"+" Type} + [category {"+" Value}] + [descriptor {"+" Descriptor}]]]) (type: .public Field (Rec Field @@ -60,13 +60,21 @@ [(binaryF.sequence/16 //attribute.writer) #attributes])) ))) -(def: .public (field modifier name type attributes) - (-> (Modifier Field) UTF8 (Type Value) (Sequence Attribute) +(def: .public (field modifier name type with_signature? attributes) + (-> (Modifier Field) UTF8 (Type Value) Bit (Sequence Attribute) (Resource Field)) - (do //constant/pool.monad + (do [! //constant/pool.monad] [@name (//constant/pool.utf8 name) - @descriptor (//constant/pool.descriptor (//type.descriptor type))] + @descriptor (//constant/pool.descriptor (//type.descriptor type)) + @signature (if with_signature? + (# ! each (|>> {.#Some}) (//attribute.signature (//type.signature type))) + (in {.#None}))] (in [#modifier modifier #name @name #descriptor @descriptor - #attributes attributes]))) + #attributes (case @signature + {.#Some @signature} + (sequence.suffix @signature attributes) + + {.#None} + attributes)]))) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index edc4d44f8..05b1bf768 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -130,6 +130,7 @@ ["?" exit_status] ["stdout" stdout] + ["stdin" stdin] ) (template [<ruby_name> <lux_name>] @@ -463,6 +464,11 @@ (|> (..manual "Class") (..new (list) {.#Some definition}))) +(def: .public (module definition) + (-> Block Computation) + (|> (..manual "Module") + (..new (list) {.#Some definition}))) + (def: .public (apply_lambda/* args lambda) (-> (List Expression) Expression Computation) (|> lambda @@ -490,9 +496,13 @@ <definitions>))] + [0 + [["gets"]]] + [1 [["print"] ["include"] + ["extend"] ["require"] ["defined?"]]] diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index c44dd5e7e..ebdddd347 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -33,12 +33,12 @@ ["[1][0]" generation] ["[1][0]" analysis [macro {"+" Expander}] - ["[1]/[0]" evaluation]] + ["[1]/[0]" evaluation] + ["[0]A" module]] [phase + ["[0]P" analysis] ["[0]P" synthesis] ["[0]P" directive] - ["[0]P" analysis - ["[0]A" module]] ["[0]" extension {"+" Extender} ["[0]E" analysis] ["[0]E" synthesis] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 96c638d52..d20a1b7d7 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -41,14 +41,13 @@ ["[1][0]" version] ["[0]" syntax] ["[1][0]" analysis - [macro {"+" Expander}]] + [macro {"+" Expander}] + ["[0]A" module]] ["[1][0]" synthesis] ["[1][0]" generation {"+" Buffer}] ["[1][0]" directive] [phase - ["[0]" extension {"+" Extender}] - [analysis - ["[0]A" module]]]]] + ["[0]" extension {"+" Extender}]]]] [meta ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index ae38fc2de..566a7afa9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -1,22 +1,21 @@ (.using - [library - [lux "*" - [control - ["<>" parser - ["<b>" binary {"+" Parser}]]] - [data - [format - ["_" binary {"+" Writer}]]]]] - ["[0]" / "_" - ["[1][0]" version] - [phase - [analysis - ["[0]" module]]] - [/// - [meta - [archive - ["[0]" signature] - ["[0]" key {"+" Key}]]]]]) + [library + [lux "*" + [control + ["<>" parser + ["<b>" binary {"+" Parser}]]] + [data + [format + ["_" binary {"+" Writer}]]]]] + ["[0]" / "_" + ["[1][0]" version] + [analysis + ["[0]" module]] + [/// + [meta + [archive + ["[0]" signature] + ["[0]" key {"+" Key}]]]]]) ... TODO: Remove #module_hash, #imports & #module_state ASAP. ... TODO: Not just from this parser, but from the lux.Module type. diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux index 3ca157f38..e0798d438 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" Label} [abstract ["[0]" monad {"+" do}]] [control @@ -15,28 +15,29 @@ [dictionary ["[0]" plist]]]] ["[0]" meta]]] - ["[0]" /// "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Operation}] + ["/" // {"+" Operation} + ["//[1]" // "_" + [phase + ["[1][0]" extension]] [/// ["[1]" phase]]]]) -(type: .public Tag Text) +(type: .public Label + Text) (exception: .public (unknown_module [module Text]) (exception.report ["Module" module])) (template [<name>] - [(exception: .public (<name> [tags (List Text) + [(exception: .public (<name> [labels (List Label) owner Type]) (exception.report - ["Tags" (text.interposed " " tags)] + ["Labels" (text.interposed " " labels)] ["Type" (%.type owner)]))] - [cannot_declare_tags_for_unnamed_type] - [cannot_declare_tags_for_foreign_type] + [cannot_declare_labels_for_anonymous_type] + [cannot_declare_labels_for_foreign_type] ) (exception: .public (cannot_define_more_than_once [name Symbol @@ -70,11 +71,11 @@ (def: .public (empty hash) (-> Nat Module) - [.#module_hash hash - .#module_aliases (list) - .#definitions (list) - .#imports (list) - .#module_state {.#Active}]) + [.#module_hash hash + .#module_aliases (list) + .#definitions (list) + .#imports (list) + .#module_state {.#Active}]) (def: .public (import module) (-> Text (Operation Any)) @@ -147,7 +148,7 @@ (def: .public (with_module hash name action) (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) (do ///.monad - [_ (create hash name) + [_ (..create hash name) output (/.with_current_module name action) module (///extension.lifted (meta.module name))] @@ -168,11 +169,11 @@ (plist.has module_name (with@ .#module_state {<tag>} module)) state) []]} - ((///extension.up (/.except can_only_change_state_of_active_module [module_name {<tag>}])) + ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {<tag>}])) state))) {.#None} - ((///extension.up (/.except unknown_module module_name)) + ((///extension.up (/.except ..unknown_module module_name)) state))))) (def: .public (<asker> module_name) @@ -187,7 +188,7 @@ _ #0)]} {.#None} - ((///extension.up (/.except unknown_module module_name)) + ((///extension.up (/.except ..unknown_module module_name)) state)))))] [set_active active? .#Active] @@ -195,20 +196,8 @@ [set_cached cached? .#Cached] ) -(def: (hash module_name) - (-> Text (Operation Nat)) - (///extension.lifted - (function (_ state) - (case (|> state (value@ .#modules) (plist.value module_name)) - {.#Some module} - {try.#Success [state (value@ .#module_hash module)]} - - {.#None} - ((///extension.up (/.except unknown_module module_name)) - state))))) - -(def: .public (declare_tags record? tags exported? type) - (-> Bit (List Tag) Bit Type (Operation Any)) +(def: .public (declare_labels record? labels exported? type) + (-> Bit (List Label) Bit Type (Operation Any)) (do [! ///.monad] [self_name (///extension.lifted meta.current_module_name) [type_module type_name] (case type @@ -216,12 +205,12 @@ (in type_name) _ - (/.except ..cannot_declare_tags_for_unnamed_type [tags type])) - _ (///.assertion cannot_declare_tags_for_foreign_type [tags type] + (/.except ..cannot_declare_labels_for_anonymous_type [labels type])) + _ (///.assertion ..cannot_declare_labels_for_foreign_type [labels type] (text#= self_name type_module))] (monad.each ! (function (_ [index short]) (..define short (if record? - {.#Slot [exported? type tags index]} - {.#Tag [exported? type tags index]}))) - (list.enumeration tags)))) + {.#Slot [exported? type labels index]} + {.#Tag [exported? type labels index]}))) + (list.enumeration labels)))) 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 be1e560ca..2bc7d831e 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 @@ -1679,12 +1679,62 @@ {#Protected} ..protected_tag {#Default} ..default_tag))) +(type: Exception + (Type Class)) + +(type: .public (Abstract_Method a) + [Text + Visibility + (List (Annotation a)) + (List (Type Var)) + (List Argument) + (Type Return) + (List Exception)]) + +(def: abstract_tag "abstract") + +(def: .public abstract_method_definition + (Parser (Abstract_Method Code)) + (<| <code>.form + (<>.after (<code>.text! ..abstract_tag)) + ($_ <>.and + <code>.text + ..visibility + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + (<code>.tuple (<>.some ..argument)) + ..return + (<code>.tuple (<>.some ..class))))) + +(def: .public (analyse_abstract_method analyse archive method) + (-> Phase Archive (Abstract_Method Code) (Operation Analysis)) + (let [[method_name visibility annotations vars arguments return exceptions] method] + (do [! phase.monad] + [annotationsA (monad.each ! (function (_ [name parameters]) + (do ! + [parametersA (monad.each ! (function (_ [name value]) + (do ! + [valueA (analyse archive value)] + (in [name valueA]))) + parameters)] + (in [name parametersA]))) + annotations)] + (in (/////analysis.tuple (list (/////analysis.text ..abstract_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.tuple (list#each annotation_analysis annotationsA)) + (/////analysis.tuple (list#each var_analysis vars)) + (/////analysis.tuple (list#each ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list#each class_analysis exceptions)) + )))))) + (type: .public (Constructor a) [Visibility Strictness (List (Annotation a)) (List (Type Var)) - (List (Type Class)) ... Exceptions + (List Exception) Text (List Argument) (List (Typed a)) @@ -1766,7 +1816,7 @@ Text (List Argument) (Type Return) - (List (Type Class)) ... Exceptions + (List Exception) a]) (def: virtual_tag "virtual") @@ -1861,9 +1911,9 @@ Strictness (List (Annotation a)) (List (Type Var)) - (List (Type Class)) ... Exceptions (List Argument) (Type Return) + (List Exception) a]) (def: .public static_tag "static") @@ -1878,16 +1928,16 @@ <code>.bit (<code>.tuple (<>.some ..annotation)) (<code>.tuple (<>.some ..var)) - (<code>.tuple (<>.some ..class)) (<code>.tuple (<>.some ..argument)) ..return + (<code>.tuple (<>.some ..class)) <code>.any))) (def: .public (analyse_static_method analyse archive mapping method) (-> Phase Archive Mapping (Static_Method Code) (Operation Analysis)) (let [[method_name visibility - strict_fp? annotations vars exceptions - arguments return + strict_fp? annotations vars + arguments return exceptions body] method] (do [! phase.monad] [annotationsA (monad.each ! (function (_ [name parameters]) 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 bdf4d3e11..872b224b4 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 @@ -43,6 +43,7 @@ [category {"+" Void Value Return Primitive Object Class Array Var Parameter}] ["[0]T" lux {"+" Mapping}] ["[0]" signature] + ["[0]" reflection] ["[0]" descriptor {"+" Descriptor}] ["[0]" parser]]]] [tool @@ -53,13 +54,12 @@ ["[0]" artifact]]] [language [lux - ["[0]" analysis] ["[0]" synthesis] ["[0]" generation] ["[0]" directive {"+" Handler Bundle}] + ["[0]" analysis + ["[0]A" type]] [phase - [analysis - ["[0]A" type]] [generation [jvm ["[0]" runtime {"+" Anchor Definition Extender}]]] @@ -76,6 +76,7 @@ (directive.Operation Anchor (Bytecode Any) Definition)) (def: signature (|>> type.signature signature.signature)) +(def: reflection (|>> type.reflection reflection.reflection)) (type: Declaration [Text (List (Type Var))]) @@ -178,7 +179,8 @@ {#Constructor (jvm.Constructor Code)} {#Virtual_Method (jvm.Virtual_Method Code)} {#Static_Method (jvm.Static_Method Code)} - {#Overriden_Method (jvm.Overriden_Method Code)})) + {#Overriden_Method (jvm.Overriden_Method Code)} + {#Abstract_Method (jvm.Abstract_Method Code)})) (def: method (Parser Method_Definition) @@ -187,6 +189,7 @@ jvm.virtual_method_definition jvm.static_method_definition jvm.overriden_method_definition + jvm.abstract_method_definition )) (def: $Object @@ -211,7 +214,7 @@ (do pool.monad [constant (`` (|> value (~~ (template.spliced <constant>)))) attribute (attribute.constant constant)] - (field.field ..constant::modifier name <type> (sequence.sequence attribute)))]) + (field.field ..constant::modifier name <type> true (sequence.sequence attribute)))]) ([.#Bit type.boolean [(case> #0 +0 #1 +1) .i64 i32.i32 constant.integer pool.integer]] [.#Int type.byte [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] @@ -230,7 +233,7 @@ ... TODO: Handle annotations. {#Variable [name visibility state annotations type]} (field.field (modifier#composite visibility state) - name type sequence.empty))) + name type true sequence.empty))) (def: (method_definition archive supers [mapping selfT] [analyse synthesize generate]) (-> Archive @@ -255,16 +258,21 @@ (jvm.analyse_static_method analyse archive mapping method) {#Overriden_Method method} - (jvm.analyse_overriden_method analyse archive selfT mapping supers method))))] + (jvm.analyse_overriden_method analyse archive selfT mapping supers method) + + {#Abstract_Method method} + (jvm.analyse_abstract_method analyse archive method))))] (directive.lifted_synthesis (synthesize archive methodA))))) +(def: class_name + (|>> parser.read_class product.left name.internal)) + (def: (mock_class [name parameters] super interfaces fields methods modifier) (-> Declaration (Type Class) (List (Type Class)) (List (Resource field.Field)) (List (Resource method.Method)) (Modifier class.Class) (Try [External Binary])) - (let [class_name (|>> parser.read_class product.left name.internal) - signature (signature.inheritance (list#each type.signature parameters) + (let [signature (signature.inheritance (list#each type.signature parameters) (type.signature super) (list#each type.signature interfaces))] (try#each (|>> (format.result class.writer) @@ -275,22 +283,12 @@ modifier) (name.internal name) {.#Some signature} - (class_name super) - (list#each class_name interfaces) + (..class_name super) + (list#each ..class_name interfaces) fields methods sequence.empty)))) -(def: (mock_field it) - (-> ..Field (Resource field.Field)) - (case it - ... TODO: Handle constants - {#Constant [name annotations type term]} - (undefined) - - {#Variable [name visibility state annotations type]} - (field.field ($_ modifier#composite visibility state) name type sequence.empty))) - (def: (mock_value valueT) (-> (Type Value) (Bytecode Any)) (case (type.primitive? valueT) @@ -393,7 +391,7 @@ {.#Some (..mock_return return)}) {#Static_Method [name privacy strict_floating_point? annotations - variables exceptions arguments return + variables arguments return exceptions body]} (method.method ($_ modifier#composite method.static @@ -406,15 +404,15 @@ (list) {.#Some (..mock_return return)}) - ... {#Abstract [name privacy annotations - ... variables arguments return exceptions]} - ... (method.method ($_ modifier#composite - ... method.abstract - ... (..method_privacy privacy)) - ... name - ... (type.method [variables (list#each product.right arguments) return exceptions]) - ... (list) - ... {.#None}) + {#Abstract_Method [name privacy annotations + variables arguments return exceptions]} + (method.method ($_ modifier#composite + method.abstract + (..method_privacy privacy)) + name + (type.method [variables (list#each product.right arguments) return exceptions]) + (list) + {.#None}) )) (def: (mock declaration super interfaces inheritance fields methods) @@ -423,7 +421,7 @@ (Modifier class.Class) (List ..Field) (List ..Method_Definition) (Try [External Binary])) (mock_class declaration super interfaces - (list#each ..mock_field fields) + (list#each ..field_definition fields) (list#each (..mock_method super) methods) inheritance)) @@ -437,6 +435,17 @@ [class_declaration [External (List (Type Var))] parser.declaration'] ) +(def: (save_class! name bytecode) + (-> Text Binary (Operation Any)) + (directive.lifted_generation + (do [! phase.monad] + [.let [artifact [name bytecode]] + artifact_id (generation.learn_custom name artifact.no_dependencies) + _ (generation.execute! artifact) + _ (generation.save! artifact_id {.#Some name} artifact) + _ (generation.log! (format "JVM Class " name))] + (in [])))) + (def: jvm::class (Handler Anchor (Bytecode Any) Definition) (/.custom @@ -458,7 +467,10 @@ fields methods]) (do [! phase.monad] - [.let [[name parameters] class_declaration] + [.let [[name parameters] class_declaration + type_declaration (signature.inheritance (list#each type.signature parameters) + (type.signature super) + (list#each type.signature interfaces))] mock (<| phase.lifted (..mock class_declaration super @@ -470,50 +482,47 @@ _ (directive.lifted_generation (generation.execute! mock)) parameters (directive.lifted_analysis - (typeA.with_env - (jvm.parameter_types parameters))) + (typeA.check (jvm.parameter_types parameters))) .let [mapping (list#mix (function (_ [parameterJ parameterT] mapping) (dictionary.has (parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] superT (directive.lifted_analysis - (typeA.with_env - (luxT.check (luxT.class mapping) (..signature super)))) + (typeA.check (luxT.check (luxT.class mapping) (..signature super)))) interfaceT+ (directive.lifted_analysis - (typeA.with_env - (monad.each check.monad - (|>> ..signature (luxT.check (luxT.class mapping))) - interfaces))) - .let [selfT (jvm.inheritance_relationship_type {.#Primitive name (list#each product.right parameters)} - superT - interfaceT+)] + (typeA.check (monad.each check.monad + (|>> ..signature (luxT.check (luxT.class mapping))) + interfaces))) state (extension.lifted phase.state) - .let [analyse (value@ [directive.#analysis directive.#phase] state) - synthesize (value@ [directive.#synthesis directive.#phase] state) - generate (value@ [directive.#generation directive.#phase] state)] - methods (monad.each ! (..method_definition archive (list& super interfaces) [mapping selfT] [analyse synthesize generate]) + .let [selfT {.#Primitive name (list#each product.right parameters)}] + methods (monad.each ! (..method_definition archive (list& super interfaces) [mapping selfT] + [(value@ [directive.#analysis directive.#phase] state) + (value@ [directive.#synthesis directive.#phase] state) + (value@ [directive.#generation directive.#phase] state)]) methods) - ... _ (directive.lifted_generation - ... (generation.save! true ["" name] - ... [name - ... (class.class version.v6_0 - ... (modifier#composite class.public inheritance) - ... (name.internal name) (list#each (|>> product.left parser.name ..constraint) parameters) - ... super interfaces - ... (list#each ..field_definition fields) - ... (list) ... TODO: Add methods - ... sequence.empty)])) - _ (directive.lifted_generation - (generation.log! (format "JVM Class " name)))] + bytecode (<| (# ! each (format.result class.writer)) + phase.lifted + (class.class version.v6_0 + ($_ modifier#composite + class.public + inheritance) + (name.internal name) + {.#Some type_declaration} + (..class_name super) + (list#each ..class_name interfaces) + (list#each ..field_definition fields) + (list) ... (list#each ..method_definition methods) + sequence.empty)) + _ (..save_class! name bytecode)] (in directive.no_requirements)))])) -(def: (method_declaration (^open "it[0]")) +(def: (method_declaration (^open "/[0]")) (-> (jvm.Method_Declaration Code) (Resource Method)) - (let [type (type.method [it#type_variables it#arguments it#return it#exceptions])] + (let [type (type.method [/#type_variables /#arguments /#return /#exceptions])] (method.method ($_ modifier#composite method.public method.abstract) - it#name + /#name type (list) {.#None}))) @@ -542,17 +551,12 @@ (type.signature $Object) (list#each type.signature supers))} (name.internal "java.lang.Object") - (list#each (|>> parser.read_class product.left name.internal) - supers) + (list#each ..class_name supers) (list) (list#each ..method_declaration method_declarations) sequence.empty)) - ... module generation.module - ... module_id (generation.module_id module archive) artifact_id (generation.learn_custom name artifact.no_dependencies) - .let [artifact [name - ... (runtime.class_name [module_id artifact_id]) - bytecode]] + .let [artifact [name bytecode]] _ (generation.execute! artifact) _ (generation.save! artifact_id {.#Some name} artifact) _ (generation.log! (format "JVM Interface " (%.text name)))] 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 74f526332..73c67165f 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 @@ -32,13 +32,12 @@ ["[1][0]" bundle] ["[1][0]" analysis] ["/[1]" // "_" - [analysis - ["[0]A" module]] ["/[1]" // "_" ["[1][0]" analysis [macro {"+" Expander}] ["[1]/[0]" evaluation] - ["[0]A" type]] + ["[0]A" type] + ["[0]A" module]] ["[1][0]" synthesis {"+" Synthesis}] ["[1][0]" generation {"+" Context}] ["[1][0]" directive {"+" Import Requirements Phase Operation Handler Bundle}] @@ -250,14 +249,14 @@ _ (phase.except ///.invalid_syntax [extension_name %.code inputsC+])))) -(def: (announce_labels! tags owner) +(def: (announce_labels! labels owner) (All (_ anchor expression directive) (-> (List Text) Type (Operation anchor expression directive (List Any)))) (/////directive.lifted_generation (monad.each phase.monad (function (_ tag) (/////generation.log! (format tag " : Tag of " (%.type owner)))) - tags))) + labels))) (def: (def::type_tagged expander host_analysis) (-> Expander /////analysis.Bundle Handler) @@ -290,7 +289,7 @@ (moduleA.define short_name {.#Type [exported? (:as .Type value) (if record? {.#Right labels} {.#Left labels})]})) - _ (moduleA.declare_tags record? labels exported? (:as .Type value))] + _ (moduleA.declare_labels record? labels exported? (:as .Type value))] (in labels))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux index bd7f69e16..10bf59a29 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux @@ -23,4 +23,4 @@ (def: .public (constant name type) (-> Text (Type Value) (Resource Field)) - (field.field ..modifier name type (sequence.sequence))) + (field.field ..modifier name type false (sequence.sequence))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux index b02bde225..cc22b43b9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux @@ -46,7 +46,7 @@ (def: .public (variable name type) (-> Text (Type Value) (Resource Field)) - (field.field ..modifier name type (sequence.sequence))) + (field.field ..modifier name type false (sequence.sequence))) (def: .public (variables naming amount) (-> (-> Register Text) Nat (List (Resource Field))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index 00b7557af..0b14f240e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -124,7 +124,7 @@ (encoding/name.internal bytecode_name) {.#None} (encoding/name.internal "java.lang.Object") (list) - (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence))) + (list (field.field ..value::modifier ..value::field ..value::type false (sequence.sequence))) (list (method.method ..init::modifier "<clinit>" ..init::type (list) {.#Some diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 57a446860..a812a0c31 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -560,7 +560,7 @@ right_projection::method ..try::method)) - (sequence.sequence)))] + sequence.empty))] (do ////.monad [_ (generation.execute! [class bytecode]) _ (generation.save! ..artifact_id {.#None} [class bytecode])] @@ -608,8 +608,8 @@ partial_count (: (Resource Field) (field.field (modifier#composite field.public field.final) //function/count.field - //function/count.type - (sequence.sequence))) + //function/count.type .false + sequence.empty)) bytecode (<| (format.result class.writer) try.trusted (class.class jvm/version.v6_0 @@ -619,7 +619,7 @@ (name.internal (..reflection ^Object)) (list) (list partial_count) (list& <init>::method apply::method+) - (sequence.sequence)))] + sequence.empty))] (do ////.monad [_ (generation.execute! [class bytecode]) ... _ (generation.save! //function.artifact_id {.#None} [class bytecode]) 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 294e31ecc..3d7854861 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [type {"+" :sharing}] [abstract ["[0]" monad {"+" do}]] @@ -32,8 +32,9 @@ [// ["[0]" archive {"+" Output} [registry {"+" Registry}] - ["[0]" descriptor {"+" Module Descriptor}] ["[0]" artifact] + ["[0]" module] + ["[0]" descriptor] ["[0]" document {"+" Document}]] ["[0]" cache "_" ["[1]/[0]" module {"+" Order}] @@ -46,7 +47,7 @@ [generation {"+" Context}]]]]]]) (def: (bundle_module module module_id necessary_dependencies output) - (-> Module archive.ID (Set Context) Output (Try (Maybe _.Statement))) + (-> descriptor.Module module.ID (Set Context) Output (Try (Maybe _.Statement))) (do [! try.monad] [] (case (|> output @@ -76,14 +77,14 @@ (in {.#Some bundle}))))) (def: module_file - (-> archive.ID file.Path) + (-> module.ID file.Path) (|>> %.nat (text.suffix ".rb"))) (def: (write_module mapping necessary_dependencies [module [module_id entry]] sink) - (-> (Dictionary Module archive.ID) (Set Context) - [Module [archive.ID [Descriptor (Document .Module) Output Registry]]] - (List [archive.ID [Text Binary]]) - (Try (List [archive.ID [Text Binary]]))) + (-> (Dictionary descriptor.Module module.ID) (Set Context) + [descriptor.Module [module.ID (archive.Entry .Module)]] + (List [module.ID [Text Binary]]) + (Try (List [module.ID [Text Binary]]))) (do [! try.monad] [bundle (: (Try (Maybe _.Statement)) (..bundle_module module module_id necessary_dependencies (value@ archive.#output entry)))] @@ -104,13 +105,13 @@ "main.rb") (def: module_id_mapping - (-> (Order .Module) (Dictionary Module archive.ID)) + (-> (Order .Module) (Dictionary descriptor.Module module.ID)) (|>> (list#each (function (_ [module [module_id entry]]) [module module_id])) (dictionary.of_list text.hash))) (def: included_modules - (All (_ a) (-> (List [archive.ID a]) (Set archive.ID))) + (All (_ a) (-> (List [module.ID a]) (Set module.ID))) (|>> (list#each product.left) (list#mix set.has (set.empty nat.hash)))) 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 0f6007e75..e014c3403 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -23,8 +23,9 @@ ["[0]" // {"+" Packager} [// ["[0]" archive {"+" Output} - ["[0]" descriptor] - ["[0]" artifact]] + ["[0]" artifact] + ["[0]" module] + ["[0]" descriptor]] ["[0]" cache "_" ["[1]/[0]" module] ["[1]/[0]" artifact]] @@ -37,7 +38,7 @@ (def: (write_module necessary_dependencies sequence [module_id output] so_far) (All (_ directive) - (-> (Set Context) (-> directive directive directive) [archive.ID Output] directive + (-> (Set Context) (-> directive directive directive) [module.ID Output] directive (Try directive))) (|> output sequence.list diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 0899dcb64..e78630278 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -1,25 +1,25 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io] - ["[0]" try] - ["<>" parser - ["<[0]>" code] - ["<[0]>" cli]]] - [data - ["[0]" text] - [collection - ["[0]" list]]] - [macro - [syntax {"+" syntax:}]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io] + ["[0]" try] + ["<>" parser + ["<[0]>" code] + ["<[0]>" cli]]] + [data + ["[0]" text] + [collection + ["[0]" list]]] + [macro + [syntax {"+" syntax:}]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]]) (syntax: (actual_program [actual_program (<| <code>.form (<>.after (<code>.text! "lux def program")) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 616f3f1f5..b6762f168 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -857,8 +857,8 @@ {.#None} (/name.internal "java.lang.Object") (list) - (list (/field.field /field.static class_field /type.long (sequence.sequence)) - (/field.field /field.public object_field /type.long (sequence.sequence))) + (list (/field.field /field.static class_field /type.long false (sequence.sequence)) + (/field.field /field.public object_field /type.long false (sequence.sequence))) (list (/method.method /method.private constructor constructor::type diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 5a52dc1b8..281ffe594 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -234,6 +234,8 @@ items (random.list size random.safe_frac) $class (# ! each (|>> %.nat (format "class_") /.local) random.nat) + $sub_class (# ! each (|>> %.nat (format "sub_class_") /.local) + random.nat) $method/0 (# ! each (|>> %.nat (format "method_") /.local) random.nat) $method/1 (|> random.nat @@ -296,6 +298,32 @@ (/.do (/.code $method/1) (list (/.float single)) {.#None})))) [(list)] (/.lambda {.#None}) (/.apply_lambda/* (list))))) + (_.for [/.module] + ($_ _.and + (_.cover [/.include/1] + (expression (|>> (:as Frac) (f.= (f.+ single single))) + (|> ($_ /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.include/1 $class))])) + (/.return (|> $sub_class + (/.new (list) {.#None}) + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.extend/1] + (expression (|>> (:as Frac) (f.= (f.+ single single))) + (|> ($_ /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.extend/1 $class))])) + (/.return (|> $sub_class + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) ))) (def: test|io @@ -305,34 +333,67 @@ right (random.ascii/upper 5) $old (# ! each /.local (random.ascii/upper 1)) $new (# ! each /.local (random.ascii/upper 2)) + $it (# ! each /.local (random.ascii/upper 3)) .let [expected (format left right)]]) - (_.for [/.stdout]) ($_ _.and - (_.cover [/.print/1] - (expression (|>> (:as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/1 (/.string left))) - (/.statement (/.print/1 (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.print/2] - (expression (|>> (:as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/2 (/.string left) (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) + (_.for [/.stdout] + ($_ _.and + (_.cover [/.print/1] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/1 (/.string left))) + (/.statement (/.print/1 (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.print/2] + (expression (|>> (:as Text) (text#= expected)) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/2 (/.string left) (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) + (_.for [/.stdin] + ($_ _.and + (_.cover [/.gets/0] + (expression (|>> (:as Text) (text#= (format left text.\n))) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return $it)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_string_read] + (expression (|>> (:as Text) (text#= (format right text.\n))) + (|> ($_ /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return /.last_string_read)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_line_number_read] + (expression (|>> (:as Nat) (n.= 2)) + /.last_line_number_read)) + )) ))) (def: test|computation @@ -367,18 +428,6 @@ (/.float then)))) ))) -(def: test|expression - Test - (do [! random.monad] - [dummy random.safe_frac - expected random.safe_frac] - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - )))) - (def: test|global Test (do [! random.monad] @@ -397,11 +446,6 @@ (|>> (:as Text) (text.ends_with? file))) /.script_name)) - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (:as Text) - (text.ends_with? file))) - /.script_name)) (_.cover [/.input_record_separator] (expression (|>> (:as Text) (text#= text.\n)) @@ -635,6 +679,20 @@ )) ))) +(def: test|expression + Test + (do [! random.monad] + [dummy random.safe_frac + expected random.safe_frac] + (`` ($_ _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.for [/.Location] + ..test|location) + )))) + (def: test|label Test (do [! random.monad] @@ -948,8 +1006,6 @@ ..test|loop (_.for [/.Block] ..test|function) - (_.for [/.Location] - ..test|location) ))) (def: random_expression diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index f19111e2d..8f6a7b381 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -29,6 +29,7 @@ ["[1][0]" pattern] ["[1][0]" macro] ["[1][0]" type] + ["[1][0]" module] [//// ["[1][0]" reference ["[2][0]" variable]] @@ -440,4 +441,5 @@ /pattern.test /macro.test /type.test + /module.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux new file mode 100644 index 000000000..ab07c98b3 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux @@ -0,0 +1,341 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + ["/[1]" // + [// + [phase + ["[2][0]" extension]] + [/// + ["[2][0]" phase]]]]]]) + +(def: random_state + (Random Lux) + (do random.monad + [version random.nat + host (random.ascii/lower 1)] + (in (//.state (//.info version host))))) + +(def: primitive + (Random Type) + (do random.monad + [name (random.ascii/lower 1)] + (in {.#Primitive name (list)}))) + +(def: (new? hash it) + (-> Nat .Module Bit) + (and (same? hash (value@ .#module_hash it)) + (list.empty? (value@ .#module_aliases it)) + (list.empty? (value@ .#definitions it)) + (list.empty? (value@ .#imports it)) + (case (value@ .#module_state it) + {.#Active} + true + + _ + false))) + +(def: test|module + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + name (random.ascii/lower 1) + hash random.nat + expected_import (random.ascii/lower 2) + expected_alias (random.ascii/lower 3)] + ($_ _.and + (_.cover [/.empty] + (..new? hash (/.empty hash))) + (_.cover [/.create] + (|> (do /phase.monad + [_ (/.create hash name)] + (/extension.lifted (meta.module name))) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.exists?] + (|> (do /phase.monad + [pre (/.exists? name) + _ (/.create hash name) + post (/.exists? name)] + (in (and (not pre) post))) + (/phase.result state) + (try.else false))) + (_.cover [/.with_module] + (|> (do /phase.monad + [[it _] (/.with_module hash name + (in []))] + (in it)) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.import] + (`` (and (~~ (template [<expected>] + [(|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it ?] (/.with_module hash name + (do ! + [_ (if <expected> + (/.import expected_import) + (in []))] + (/extension.lifted + (meta.imported? expected_import))))] + (in ?)) + (/phase.result state) + (try#each (bit#= <expected>)) + (try.else false))] + + [false] + [true]))))) + (_.cover [/.alias] + (|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it _] (/.with_module hash name + (do ! + [_ (/.import expected_import)] + (/.alias expected_alias expected_import)))] + (in it)) + (/phase.result state) + (try#each (|>> (value@ .#module_aliases) + (case> (^ (list [actual_alias actual_import])) + (and (same? expected_alias actual_alias) + (same? expected_import actual_import)) + + _ + false))) + (try.else false))) + ))) + +(def: test|state + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + name (random.ascii/lower 1) + hash random.nat] + (`` ($_ _.and + (~~ (template [<set> <query> <not/0> <not/1>] + [(_.cover [<set> <query>] + (|> (do [! /phase.monad] + [[it ?] (/.with_module hash name + (do ! + [_ (<set> name) + ? (<query> name) + ~0 (<not/0> name) + ~1 (<not/1> name)] + (in (and ? (not ~0) (not ~1)))))] + (in ?)) + (/phase.result state) + (try.else false)))] + + [/.set_active /.active? /.compiled? /.cached?] + [/.set_compiled /.compiled? /.cached? /.active?] + [/.set_cached /.cached? /.active? /.compiled?] + )) + (_.cover [/.can_only_change_state_of_active_module] + (and (~~ (template [<pre> <post>] + [(|> (/.with_module hash name + (do /phase.monad + [_ (<pre> name)] + (<post> name))) + (/phase.result state) + (case> {try.#Success _} + false + + {try.#Failure error} + (text.contains? (value@ exception.#label /.can_only_change_state_of_active_module) error)))] + + [/.set_compiled /.set_active] + [/.set_compiled /.set_compiled] + [/.set_compiled /.set_cached] + [/.set_cached /.set_active] + [/.set_cached /.set_compiled] + [/.set_cached /.set_cached] + )))) + (_.cover [/.unknown_module] + (and (~~ (template [<set>] + [(|> (<set> name) + (/phase.result state) + (case> {try.#Success _} + false + + {try.#Failure error} + (text.contains? (value@ exception.#label /.unknown_module) error)))] + + [/.set_active] + [/.set_compiled] + [/.set_cached] + )))) + )))) + +(def: test|definition + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + module_name (random.ascii/lower 1) + hash random.nat + def_name (random.ascii/lower 2) + alias_name (random.ascii/lower 3) + + public? random.bit + def_type ..primitive + arity (# ! each (|>> (n.% 10) ++) random.nat) + labels|head (random.ascii/lower 1) + labels|tail (|> (random.ascii/lower 1) + (random.only (|>> (text#= labels|head) not)) + (random.set text.hash (-- arity)) + (# ! each set.list)) + index (# ! each (n.% arity) random.nat) + .let [definition {.#Definition [public? def_type []]} + alias {.#Alias [module_name def_name]}]] + ($_ _.and + (_.cover [/.define] + (`` (and (~~ (template [<global>] + [(|> (/.with_module hash module_name + (/.define def_name <global>)) + (/phase.result state) + (case> {try.#Success _} true + {try.#Failure _} false))] + + [definition] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (list& labels|head labels|tail) index]}] + [{.#Slot [public? def_type (list& labels|head labels|tail) index]}])) + (|> (/.with_module hash module_name + (do /phase.monad + [_ (/.define def_name definition)] + (/.define alias_name alias))) + (/phase.result state) + (case> {try.#Success _} true + {try.#Failure _} false))))) + (_.cover [/.cannot_define_more_than_once] + (`` (and (~~ (template [<global>] + [(|> (/.with_module hash module_name + (do /phase.monad + [_ (/.define def_name <global>)] + (/.define def_name <global>))) + (/phase.result state) + (case> {try.#Success _} false + {try.#Failure _} true))] + + [{.#Definition [public? def_type []]}] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (list& labels|head labels|tail) index]}] + [{.#Slot [public? def_type (list& labels|head labels|tail) index]}])) + (|> (/.with_module hash module_name + (do /phase.monad + [_ (/.define def_name definition) + _ (/.define alias_name alias)] + (/.define alias_name alias))) + (/phase.result state) + (case> {try.#Success _} false + {try.#Failure _} true))))) + ))) + +(def: test|label + Test + (do [! random.monad] + [lux ..random_state + .let [state [/extension.#bundle /extension.empty + /extension.#state lux]] + module_name (random.ascii/lower 1) + hash random.nat + def_name (random.ascii/lower 2) + foreign_module (random.ascii/lower 3) + + public? random.bit + def_type ..primitive + arity (# ! each (|>> (n.% 10) ++) random.nat) + labels|head (random.ascii/lower 1) + labels|tail (|> (random.ascii/lower 1) + (random.only (|>> (text#= labels|head) not)) + (random.set text.hash (-- arity)) + (# ! each set.list))] + ($_ _.and + (_.cover [/.declare_labels] + (`` (and (~~ (template [<side> <record?> <query> <on_success>] + [(|> (/.with_module hash module_name + (do [! /phase.monad] + [.let [it {.#Named [module_name def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]}) + _ (/.declare_labels <record?> (list& labels|head labels|tail) public? it)] + (monad.each ! (|>> [module_name] <query> /extension.lifted) + (list& labels|head labels|tail)))) + (/phase.result state) + (case> {try.#Success _} <on_success> + {try.#Failure _} (not <on_success>)))] + + [.#Left false meta.tag true] + [.#Left false meta.slot false] + [.#Right true meta.slot true] + [.#Right true meta.tag false]))))) + (_.cover [/.cannot_declare_labels_for_anonymous_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with_module hash module_name + (do [! /phase.monad] + [.let [it def_type] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (list& labels|head labels|tail) public? it))) + (/phase.result state) + (case> {try.#Success _} + false + + {try.#Failure error} + (text.contains? (value@ exception.#label /.cannot_declare_labels_for_anonymous_type) error)))] + + [.#Left false] + [.#Right true]))))) + (_.cover [/.cannot_declare_labels_for_foreign_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with_module hash module_name + (do [! /phase.monad] + [.let [it {.#Named [foreign_module def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (list& labels|head labels|tail) public? it))) + (/phase.result state) + (case> {try.#Success _} + false + + {try.#Failure error} + (text.contains? (value@ exception.#label /.cannot_declare_labels_for_foreign_type) error)))] + + [.#Left false] + [.#Right true]))))) + ))) + +(def: .public test + Test + (<| (_.covering /._) + ($_ _.and + ..test|module + ..test|state + ..test|definition + (_.for [/.Label] + ..test|label) + ))) |