diff options
31 files changed, 858 insertions, 646 deletions
diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 3c384b475..009bec5b4 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -1,72 +1,73 @@ (.using - [library - [lux {"-" Type Primitive static local} - ["[0]" ffi {"+" Inheritance Privacy State import:}] - [abstract - ["[0]" monad {"+" do}]] - [control - [pipe {"+" case>}] - ["[0]" try {"+" Try}] - ["<>" parser - ["<[0]>" code {"+" Parser}] - ["<[0]>" text]]] - [data - [identity {"+" Identity}] - [binary {"+" Binary}] - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - [array {"+" Array}] - ["[0]" list ("[1]#[0]" mix functor monoid)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] - ["[0]" set {"+" Set}]]] - [math - [number - ["[0]" nat]]] - [target - ["/" jvm - [encoding - ["[0]" name {"+" External}]] - ["[1][0]" type {"+" Type Typed Constraint} - [category {"+" Void Value Return Primitive Object Class Var Parameter}] - ["[0]" parser] - ["[0]T" lux] - ["[1]/[0]" signature] - ["[1]/[0]" descriptor]]]] - [tool - [compiler - ["[0]" phase] - [language - [lux - ["[0]" analysis {"+" Analysis}] - ["[0]" synthesis {"+" Synthesis}] - ["[0]" generation] - ["[0]" directive {"+" Requirements}] - [phase + [library + [lux {"-" Type Primitive static local} + ["[0]" ffi {"+" Inheritance Privacy State import:}] + [abstract + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try {"+" Try}] + ["<>" parser + ["<[0]>" code {"+" Parser}] + ["<[0]>" text]]] + [data + [identity {"+" Identity}] + [binary {"+" Binary}] + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + [array {"+" Array}] + ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence {"+" Sequence} ("[1]#[0]" functor mix)] + ["[0]" set {"+" Set}]]] + [math + [number + ["[0]" nat]]] + [target + ["/" jvm + [encoding + ["[0]" name {"+" External}]] + ["[1][0]" type {"+" Type Typed Constraint} + [category {"+" Void Value Return Primitive Object Class Var Parameter}] + ["[0]" parser] + ["[0]T" lux] + ["[1]/[0]" signature] + ["[1]/[0]" descriptor]]]] + [tool + [compiler + ["[0]" phase] + [language + [lux + ["[0]" analysis {"+" Analysis}] + ["[0]" synthesis {"+" Synthesis}] + ["[0]" generation] + ["[0]" directive {"+" Requirements}] + [phase + [analysis + ["[0]A" scope] + ["[0]A" type]] + ["[0]" extension + ["[0]" bundle] [analysis - ["[0]A" scope] - ["[0]A" type]] - ["[0]" extension - ["[0]" bundle] - [analysis - ["//A" jvm]] - [directive - ["[0]/" lux]]]]]] - [meta - [archive {"+" Archive} - ["[0]" artifact] - ["[0]" dependency]]]]]]] - [/// - [host - ["[0]" jvm {"+" Inst} - ["_" inst] - ["[0]" def]]] - [translation - [jvm - [extension - ["//G" host]]]]]) + ["//A" jvm]] + [directive + ["[0]/" lux]]]]]] + [meta + [archive {"+" Archive} + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]" artifact]]]]]]] + [/// + [host + ["[0]" jvm {"+" Inst} + ["_" inst] + ["[0]" def]]] + [translation + [jvm + [extension + ["//G" host]]]]]) (import: org/objectweb/asm/Label ["[1]::[0]" @@ -734,10 +735,10 @@ self arguments constructor_arguments body]} (do [! phase.monad] - [all_super_ctor_dependencies (monad.each ! (|>> product.right (dependency.dependencies archive)) + [all_super_ctor_dependencies (monad.each ! (|>> product.right (cache.dependencies archive)) constructor_arguments) - body_dependencies (dependency.dependencies archive body)] - (in (dependency.all (list& body_dependencies all_super_ctor_dependencies)))) + body_dependencies (cache.dependencies archive body)] + (in (cache.all (list& body_dependencies all_super_ctor_dependencies)))) (^or {#Override [[parent_name parent_variables] name strict_floating_point? annotations variables @@ -749,7 +750,7 @@ {#Static [name privacy strict_floating_point? annotations variables arguments return exceptions body]}) - (dependency.dependencies archive body) + (cache.dependencies archive body) {#Abstract _} (# phase.monad in artifact.no_dependencies))) @@ -1468,7 +1469,7 @@ methodsG (monad.each ! (method_generation archive super_class) methodsS) all_dependencies (|> methodsS (monad.each ! (method_dependencies archive)) - (# ! each dependency.all) + (# ! each cache.all) directive.lifted_generation) .let [directive [class_name (def.class {jvm.#V1_6} {jvm.#Public} jvm.noneC class_name diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index dc806c8d0..78033cc96 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -40,8 +40,9 @@ ["[0]" variable {"+" Variable Register}]] [meta [archive {"+" Archive} - ["[0]" artifact] - ["[0]" dependency]]] + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]" artifact]]] [language [lux [analysis {"+" Environment}] @@ -913,8 +914,29 @@ [synthesis.#Text_Fork]) ))) +(type: Mapping + (Dictionary Synthesis Variable)) + +(def: (local_mapping global_mapping) + (-> Mapping (Environment Synthesis) Mapping) + (|>> list.enumeration + (list#each (function (_ [foreign_id capture]) + [(synthesis.variable/foreign foreign_id) + (|> global_mapping + (dictionary.value capture) + maybe.trusted)])) + (dictionary.of_list synthesis.hash))) + +(def: (init_mapping global_mapping) + (-> Mapping (Environment Synthesis) Mapping) + (|>> list.enumeration + (list#each (function (_ [id capture]) + [(synthesis.variable/foreign id) + {variable.#Local (++ id)}])) + (dictionary.of_list synthesis.hash))) + (def: (normalize_method_body mapping) - (-> (Dictionary Synthesis Variable) Synthesis Synthesis) + (-> Mapping Synthesis Synthesis) (function (again body) (case body (^template [<tag>] @@ -980,38 +1002,51 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: (anonymous_init_method env) - (-> (Environment Synthesis) (Type Method)) +(def: (anonymous_init_method env inputsTI) + (-> (Environment Synthesis) (List (Typed Inst)) (Type 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 inputsTI) (-> (Type Class) (Environment Synthesis) (Type Class) (List (Typed Inst)) Def) - (let [store_capturedI (|> env + (let [inputs_offset (list.size inputsTI) + inputs! (|> inputsTI + list.enumeration + (list#each (function (_ [register [type term]]) + (case (type.primitive? type) + {.#Right type} + (_.ALOAD (++ register)) + + {.#Left type} + (|>> (_.ALOAD (++ register)) + (_.CHECKCAST type))))) + _.fuse) + store_capturedI (|> env list.size list.indices (list#each (.function (_ register) (|>> (_.ALOAD 0) - (_.ALOAD (++ register)) + (_.ALOAD (n.+ inputs_offset (++ register))) (_.PUTFIELD class (///reference.foreign_name register) $Object)))) _.fuse)] - (_def.method {$.#Public} $.noneM "<init>" (anonymous_init_method env) + (_def.method {$.#Public} $.noneM "<init>" (anonymous_init_method env inputsTI) (|>> (_.ALOAD 0) - ((_.fuse (list#each product.right inputsTI))) + inputs! (_.INVOKESPECIAL super_class "<init>" (type.method [(list) (list#each product.left inputsTI) type.void (list)])) store_capturedI _.RETURN)))) -(def: (anonymous_instance generate archive class env) - (-> Phase Archive (Type Class) (Environment Synthesis) (Operation Inst)) +(def: (anonymous_instance generate archive class env inputsTI) + (-> Phase Archive (Type Class) (Environment Synthesis) (List (Typed Inst)) (Operation Inst)) (do [! phase.monad] [captureI+ (monad.each ! (generate archive) env)] (in (|>> (_.NEW class) _.DUP - (_.fuse captureI+) - (_.INVOKESPECIAL class "<init>" (anonymous_init_method env)))))) + ((_.fuse (list#each product.right inputsTI))) + ((_.fuse captureI+)) + (_.INVOKESPECIAL class "<init>" (anonymous_init_method env inputsTI)))))) (def: (prepare_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register Inst]) @@ -1095,7 +1130,7 @@ (let [[_super _name _strict_fp? _annotations _t_vars _this _arguments _return _exceptions bodyS] method] - (dependency.dependencies archive bodyS))) + (cache.dependencies archive bodyS))) (def: class::anonymous Handler @@ -1110,16 +1145,16 @@ inputsTS overriden_methods]) (do [! phase.monad] - [all_input_dependencies (monad.each ! (|>> product.right (dependency.dependencies archive)) inputsTS) + [all_input_dependencies (monad.each ! (|>> product.right (cache.dependencies archive)) inputsTS) all_closure_dependencies (|> overriden_methods (list#each product.left) list.together - (monad.each ! (dependency.dependencies archive))) + (monad.each ! (cache.dependencies archive))) all_method_dependencies (monad.each ! (|>> product.right (method_dependencies archive)) overriden_methods) - .let [all_dependencies (dependency.all ($_ list#composite - all_input_dependencies - all_closure_dependencies - all_method_dependencies))] + .let [all_dependencies (cache.all ($_ list#composite + all_input_dependencies + all_closure_dependencies + all_method_dependencies))] [context _] (generation.with_new_context archive all_dependencies @@ -1146,20 +1181,18 @@ strict_fp? annotations vars self_name arguments returnT exceptionsT body]]) - (let [local_mapping (|> environment - list.enumeration - (list#each (function (_ [foreign_id capture]) - [(synthesis.variable/foreign foreign_id) - (|> global_mapping - (dictionary.value capture) - maybe.trusted)])) - (dictionary.of_list synthesis.hash))] - [ownerT name - strict_fp? annotations vars - self_name arguments returnT exceptionsT - (normalize_method_body local_mapping body)])) - overriden_methods)] - inputsTI (monad.each ! (generate_input generate archive) inputsTS) + [ownerT name + strict_fp? annotations vars + self_name arguments returnT exceptionsT + (normalize_method_body (..local_mapping global_mapping environment) + body)]) + overriden_methods) + inputsTS (let [mapping (..init_mapping global_mapping total_environment)] + (list#each (function (_ [type term]) + [type (normalize_method_body mapping term)]) + inputsTS))] + inputsTI (generation.with_context artifact_id + (monad.each ! (generate_input generate archive) inputsTS)) method_definitions (|> normalized_methods (monad.each ! (function (_ [ownerT name strict_fp? annotations varsT @@ -1188,7 +1221,7 @@ method_definitions))]] _ (generation.execute! directive) _ (generation.save! artifact_id {.#None} directive)] - (..anonymous_instance generate archive class total_environment)))])) + (..anonymous_instance generate archive class total_environment inputsTI)))])) (def: class_bundle Bundle diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 7932360a3..2eb1894da 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -1,49 +1,50 @@ (.using - [library - [lux {"-" Type Label Primitive function} - [abstract - ["[0]" monad {"+" do}] - ["[0]" enum]] - [control - [pipe {"+" when> new>}] - ["[0]" function]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]@[0]" functor monoid)]]] - [math - [number - ["n" nat] - ["i" int]]] - [target - [jvm - ["[0]" type {"+" Type} - ["[0]" category {"+" Void Value Return Primitive Object Class Array Var Parameter Method}]]]] - [tool - [compiler - [arity {"+" Arity}] - ["[0]" phase] - [reference - [variable {"+" Register}]] - [language - [lux - [analysis {"+" Environment}] - [synthesis {"+" Synthesis Abstraction Apply}] - ["[0]" generation {"+" Context}]]] - [meta - [archive {"+" Archive} - ["[0]" dependency]]]]]]] - [luxc - [lang - [host - ["$" jvm {"+" Label Inst Def Operation Phase Generator} - ["[0]" def] - ["_" inst]]]]] - ["[0]" // - ["[1][0]" runtime] - ["[0]" reference]]) + [library + [lux {"-" Type Label Primitive function} + [abstract + ["[0]" monad {"+" do}] + ["[0]" enum]] + [control + [pipe {"+" when> new>}] + ["[0]" function]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]@[0]" functor monoid)]]] + [math + [number + ["n" nat] + ["i" int]]] + [target + [jvm + ["[0]" type {"+" Type} + ["[0]" category {"+" Void Value Return Primitive Object Class Array Var Parameter Method}]]]] + [tool + [compiler + [arity {"+" Arity}] + ["[0]" phase] + [reference + [variable {"+" Register}]] + [language + [lux + [analysis {"+" Environment}] + [synthesis {"+" Synthesis Abstraction Apply}] + ["[0]" generation {"+" Context}]]] + [meta + [archive {"+" Archive}] + ["[0]" cache "_" + ["[1]" artifact]]]]]]] + [luxc + [lang + [host + ["$" jvm {"+" Label Inst Def Operation Phase Generator} + ["[0]" def] + ["_" inst]]]]] + ["[0]" // + ["[1][0]" runtime] + ["[0]" reference]]) (def: arity_field Text "arity") @@ -308,7 +309,7 @@ (-> (Maybe Context) (Generator Abstraction)) (do [! phase.monad] [@begin _.make_label - dependencies (dependency.dependencies archive bodyS) + dependencies (cache.dependencies archive bodyS) [function_context bodyI] (case forced_context {.#Some function_context} (do ! diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index bd3f36e3e..4cb5319cd 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -459,8 +459,9 @@ #0) ... (type: .public (Either l r) -... {#Left l} -... {#Right r}) +... (Variant +... {#Left l} +... {#Right r})) ("lux def type tagged" Either {#Named [..prelude_module "Either"] {#UnivQ {#End} @@ -482,9 +483,10 @@ .public) ... (type: .public Module_State -... #Active -... #Compiled -... #Cached) +... (Variant +... #Active +... #Compiled +... #Cached)) ("lux def type tagged" Module_State {#Named [..prelude_module "Module_State"] {#Sum diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 923919c16..e042ad9d1 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -227,7 +227,7 @@ (^or "<type 'list'>" "<class 'list'>") (tuple_inspection inspection value) - (^or "<type 'tuple'>" "<type 'tuple'>") + (^or "<type 'tuple'>" "<class 'tuple'>") (let [variant (:as (array.Array Any) value)] (case (array.size variant) 3 (let [variant_tag ("python array read" 0 variant) diff --git a/stdlib/source/library/lux/tool/compiler.lux b/stdlib/source/library/lux/tool/compiler.lux index 7a9c40261..c4160aa3c 100644 --- a/stdlib/source/library/lux/tool/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler.lux @@ -34,7 +34,7 @@ [#dependencies (List Module) #process (-> s Archive (Try [s (Either (Compilation s d o) - [Descriptor (Document d) Output])]))])) + (archive.Entry Any))]))])) (type: .public (Compiler s d o) (-> Input (Compilation s d o))) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index e7c3bae01..8f32b5108 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -1,60 +1,60 @@ (.using - [library - [lux {"-" Module} - ["@" target {"+" Target}] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - [binary {"+" Binary}] - ["[0]" product] - ["[0]" text ("[1]#[0]" hash) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" dictionary] - ["[0]" set] - ["[0]" sequence ("[1]#[0]" functor)]]] - ["[0]" meta] - [world - ["[0]" file]]]] - ["[0]" // "_" - ["/[1]" // {"+" Instancer} - ["[1][0]" phase] - [language - [lux - [program {"+" Program}] - ["[1][0]" version] - ["[1][0]" syntax {"+" Aliases}] - ["[1][0]" synthesis] - ["[1][0]" directive {"+" Requirements}] - ["[1][0]" generation] - ["[1][0]" analysis - [macro {"+" Expander}] - ["[1]/[0]" evaluation]] - [phase - ["[0]P" synthesis] - ["[0]P" directive] - ["[0]P" analysis - ["[0]" module]] - ["[0]" extension {"+" Extender} - ["[0]E" analysis] - ["[0]E" synthesis] - [directive - ["[0]D" lux]]]]]] - [meta - ["[0]" archive {"+" Archive} - ["[0]" descriptor {"+" Module}] - ["[0]" registry {"+" Registry}] - ["[0]" document]]]] - ]) + [library + [lux "*" + ["@" target {"+" Target}] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text ("[1]#[0]" hash) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" dictionary] + ["[0]" set] + ["[0]" sequence ("[1]#[0]" functor)]]] + ["[0]" meta] + [world + ["[0]" file]]]] + ["[0]" // "_" + ["/[1]" // {"+" Instancer} + ["[1][0]" phase] + [language + [lux + [program {"+" Program}] + ["[1][0]" version] + ["[1][0]" syntax {"+" Aliases}] + ["[1][0]" synthesis] + ["[1][0]" directive {"+" Requirements}] + ["[1][0]" generation] + ["[1][0]" analysis + [macro {"+" Expander}] + ["[1]/[0]" evaluation]] + [phase + ["[0]P" synthesis] + ["[0]P" directive] + ["[0]P" analysis + ["[0]" module]] + ["[0]" extension {"+" Extender} + ["[0]E" analysis] + ["[0]E" synthesis] + [directive + ["[0]D" lux]]]]]] + [meta + ["[0]" archive {"+" Archive} + ["[0]" descriptor] + ["[0]" registry {"+" Registry}] + ["[0]" document]]]] + ]) (def: .public (state target module expander host_analysis host generate generation_bundle) (All (_ anchor expression directive) (-> Target - Module + descriptor.Module Expander ///analysis.Bundle (///generation.Host expression directive) @@ -92,7 +92,7 @@ (-> Source (Either [Source Text] [Source Code]))) (def: (reader current_module aliases [location offset source_code]) - (-> Module Aliases Source (///analysis.Operation Reader)) + (-> descriptor.Module Aliases Source (///analysis.Operation Reader)) (function (_ [bundle state]) {try.#Success [[bundle state] (///syntax.parse current_module aliases ("lux text size" source_code))]})) @@ -120,7 +120,7 @@ Registry]) (def: (begin dependencies hash input) - (-> (List Module) Nat ///.Input + (-> (List descriptor.Module) Nat ///.Input (All (_ anchor expression directive) (///directive.Operation anchor expression directive [Source (Payload directive)]))) @@ -137,7 +137,7 @@ registry.empty]]))))) (def: (end module) - (-> Module + (-> descriptor.Module (All (_ anchor expression directive) (///directive.Operation anchor expression directive [.Module (Payload directive)]))) (do ///phase.monad @@ -200,7 +200,7 @@ (def: (iteration wrapper archive expander module source pre_payload aliases) (All (_ directive) - (-> ///phase.Wrapper Archive Expander Module Source (Payload directive) Aliases + (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload directive) Aliases (All (_ anchor expression) (///directive.Operation anchor expression directive (Maybe [Source Requirements (Payload directive)]))))) @@ -218,7 +218,7 @@ (exception.with ///.cannot_compile module {try.#Failure error})))))) (def: (default_dependencies prelude input) - (-> Module ///.Input (List Module)) + (-> descriptor.Module ///.Input (List descriptor.Module)) (list& archive.runtime_module (if (text#= prelude (value@ ///.#module input)) (list) @@ -230,7 +230,7 @@ (def: .public (compiler wrapper expander prelude write_directive) (All (_ anchor expression directive) - (-> ///phase.Wrapper Expander Module (-> directive Binary) + (-> ///phase.Wrapper Expander descriptor.Module (-> directive Binary) (Instancer (///directive.State+ anchor expression directive) .Module))) (let [execute! (directiveP.phase wrapper expander)] (function (_ key parameters input) @@ -254,14 +254,14 @@ descriptor.#name module descriptor.#file (value@ ///.#file input) descriptor.#references (set.of_list text.hash dependencies) - descriptor.#state {.#Compiled} - descriptor.#registry final_registry]]] + descriptor.#state {.#Compiled}]]] (in [state {.#Right [descriptor (document.document key analysis_module) (sequence#each (function (_ [artifact_id custom directive]) [artifact_id custom (write_directive directive)]) - final_buffer)]}])) + final_buffer) + final_registry]}])) {.#Some [source requirements temporary_payload]} (let [[temporary_buffer temporary_registry] temporary_payload] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index fd852c4ce..b7fb40f56 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -51,7 +51,7 @@ ["[0]" module]]]]] [meta ["[0]" archive {"+" Output Archive} - [registry {"+" Registry}] + ["[0]" registry {"+" Registry}] ["[0]" artifact] ["[0]" descriptor {"+" Descriptor Module}] ["[0]" document {"+" Document}]] @@ -89,13 +89,16 @@ <Bundle> (as_is (///generation.Bundle <type_vars>))] (def: writer - (Writer [Descriptor (Document .Module)]) - (_.and descriptor.writer - (document.writer $.writer))) - - (def: (cache_module static platform module_id [descriptor document output]) + (Writer [Descriptor (Document .Module) Registry]) + ($_ _.and + descriptor.writer + (document.writer $.writer) + registry.writer + )) + + (def: (cache_module static platform module_id [descriptor document output registry]) (All (_ <type_vars>) - (-> Static <Platform> archive.ID [Descriptor (Document Any) Output] + (-> Static <Platform> archive.ID (archive.Entry Any) (Async (Try Any)))) (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) @@ -115,7 +118,7 @@ document (# async.monad in (document.marked? $.key document))] (ioW.cache system static module_id - (_.result ..writer [descriptor document]))))) + (_.result ..writer [descriptor document registry]))))) ... TODO: Inline ASAP (def: initialize_buffer! @@ -131,14 +134,13 @@ [_ ..initialize_buffer!] (value@ #runtime platform))) - (def: (runtime_descriptor registry) - (-> Registry Descriptor) + (def: runtime_descriptor + Descriptor [descriptor.#hash 0 descriptor.#name archive.runtime_module descriptor.#file "" descriptor.#references (set.empty text.hash) - descriptor.#state {.#Compiled} - descriptor.#registry registry]) + descriptor.#state {.#Compiled}]) (def: runtime_document (Document .Module) @@ -148,17 +150,16 @@ (All (_ <type_vars>) (-> Archive <Platform> (///directive.Operation <type_vars> - [Archive [Descriptor (Document .Module) Output]]))) + [Archive (archive.Entry .Module)]))) (do ///phase.monad [[registry payload] (///directive.lifted_generation (..compile_runtime! platform)) - .let [[descriptor document] [(..runtime_descriptor registry) ..runtime_document]] archive (///phase.lifted (if (archive.reserved? archive archive.runtime_module) - (archive.has archive.runtime_module [descriptor document payload] archive) + (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive) (do try.monad [[_ archive] (archive.reserve archive.runtime_module archive)] - (archive.has archive.runtime_module [descriptor document payload] archive))))] - (in [archive [descriptor document payload]]))) + (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive))))] + (in [archive [..runtime_descriptor ..runtime_document payload registry]]))) (def: (initialize_state extender [analysers @@ -623,7 +624,7 @@ (All (_ <type_vars>) (-> Module <Context> (///.Compilation <State+> .Module Any) (Try [<State+> (Either (///.Compilation <State+> .Module Any) - [Descriptor (Document .Module) Output])]))) + (archive.Entry Any))]))) ((value@ ///.#process compilation) ... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. ... TODO: The context shouldn't need to be re-set either. 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 4a9efba50..077747e0d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module symbol} + [lux {"-" symbol} [abstract [monad {"+" do}]] [control @@ -31,7 +31,7 @@ ["[0]" phase] [meta ["[0]" archive {"+" Archive} - ["[0]" descriptor {"+" Module}] + ["[0]" descriptor] ["[0]" artifact] ["[0]" registry {"+" Registry}]]]]]) @@ -46,9 +46,9 @@ ["Error" error])) (template [<name>] - [(exception: .public (<name> [artifact_id artifact.ID]) + [(exception: .public (<name> [it artifact.ID]) (exception.report - ["Artifact ID" (%.nat artifact_id)]))] + ["Artifact ID" (%.nat it)]))] [cannot_overwrite_output] [no_buffer_for_saving_code] @@ -72,7 +72,7 @@ (type: .public (State anchor expression directive) (Record - [#module Module + [#module descriptor.Module #anchor (Maybe anchor) #host (Host expression directive) #buffer (Maybe (Buffer directive)) @@ -97,7 +97,7 @@ (def: .public (state host module) (All (_ anchor expression directive) (-> (Host expression directive) - Module + descriptor.Module (..State anchor expression directive))) [#module module #anchor {.#None} @@ -191,12 +191,12 @@ (def: .public (enter_module module) (All (_ anchor expression directive) - (-> Module (Operation anchor expression directive Any))) + (-> descriptor.Module (Operation anchor expression directive Any))) (extension.update (with@ #module module))) (def: .public module (All (_ anchor expression directive) - (Operation anchor expression directive Module)) + (Operation anchor expression directive descriptor.Module)) (extension.read (value@ #module))) (def: .public (evaluate! label code) @@ -281,8 +281,8 @@ registry (if (text#= (value@ #module state) _module) {try.#Success (value@ #registry state)} (do try.monad - [[descriptor document] (archive.find _module archive)] - {try.#Success (value@ descriptor.#registry descriptor)}))] + [[descriptor document output registry] (archive.find _module archive)] + {try.#Success registry}))] (case (registry.id _name registry) {.#None} (exception.except ..unknown_definition [name (registry.definitions registry)]) @@ -294,7 +294,7 @@ (def: .public (module_id module archive) (All (_ anchor expression directive) - (-> Module Archive (Operation anchor expression directive archive.ID))) + (-> descriptor.Module Archive (Operation anchor expression directive archive.ID))) (function (_ (^@ stateE [bundle state])) (do try.monad [module_id (archive.id module archive)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index d1b051176..f1ea553f8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -76,7 +76,8 @@ (^template [<tag> <generator>] [(^ (<tag> value)) (<generator> statement expression archive value)]) - ([synthesis.branch/let //case.let!] + ([synthesis.branch/exec //case.exec!] + [synthesis.branch/let //case.let!] [synthesis.branch/if //case.if!] [synthesis.loop/scope //loop.scope!] [synthesis.loop/again //loop.again!]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux index a6b233f4f..10a220018 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -1,34 +1,34 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - ["[0]" exception {"+" exception:}]] - [target - ["_" python]]]] - ["[0]" / "_" - [runtime {"+" Phase}] - ["[1][0]" primitive] - ["[1][0]" structure] + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + ["[0]" exception {"+" exception:}]] + [target + ["_" python]]]] + ["[0]" / "_" + [runtime {"+" Phase}] + ["[1][0]" primitive] + ["[1][0]" structure] + ["[1][0]" reference] + ["[1][0]" function] + ["[1][0]" case] + ["[1][0]" loop] + ["/[1]" // "_" ["[1][0]" reference] - ["[1][0]" function] - ["[1][0]" case] - ["[1][0]" loop] ["/[1]" // "_" - ["[1][0]" reference] + ["[1][0]" extension + [generation + [python + ["[1]/[0]" common]]]] ["/[1]" // "_" - ["[1][0]" extension - [generation - [python - ["[1]/[0]" common]]]] - ["/[1]" // "_" - [analysis {"+" }] - ["[1][0]" synthesis] - ["//[1]" /// "_" - ["[1][0]" phase ("[1]#[0]" monad)] - [reference {"+"} - [variable {"+"}]]]]]]]) + [analysis {"+" }] + ["[1][0]" synthesis] + ["//[1]" /// "_" + ["[1][0]" phase ("[1]#[0]" monad)] + [reference {"+"} + [variable {"+"}]]]]]]]) (exception: .public cannot_recur_as_an_expression) @@ -43,38 +43,31 @@ [////synthesis.f64 /primitive.f64] [////synthesis.text /primitive.text]) - (^ (////synthesis.variant variantS)) - (/structure.variant expression archive variantS) - - (^ (////synthesis.tuple members)) - (/structure.tuple expression archive members) - - {////synthesis.#Reference value} - (//reference.reference /reference.system archive value) - - (^ (////synthesis.branch/case case)) - (/case.case ///extension/common.statement expression archive case) - - (^ (////synthesis.branch/let let)) - (/case.let expression archive let) - - (^ (////synthesis.branch/if if)) - (/case.if expression archive if) - - (^ (////synthesis.branch/get get)) - (/case.get expression archive get) + (^template [<tag> <generator>] + [(^ (<tag> value)) + (<generator> expression archive value)]) + ([////synthesis.variant /structure.variant] + [////synthesis.tuple /structure.tuple] + + [////synthesis.branch/exec /case.exec] + [////synthesis.branch/let /case.let] + [////synthesis.branch/if /case.if] + [////synthesis.branch/get /case.get] + + [////synthesis.function/apply /function.apply]) - (^ (////synthesis.loop/scope scope)) - (/loop.scope ///extension/common.statement expression archive scope) + (^template [<tag> <generator>] + [(^ (<tag> value)) + (<generator> ///extension/common.statement expression archive value)]) + ([////synthesis.branch/case /case.case] + [////synthesis.loop/scope /loop.scope] + [////synthesis.function/abstraction /function.function]) (^ (////synthesis.loop/again updates)) (//////phase.except ..cannot_recur_as_an_expression []) - (^ (////synthesis.function/abstraction abstraction)) - (/function.function ///extension/common.statement expression archive abstraction) - - (^ (////synthesis.function/apply application)) - (/function.apply expression archive application) + {////synthesis.#Reference value} + (//reference.reference /reference.system archive value) {////synthesis.#Extension extension} (///extension.apply archive expression extension))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index d65324f5a..db2b87ba7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" case let if symbol} + [lux {"-" case exec let if symbol} [abstract ["[0]" monad {"+" do}]] [data @@ -32,8 +32,9 @@ ["[1][0]" variable {"+" Register}]] ["[1][0]" phase ("[1]#[0]" monad)] [meta - [archive {"+" Archive} - ["[0]" dependency]]]]]]]]) + [archive {"+" Archive}] + ["[0]" cache "_" + ["[1]" artifact]]]]]]]]) (def: .public (symbol prefix) (-> Text (Operation SVar)) @@ -46,7 +47,7 @@ (def: .public capture (-> Register SVar) - (|>> (///reference.foreign //reference.system) :expected)) + (|>> (///reference.foreign //reference.system) :expected)) (def: .public (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) @@ -67,6 +68,22 @@ (_.set (list (..register register)) valueO) bodyO)))) +(def: .public (exec expression archive [pre post]) + (Generator [Synthesis Synthesis]) + (do ///////phase.monad + [pre (expression archive pre) + post (expression archive post)] + (in (_.item (_.int +1) (_.tuple (list pre post)))))) + +(def: .public (exec! statement expression archive [pre post]) + (Generator! [Synthesis Synthesis]) + (do ///////phase.monad + [pre (expression archive pre) + post (statement expression archive post)] + (in ($_ _.then + (_.statement pre) + post)))) + (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) (do ///////phase.monad @@ -207,8 +224,10 @@ ..peek)]) (again then))) {.#Item item})] - (in {.#Some (_.cond clauses - ..fail_pm!)}))]) + (in {.#Some (list#mix (function (_ [when then] else) + (_.if when then else)) + ..fail_pm! + clauses)}))]) ([/////synthesis.#I64_Fork (<| //primitive.i64 .int)] [/////synthesis.#F64_Fork (<| //primitive.f64)] [/////synthesis.#Text_Fork (<| //primitive.text)]) @@ -324,7 +343,7 @@ (def: .public (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad - [dependencies (dependency.path_dependencies archive pathP) + [dependencies (cache.path_dependencies archive pathP) [[case_module case_artifact] pattern_matching!] (/////generation.with_new_context archive dependencies 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 816353edd..4a1e1b205 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 @@ -1,39 +1,40 @@ (.using - [library - [lux {"-" function} - [abstract - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)]]] - [target - ["_" python {"+" SVar Expression Statement}]]]] - ["[0]" // "_" - [runtime {"+" Operation Phase Generator Phase! Generator!}] + [library + [lux {"-" function} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)]]] + [target + ["_" python {"+" SVar Expression Statement}]]]] + ["[0]" // "_" + [runtime {"+" Operation Phase Generator Phase! Generator!}] + ["[1][0]" reference] + ["[1][0]" case] + ["[1][0]" loop] + ["/[1]" // "_" ["[1][0]" reference] - ["[1][0]" case] - ["[1][0]" loop] - ["/[1]" // "_" - ["[1][0]" reference] + ["//[1]" /// "_" + [analysis {"+" Environment Abstraction Reification Analysis}] + [synthesis {"+" Synthesis}] + ["[1][0]" generation {"+" Context}] ["//[1]" /// "_" - [analysis {"+" Environment Abstraction Application Analysis}] - [synthesis {"+" Synthesis}] - ["[1][0]" generation {"+" Context}] - ["//[1]" /// "_" - [arity {"+" Arity}] - ["[1][0]" phase] - [reference - [variable {"+" Register Variable}]] - [meta - [archive {"+" Archive} - ["[0]" artifact] - ["[0]" dependency]]]]]]]) + [arity {"+" Arity}] + ["[1][0]" phase] + [reference + [variable {"+" Register Variable}]] + [meta + [archive {"+" Archive} + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]" artifact]]]]]]]) (def: .public (apply expression archive [functionS argsS+]) - (Generator (Application Synthesis)) + (Generator (Reification Synthesis)) (do [! ///////phase.monad] [functionO (expression archive functionS) argsO+ (monad.each ! (expression archive) argsS+)] @@ -70,7 +71,7 @@ (def: .public (function statement expression archive [environment arity bodyS]) (-> Phase! (Generator (Abstraction Synthesis))) (do [! ///////phase.monad] - [dependencies (dependency.dependencies archive bodyS) + [dependencies (cache.dependencies archive bodyS) [[function_module function_artifact] body!] (/////generation.with_new_context archive dependencies (/////generation.with_anchor 1 (statement expression archive bodyS))) @@ -92,23 +93,23 @@ (_.def @self (list (_.poly @curried)) ($_ _.then (_.set (list @num_args) (_.len/1 @curried)) - (_.cond (list [(|> @num_args (_.= arityO)) - (<| (_.then initialize!) - //loop.set_scope - body!)] - [(|> @num_args (_.> arityO)) - (let [arity_inputs (_.slice (_.int +0) arityO @curried) - extra_inputs (_.slice arityO @num_args @curried)] - (_.return (|> @self - (apply_poly arity_inputs) - (apply_poly extra_inputs))))]) - ... (|> @num_args (_.< arityO)) - (let [@next (_.var "next") - @missing (_.var "missing")] - ($_ _.then - (_.def @next (list (_.poly @missing)) - (_.return (|> @self (apply_poly (|> @curried (_.+ @missing)))))) - (_.return @next) - ))) + (<| (_.if (|> @num_args (_.= arityO)) + (<| (_.then initialize!) + //loop.set_scope + body!)) + (_.if (|> @num_args (_.> arityO)) + (let [arity_inputs (_.slice (_.int +0) arityO @curried) + extra_inputs (_.slice arityO @num_args @curried)] + (_.return (|> @self + (apply_poly arity_inputs) + (apply_poly extra_inputs))))) + ... (|> @num_args (_.< arityO)) + (let [@next (_.var "next") + @missing (_.var "missing")] + ($_ _.then + (_.def @next (list (_.poly @missing)) + (_.return (|> @self (apply_poly (|> @curried (_.+ @missing)))))) + (_.return @next) + ))) ))) )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 163ce3b9d..57040b638 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -29,8 +29,8 @@ ["//[1]" /// "_" ["[1][0]" phase] [meta - [archive - ["[0]" dependency]]] + ["[0]" cache "_" + ["[1]" artifact]]] [reference ["[1][0]" variable {"+" Register}]]]]]]]) @@ -77,7 +77,7 @@ ... true loop _ (do [! ///////phase.monad] - [dependencies (dependency.dependencies archive bodyS) + [dependencies (cache.dependencies archive bodyS) initsO+ (monad.each ! (expression archive) initsS+) [[loop_module loop_artifact] body!] (/////generation.with_new_context archive dependencies (/////generation.with_anchor start 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 2f99ad62b..790853c23 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 @@ -38,7 +38,8 @@ [variable {"+" Register}]] [meta [archive {"+" Output Archive} - ["[0]" artifact {"+" Registry}]]]]]]) + ["[0]" registry {"+" Registry}] + ["[0]" artifact]]]]]]) (template [<name> <base>] [(type: .public <name> @@ -227,12 +228,12 @@ ($_ _.then (_.set (list last_index_right) (..last_index tuple)) (_.set (list right_index) (_.+ (_.int +1) lefts)) - (_.cond (list [(_.= last_index_right right_index) - (_.return (_.item right_index tuple))] - [(_.> last_index_right right_index) - ... Needs recursion. - <recur>]) - (_.return (_.slice_from right_index tuple)))) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + <recur>) + (_.return (_.slice_from right_index tuple)))) {.#None})))) (runtime: (sum::get sum expected##right? expected##lefts) @@ -246,23 +247,21 @@ (_.- (_.int +1)))) (_.set (list sum) actual##value))] (_.while (_.bool true) - (_.cond (list [(_.= expected##lefts actual##lefts) - (_.if (_.= expected##right? actual##right?) - (_.return actual##value) - mismatch!)] - - [(_.< expected##lefts actual##lefts) - (_.if (_.= ..unit actual##right?) - recur! - mismatch!)] - - [(_.= ..unit expected##right?) - (_.return (variant' (|> actual##lefts - (_.- expected##lefts) - (_.- (_.int +1))) - actual##right? - actual##value))]) - mismatch!) + (<| (_.if (_.= expected##lefts actual##lefts) + (_.if (_.= expected##right? actual##right?) + (_.return actual##value) + mismatch!)) + (_.if (_.< expected##lefts actual##lefts) + (_.if (_.= ..unit actual##right?) + recur! + mismatch!)) + (_.if (_.= ..unit expected##right?) + (_.return (variant' (|> actual##lefts + (_.- expected##lefts) + (_.- (_.int +1))) + actual##right? + actual##value))) + mismatch!) {.#None}))) (def: runtime::adt @@ -452,8 +451,8 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id {.#None} ..runtime)] - (in [(|> artifact.empty - (artifact.resource true artifact.no_dependencies) + (in [(|> registry.empty + (registry.resource true artifact.no_dependencies) product.right) (sequence.sequence [..module_id {.#None} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux index 0b3183166..fc59e133d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux @@ -9,7 +9,8 @@ ["[1][0]" runtime {"+" Operation Phase Generator}] ["[1][0]" primitive] ["///[1]" //// "_" - [analysis {"+" Variant Tuple}] + [analysis + [complex {"+" Variant Tuple}]] ["[1][0]" synthesis {"+" Synthesis}] ["//[1]" /// "_" ["[1][0]" phase ("[1]#[0]" monad)]]]]) 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 4e1c9805d..6d10d0316 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [abstract ["[0]" monad {"+" do}]] [control @@ -18,7 +18,7 @@ [/// [meta ["[0]" archive {"+" Archive} - ["[0]" descriptor {"+" Module}] + ["[0]" descriptor] ["[0]" registry {"+" Registry}]]]]]) (type: .public (Program expression directive) @@ -28,7 +28,7 @@ Text "") -(exception: .public (cannot_find_program [modules (List Module)]) +(exception: .public (cannot_find_program [modules (List descriptor.Module)]) (exception.report ["Modules" (exception.listing %.text modules)])) @@ -41,8 +41,8 @@ (function (_ module) (do ! [id (archive.id module archive) - [descriptor document] (archive.find module archive)] - (in [[module id] (value@ descriptor.#registry descriptor)])))))] + [descriptor document output registry] (archive.find module archive)] + (in [[module id] registry])))))] (case (list.one (function (_ [[module module_id] registry]) (do maybe.monad [program_id (registry.id ..name registry)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 35e167067..faa7e8765 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [abstract ["[0]" equivalence {"+" Equivalence}] ["[0]" monad {"+" do}]] @@ -13,7 +13,6 @@ ["<[0]>" binary {"+" Parser}]]] [data [binary {"+" Binary}] - ["[0]" bit] ["[0]" product] ["[0]" text ["%" format {"+" format}]] @@ -31,9 +30,10 @@ abstract]]] [/ ["[0]" artifact] + ["[0]" registry {"+" Registry}] ["[0]" signature {"+" Signature}] ["[0]" key {"+" Key}] - ["[0]" descriptor {"+" Module Descriptor}] + ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}] [/// [version {"+" Version}]]]) @@ -41,13 +41,13 @@ (type: .public Output (Sequence [artifact.ID (Maybe Text) Binary])) -(exception: .public (unknown_document [module Module - known_modules (List Module)]) +(exception: .public (unknown_document [module descriptor.Module + known_modules (List descriptor.Module)]) (exception.report ["Module" (%.text module)] ["Known Modules" (exception.listing %.text known_modules)])) -(exception: .public (cannot_replace_document [module Module +(exception: .public (cannot_replace_document [module descriptor.Module old (Document Any) new (Document Any)]) (exception.report @@ -55,29 +55,34 @@ ["Old key" (signature.description (document.signature old))] ["New key" (signature.description (document.signature new))])) -(exception: .public (module_has_already_been_reserved [module Module]) - (exception.report - ["Module" (%.text module)])) - -(exception: .public (module_must_be_reserved_before_it_can_be_added [module Module]) - (exception.report - ["Module" (%.text module)])) +(template [<name>] + [(exception: .public (<name> [it descriptor.Module]) + (exception.report + ["Module" (%.text it)]))] -(exception: .public (module_is_only_reserved [module Module]) - (exception.report - ["Module" (%.text module)])) + [module_has_already_been_reserved] + [module_must_be_reserved_before_it_can_be_added] + [module_is_only_reserved] + ) (type: .public ID Nat) (def: .public runtime_module - Module + descriptor.Module "") +(type: .public (Entry a) + (Record + [#descriptor Descriptor + #document (Document a) + #output Output + #registry Registry])) + (abstract: .public Archive (Record [#next ID - #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])]) + #resolver (Dictionary descriptor.Module [ID (Maybe (Entry Any))])]) (def: next (-> Archive ID) @@ -89,52 +94,52 @@ #resolver (dictionary.empty text.hash)])) (def: .public (id module archive) - (-> Module Archive (Try ID)) - (let [(^open "_[0]") (:representation archive)] - (case (dictionary.value module _#resolver) + (-> descriptor.Module Archive (Try ID)) + (let [(^open "/[0]") (:representation archive)] + (case (dictionary.value module /#resolver) {.#Some [id _]} {try.#Success id} {.#None} (exception.except ..unknown_document [module - (dictionary.keys _#resolver)])))) + (dictionary.keys /#resolver)])))) (def: .public (reserve module archive) - (-> Module Archive (Try [ID Archive])) - (let [(^open "_[0]") (:representation archive)] - (case (dictionary.value module _#resolver) + (-> descriptor.Module Archive (Try [ID Archive])) + (let [(^open "/[0]") (:representation archive)] + (case (dictionary.value module /#resolver) {.#Some _} (exception.except ..module_has_already_been_reserved [module]) {.#None} - {try.#Success [_#next + {try.#Success [/#next (|> archive :representation - (revised@ #resolver (dictionary.has module [_#next {.#None}])) + (revised@ #resolver (dictionary.has module [/#next {.#None}])) (revised@ #next ++) :abstraction)]}))) - (def: .public (has module [descriptor document output] archive) - (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) - (let [(^open "_[0]") (:representation archive)] - (case (dictionary.value module _#resolver) + (def: .public (has module entry archive) + (-> descriptor.Module (Entry Any) Archive (Try Archive)) + (let [(^open "/[0]") (:representation archive)] + (case (dictionary.value module /#resolver) {.#Some [id {.#None}]} {try.#Success (|> archive :representation - (revised@ ..#resolver (dictionary.has module [id {.#Some [descriptor document output]}])) + (revised@ ..#resolver (dictionary.has module [id {.#Some entry}])) :abstraction)} {.#Some [id {.#Some [existing_descriptor existing_document existing_output]}]} - (if (same? document existing_document) + (if (same? existing_document (value@ #document entry)) ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... {try.#Success archive} - (exception.except ..cannot_replace_document [module existing_document document])) + (exception.except ..cannot_replace_document [module existing_document (value@ #document entry)])) {.#None} (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) (def: .public entries - (-> Archive (List [Module [ID [Descriptor (Document Any) Output]]])) + (-> Archive (List [descriptor.Module [ID (Entry Any)]])) (|>> :representation (value@ #resolver) dictionary.entries @@ -142,9 +147,9 @@ (# maybe.monad each (|>> [module_id] [module]) entry))))) (def: .public (find module archive) - (-> Module Archive (Try [Descriptor (Document Any) Output])) - (let [(^open "_[0]") (:representation archive)] - (case (dictionary.value module _#resolver) + (-> descriptor.Module Archive (Try (Entry Any))) + (let [(^open "/[0]") (:representation archive)] + (case (dictionary.value module /#resolver) {.#Some [id {.#Some entry}]} {try.#Success entry} @@ -152,19 +157,19 @@ (exception.except ..module_is_only_reserved [module]) {.#None} - (exception.except ..unknown_document [module (dictionary.keys _#resolver)])))) + (exception.except ..unknown_document [module (dictionary.keys /#resolver)])))) (def: .public (archived? archive module) - (-> Archive Module Bit) + (-> Archive descriptor.Module Bit) (case (..find module archive) {try.#Success _} - bit.yes + true {try.#Failure _} - bit.no)) + false)) (def: .public archived - (-> Archive (List Module)) + (-> Archive (List descriptor.Module)) (|>> :representation (value@ #resolver) dictionary.entries @@ -174,23 +179,23 @@ {.#None} {.#None}))))) (def: .public (reserved? archive module) - (-> Archive Module Bit) - (let [(^open "_[0]") (:representation archive)] - (case (dictionary.value module _#resolver) + (-> Archive descriptor.Module Bit) + (let [(^open "/[0]") (:representation archive)] + (case (dictionary.value module /#resolver) {.#Some [id _]} - bit.yes + true {.#None} - bit.no))) + false))) (def: .public reserved - (-> Archive (List Module)) + (-> Archive (List descriptor.Module)) (|>> :representation (value@ #resolver) dictionary.keys)) (def: .public reservations - (-> Archive (List [Module ID])) + (-> Archive (List [descriptor.Module ID])) (|>> :representation (value@ #resolver) dictionary.entries @@ -216,7 +221,7 @@ :abstraction))) (type: Reservation - [Module ID]) + [descriptor.Module ID]) (type: Frozen [Version ID (List Reservation)]) @@ -237,14 +242,14 @@ (def: .public (export version archive) (-> Version Archive Binary) - (let [(^open "_[0]") (:representation archive)] - (|> _#resolver + (let [(^open "/[0]") (:representation archive)] + (|> /#resolver dictionary.entries (list.all (function (_ [module [id descriptor+document]]) (case descriptor+document {.#Some _} {.#Some [module id]} {.#None} {.#None}))) - [version _#next] + [version /#next] (binary.result ..writer)))) (exception: .public (version_mismatch [expected Version diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux index 11857d4be..f91f8375f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux @@ -1,19 +1,23 @@ (.using [library [lux {"-" Module} + [abstract + [equivalence {"+" Equivalence}]] [control ["<>" parser - ["<b>" binary {"+" Parser}]]] + ["<[0]>" binary {"+" Parser}]]] [data + ["[0]" product] ["[0]" text] [collection - [set {"+" Set}]] - [format - ["[0]" binary {"+" Writer}]]] + ["[0]" set {"+" Set}]] + ["[0]" format "_" + ["[1]" binary {"+" Writer}]]] + [math + [number + ["[0]" nat]]] [world - [file {"+" Path}]]]] - [// - ["[0]" registry {"+" Registry}]]) + [file {"+" Path}]]]]) (type: .public Module Text) @@ -24,27 +28,49 @@ #file Path #hash Nat #state Module_State - #references (Set Module) - #registry Registry])) + #references (Set Module)])) + +(implementation: module_state_equivalence + (Equivalence Module_State) + + (def: (= left right) + (case [left right] + (^template [<tag>] + [[{<tag>} {<tag>}] + true]) + ([.#Active] + [.#Compiled] + [.#Cached]) + + _ + false))) + +(def: .public equivalence + (Equivalence Descriptor) + ($_ product.equivalence + text.equivalence + text.equivalence + nat.equivalence + ..module_state_equivalence + set.equivalence + )) (def: .public writer (Writer Descriptor) - ($_ binary.and - binary.text - binary.text - binary.nat - binary.any - (binary.set binary.text) - registry.writer + ($_ format.and + format.text + format.text + format.nat + format.any + (format.set format.text) )) (def: .public parser (Parser Descriptor) ($_ <>.and - <b>.text - <b>.text - <b>.nat + <binary>.text + <binary>.text + <binary>.nat (# <>.monad in {.#Cached}) - (<b>.set text.hash <b>.text) - registry.parser + (<binary>.set text.hash <binary>.text) )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux index 2a464b397..0716cae4e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux @@ -192,9 +192,8 @@ (Dictionary artifact.Dependency (Set artifact.Dependency))]) (|> archive archive.entries - (list#each (function (_ [module [module_id [descriptor document output]]]) - (|> descriptor - (value@ descriptor.#registry) + (list#each (function (_ [module [module_id [descriptor document output registry]]]) + (|> registry registry.artifacts sequence.list (list#each (function (_ [artifact dependencies]) 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 e61b8cad2..9a3f9c9cb 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [abstract ["[0]" monad {"+" do}]] [control @@ -19,30 +19,30 @@ [/// ["[0]" archive {"+" Output Archive} [key {"+" Key}] - ["[0]" descriptor {"+" Module Descriptor}] + ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]]]) (type: .public Ancestry - (Set Module)) + (Set descriptor.Module)) (def: fresh Ancestry (set.empty text.hash)) (type: .public Graph - (Dictionary Module Ancestry)) + (Dictionary descriptor.Module Ancestry)) (def: empty Graph (dictionary.empty text.hash)) (def: .public modules - (-> Graph (List Module)) + (-> Graph (List descriptor.Module)) dictionary.keys) (type: .public Dependency (Record - [#module Module + [#module descriptor.Module #imports Ancestry])) (def: .public graph @@ -53,11 +53,11 @@ (def: (ancestry archive) (-> Archive Graph) - (let [memo (: (Memo Module Ancestry) + (let [memo (: (Memo descriptor.Module Ancestry) (function (_ again module) (do [! state.monad] [.let [parents (case (archive.find module archive) - {try.#Success [descriptor document]} + {try.#Success [descriptor document output registry]} (value@ descriptor.#references descriptor) {try.#Failure error} @@ -74,17 +74,17 @@ (archive.archived archive)))) (def: (dependency? ancestry target source) - (-> Graph Module Module Bit) + (-> Graph descriptor.Module descriptor.Module Bit) (let [target_ancestry (|> ancestry (dictionary.value target) (maybe.else ..fresh))] (set.member? target_ancestry source))) -(type: .public Order - (List [Module [archive.ID [Descriptor (Document .Module) Output]]])) +(type: .public (Order a) + (List [descriptor.Module [archive.ID (archive.Entry a)]])) (def: .public (load_order key archive) - (-> (Key .Module) Archive (Try Order)) + (All (_ a) (-> (Key a) Archive (Try (Order a)))) (let [ancestry (..ancestry archive)] (|> ancestry dictionary.keys @@ -93,6 +93,6 @@ (function (_ module) (do try.monad [module_id (archive.id module archive) - [descriptor document output] (archive.find module archive) - document (document.marked? key document)] - (in [module [module_id [descriptor document output]]]))))))) + entry (archive.find module archive) + document (document.marked? key (value@ archive.#document entry))] + (in [module [module_id (with@ archive.#document document entry)]]))))))) 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 94e96ca26..79ff9881e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [target {"+" Target}] [abstract [predicate {"+" Predicate}] @@ -36,8 +36,8 @@ ["[1][0]" context] ["/[1]" // ["[0]" archive {"+" Output Archive} - ["[0]" registry] - ["[0]" descriptor {"+" Module Descriptor}] + ["[0]" registry {"+" Registry}] + ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}] ["[0]" artifact {"+" Artifact Dependency} ["[0]" category {"+" Category}]]] @@ -158,9 +158,11 @@ (# fs read (..module_descriptor fs static module_id))) (def: parser - (Parser [Descriptor (Document .Module)]) - (<>.and descriptor.parser - (document.parser $.parser))) + (Parser [Descriptor (Document .Module) Registry]) + ($_ <>.and + descriptor.parser + (document.parser $.parser) + registry.parser)) (def: (fresh_analysis_state host) (-> Target .Lux) @@ -169,7 +171,7 @@ (def: (analysis_state host archive) (-> Target Archive (Try .Lux)) (do [! try.monad] - [modules (: (Try (List [Module .Module])) + [modules (: (Try (List [descriptor.Module .Module])) (monad.each ! (function (_ module) (do ! [[descriptor document output] (archive.find module archive) @@ -350,20 +352,23 @@ (in [(document.document $.key (with@ .#definitions definitions content)) bundles]))) -(def: (load_definitions fs static module_id host_environment descriptor document) +(def: (load_definitions fs static module_id host_environment descriptor document registry) (All (_ expression directive) (-> (file.System Async) Static archive.ID (generation.Host expression directive) - Descriptor (Document .Module) - (Async (Try [[Descriptor (Document .Module) Output] - Bundles])))) + Descriptor (Document .Module) Registry + (Async (Try [(archive.Entry .Module) Bundles])))) (do (try.with async.monad) [actual (cached_artifacts fs static module_id) - .let [expected (|> descriptor (value@ descriptor.#registry) registry.artifacts)] + .let [expected (registry.artifacts registry)] [document bundles output] (async#in (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual document))] - (in [[descriptor document output] bundles]))) + (in [[archive.#descriptor descriptor + archive.#document document + archive.#output output + archive.#registry registry] + bundles]))) (def: (purge! fs static [module_name module_id]) - (-> (file.System Async) Static [Module archive.ID] (Async (Try Any))) + (-> (file.System Async) Static [descriptor.Module archive.ID] (Async (Try Any))) (do [! (try.with async.monad)] [.let [cache (..module fs static module_id)] _ (|> cache @@ -381,11 +386,14 @@ (n.= (value@ descriptor.#hash expected) (value@ ////.#hash actual)))) +(type: Cache + [descriptor.Module [archive.ID [Descriptor (Document .Module) Registry]]]) + (type: Purge - (Dictionary Module archive.ID)) + (Dictionary descriptor.Module archive.ID)) (def: initial_purge - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) + (-> (List [Bit Cache]) Purge) (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]]) (if valid_cache? @@ -394,11 +402,11 @@ (dictionary.of_list text.hash))) (def: (full_purge caches load_order) - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) - cache/module.Order + (-> (List [Bit Cache]) + (cache/module.Order .Module) Purge) (list#mix (function (_ [module_name [module_id [descriptor document]]] purge) - (let [purged? (: (Predicate Module) + (let [purged? (: (Predicate descriptor.Module) (dictionary.key? purge))] (if (purged? module_name) purge @@ -415,49 +423,75 @@ Text "(Lux Caching System)") +(def: (valid_cache fs static import contexts [module_name module_id]) + (-> (file.System Async) Static Import (List Context) + [descriptor.Module archive.ID] + (Async (Try [Bit Cache]))) + (with_expansions [<cache> [module_name [module_id [descriptor document registry]]]] + (do [! (try.with async.monad)] + [data (..read_module_descriptor fs static module_id) + [descriptor document registry] (async#in (<binary>.result ..parser data))] + (if (text#= archive.runtime_module module_name) + (in [true <cache>]) + (do ! + [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)] + (in [(..valid_cache? descriptor input) <cache>])))))) + +(def: (pre_loaded_caches fs static import contexts archive) + (-> (file.System Async) Static Import (List Context) Archive + (Async (Try (List [Bit Cache])))) + (do [! (try.with async.monad)] + [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. + it (|> archive + archive.reservations + (monad.each ! + (..valid_cache fs static import contexts)))] + (in it))) + +(def: (load_order archive pre_loaded_caches) + (-> Archive (List [Bit Cache]) + (Try (cache/module.Order .Module))) + (|> pre_loaded_caches + (monad.mix try.monad + (function (_ [_ [module [module_id [descriptor document registry]]]] archive) + (archive.has module [descriptor document (: Output sequence.empty) registry] archive)) + archive) + (# try.monad each (cache/module.load_order $.key)) + (# try.monad conjoint))) + +(def: (loaded_caches host_environment fs static purge load_order) + (All (_ expression directive) + (-> (generation.Host expression directive) (file.System Async) Static + Purge (cache/module.Order .Module) + (Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles]))))) + (do [! (try.with async.monad)] + [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. + it (|> load_order + (list.only (|>> product.left (dictionary.key? purge) not)) + (monad.each ! (function (_ [module_name [module_id [descriptor document _ registry]]]) + (do ! + [[entry bundles] (..load_definitions fs static module_id host_environment descriptor document registry)] + (in [[module_name entry] + bundles])))))] + (in it))) + (def: (load_every_reserved_module host_environment fs static import contexts archive) (All (_ expression directive) (-> (generation.Host expression directive) (file.System Async) Static Import (List Context) Archive (Async (Try [Archive .Lux Bundles])))) (do [! (try.with async.monad)] - [pre_loaded_caches (|> archive - archive.reservations - (monad.each ! (function (_ [module_name module_id]) - (do ! - [data (..read_module_descriptor fs static module_id) - [descriptor document] (async#in (<binary>.result ..parser data))] - (if (text#= archive.runtime_module module_name) - (in [true - [module_name [module_id [descriptor document]]]]) - (do ! - [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)] - (in [(..valid_cache? descriptor input) - [module_name [module_id [descriptor document]]]]))))))) - load_order (|> pre_loaded_caches - (list#each product.right) - (monad.mix try.monad - (function (_ [module [module_id [descriptor document]]] archive) - (archive.has module [descriptor document (: Output sequence.empty)] archive)) - archive) - (# try.monad each (cache/module.load_order $.key)) - (# try.monad conjoint) - async#in) + [pre_loaded_caches (..pre_loaded_caches fs static import contexts archive) + load_order (async#in (load_order archive pre_loaded_caches)) .let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries (monad.each ! (..purge! fs static))) - loaded_caches (|> load_order - (list.only (|>> product.left (dictionary.key? purge) not)) - (monad.each ! (function (_ [module_name [module_id [descriptor document _]]]) - (do ! - [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)] - (in [[module_name descriptor,document,output] - bundles])))))] + loaded_caches (..loaded_caches host_environment fs static purge load_order)] (async#in (do [! try.monad] [archive (monad.mix ! - (function (_ [[module descriptor,document,output] _bundle] archive) - (archive.has module descriptor,document,output archive)) + (function (_ [[module entry] _bundle] archive) + (archive.has module entry archive)) archive loaded_caches) analysis_state (..analysis_state (value@ static.#host static) archive)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 9f37fff18..741ee6591 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -35,10 +35,9 @@ (List [archive.ID (List artifact.ID)])) (def: .public order - (-> cache/module.Order Order) - (list#each (function (_ [module [module_id [descriptor document]]]) - (|> descriptor - (value@ descriptor.#registry) + (-> (cache/module.Order Any) Order) + (list#each (function (_ [module [module_id [_descriptor _document _output registry]]]) + (|> registry registry.artifacts sequence.list (list#each (|>> product.left (value@ artifact.#id))) 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 594f14dd8..34e0cfd46 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -257,7 +257,7 @@ order (cache/module.load_order $.key archive) .let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))] sink (|> order - (list#each (function (_ [module [module_id [descriptor document output]]]) + (list#each (function (_ [module [module_id [descriptor document output registry]]]) [module_id output])) (monad.mix ! (..write_module static necessary_dependencies) (java/util/jar/JarOutputStream::new buffer (..manifest program)))) 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 4cc20607c..3009ce521 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -123,7 +123,7 @@ imports (|> order (list.only (|>> product.right product.left (set.member? included_modules))) list.reversed - (list#each (function (_ [module [module_id [descriptor document output]]]) + (list#each (function (_ [module [module_id [descriptor document output registry]]]) (let [relative_path (_.do "gsub" (list (_.string main_file) (_.string (..module_file module_id))) {.#None} 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 c3f3e4867..2d61f9191 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -71,7 +71,7 @@ [.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)] order (cache/module.load_order $.key archive)] (|> order - (list#each (function (_ [module [module_id [descriptor document output]]]) + (list#each (function (_ [module [module_id [descriptor document output registry]]]) [module_id output])) (monad.mix ! (..write_module necessary_dependencies sequence) header) (# ! each (|>> scope diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 1ad736172..bd4ac94b0 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -116,7 +116,7 @@ [idx tag_list sig_type] (meta.slot member)] (in [idx sig_type]))) -(def: .public (compatible_type? interface candidate) +(def: (compatible_type? interface candidate) (-> Type Type Bit) (with_expansions [<found?> (type#= interface candidate)] (<| (or <found?>) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index a48460778..5537bc855 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,64 +1,66 @@ -(.using - [library - [lux "*" - ["[0]" debug] - ["@" target - ["[0]" js] - ["[0]" python] - ["[0]" lua] - ["[0]" ruby] - ["[0]" php] - ["[0]" scheme] - ["[0]" jvm - ["[0]" class] - ["[0]" version] - [encoding - ["[0]" name]]]] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try ("[1]#[0]" functor)] - ["<>" parser - ["<[0]>" code] - ["<[0]>" analysis] - ["<[0]>" synthesis]]] - [data - ["[0]" binary] - ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" sequence] - ["[0]" list ("[1]#[0]" functor)]] - [format - ["[0]F" binary]]] - [macro - ["[0]" template]] - [math - ["[0]" random] - [number - ["n" nat]]] - [tool - [compiler - ["[0]" phase] - [meta - [archive - ["[0]" artifact]]] - [language - [lux - ["[0]" analysis] - ["[0]" synthesis] - ["[0]" generation] - ["[0]" directive] - [phase - [analysis - ["[0]" type]] - [generation - ["[0]" jvm "_" - ["[1]/[0]" runtime]]]]]]]] - ["_" test {"+" Test}]]] - [\\library - ["[0]" / {"+" analysis: synthesis: generation: directive:}]]) +(.`` (.`` (.using + [library + [lux "*" + ["[0]" debug] + ["@" target + ["[0]" js] + ["[0]" python] + ["[0]" lua] + ["[0]" ruby] + ["[0]" php] + ["[0]" scheme] + ["[0]" jvm + (~~ (.for ["JVM" (~~ (.as_is ["[0]" class] + ["[0]" version] + [encoding + ["[0]" name]]))] + (~~ (.as_is))))]] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try ("[1]#[0]" functor)] + ["<>" parser + ["<[0]>" code] + ["<[0]>" analysis] + ["<[0]>" synthesis]]] + [data + ["[0]" binary] + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" sequence] + ["[0]" list ("[1]#[0]" functor)]] + [format + ["[0]F" binary]]] + [macro + ["[0]" template]] + [math + ["[0]" random] + [number + ["n" nat]]] + [tool + [compiler + ["[0]" phase] + [meta + [archive + ["[0]" artifact]]] + [language + [lux + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + ["[0]" directive] + [phase + [analysis + ["[0]" type]] + [generation + (~~ (.for ["JVM" (~~ (.as_is ["[0]" jvm "_" + ["[1]/[0]" runtime]]))] + (~~ (.as_is))))]]]]]] + ["_" test {"+" Test}]]] + [\\library + ["[0]" / {"+" analysis: synthesis: generation: directive:}]]))) (def: dummy_generation "dummy generation") @@ -163,6 +165,7 @@ (try#each (binaryF.result class.writer)) (class.class version.v6_0 class.public (name.internal $class) + {.#None} (name.internal "java.lang.Object") (list) (list) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 219151d6c..25f869808 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -24,7 +24,8 @@ ["[1]/[0]" signature] ["[1]/[0]" key] ["[1]/[0]" document] - ["[1]/[0]" registry]]] + ["[1]/[0]" registry] + ["[1]/[0]" descriptor]]] ]]) (def: .public test @@ -40,6 +41,7 @@ /meta/archive/key.test /meta/archive/document.test /meta/archive/registry.test + /meta/archive/descriptor.test /phase/extension.test /phase/analysis/simple.test ... /syntax.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux new file mode 100644 index 000000000..d9d0e09a2 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux @@ -0,0 +1,56 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" binary]]] + [data + ["[0]" text] + [format + ["[0]" binary]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] + [\\library + ["[0]" /]]) + +(def: random_module_state + (Random Module_State) + ($_ random.or + (random#in []) + (random#in []) + (random#in []) + )) + +(def: .public (random imports) + (-> Nat (Random /.Descriptor)) + ($_ random.and + (random.ascii/lower 1) + (random.ascii/lower 1) + random.nat + ..random_module_state + (random.set text.hash imports (random.ascii/lower 2)) + )) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Descriptor /.Module]) + (do random.monad + [expected (..random 5)]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random 1))) + + (_.cover [/.writer /.parser] + (|> expected + (binary.result /.writer) + (<binary>.result /.parser) + (try#each (|>> (# /.equivalence = (with@ /.#state {.#Cached} expected)))) + (try.else false))) + ))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 843dd01e4..9d38c6f6d 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -114,37 +114,84 @@ ($monad.spec ..injection ..comparison /.monad)) )) +(def: (primitive_type parameters) + (-> Nat (Random Type)) + (do random.monad + [primitive (random.ascii/upper 3) + parameters (random.list parameters (primitive_type (-- parameters)))] + (in {.#Primitive primitive parameters}))) + +(def: clean_type + (Random Type) + (primitive_type 2)) + (exception: yolo) (def: error_handling Test - ($_ _.and - (do random.monad - [expected (random.ascii/upper 10)] - (_.cover [/.failure] + (do random.monad + [left ..clean_type + right ..clean_type + ex random.nat] + ($_ _.and + (do random.monad + [expected (random.ascii/upper 10)] + (_.cover [/.failure] + (case (/.result /.fresh_context + (: (/.Check Any) + (/.failure expected))) + {try.#Success _} false + {try.#Failure actual} (same? expected actual)))) + (do random.monad + [expected (random.ascii/upper 10)] + (_.cover [/.assertion] + (and (case (/.result /.fresh_context + (: (/.Check Any) + (/.assertion expected true))) + {try.#Success _} true + {try.#Failure actual} false) + (case (/.result /.fresh_context (/.assertion expected false)) + {try.#Success _} false + {try.#Failure actual} (same? expected actual))))) + (_.cover [/.except] (case (/.result /.fresh_context (: (/.Check Any) - (/.failure expected))) + (/.except ..yolo []))) {try.#Success _} false - {try.#Failure actual} (same? expected actual)))) - (do random.monad - [expected (random.ascii/upper 10)] - (_.cover [/.assertion] - (and (case (/.result /.fresh_context - (: (/.Check Any) - (/.assertion expected true))) - {try.#Success _} true - {try.#Failure actual} false) - (case (/.result /.fresh_context (/.assertion expected false)) - {try.#Success _} false - {try.#Failure actual} (same? expected actual))))) - (_.cover [/.except] - (case (/.result /.fresh_context - (: (/.Check Any) - (/.except ..yolo []))) - {try.#Success _} false - {try.#Failure error} (exception.match? ..yolo error))) - )) + {try.#Failure error} (exception.match? ..yolo error))) + (let [scenario (: (-> (-> Text Bit) Type Type Bit) + (function (_ ? <left> <right>) + (and (|> (/.check <left> <right>) + (: (/.Check Any)) + (/.result /.fresh_context) + (case> {try.#Failure error} (? error) + {try.#Success _} false)) + (|> (/.check <right> <left>) + (: (/.Check Any)) + (/.result /.fresh_context) + (case> {try.#Failure error} (? error) + {try.#Success _} false)))))] + ($_ _.and + (_.cover [/.type_check_failed] + (let [scenario (scenario (exception.match? /.type_check_failed))] + (and (scenario (Tuple left right) left) + (scenario (Tuple left right) (Or left right)) + (scenario (Tuple left right) (-> left right)) + (scenario (Tuple left right) {.#Ex ex}) + + (scenario (Or left right) left) + (scenario (Or left right) (-> left right)) + (scenario (Or left right) {.#Ex ex}) + + (scenario (-> left right) left) + (scenario (-> left right) {.#Ex ex}) + + (scenario {.#Ex ex} left) + ))) + (_.cover [/.invalid_type_application] + (let [scenario (scenario (text.contains? (value@ exception.#label /.invalid_type_application)))] + (scenario {.#Apply left right} left))))) + ))) (def: var Test @@ -700,17 +747,6 @@ (try.else false)) )))) -(def: (primitive_type parameters) - (-> Nat (Random Type)) - (do random.monad - [primitive (random.ascii/upper 3) - parameters (random.list parameters (primitive_type (-- parameters)))] - (in {.#Primitive primitive parameters}))) - -(def: clean_type - (Random Type) - (primitive_type 2)) - (def: for_subsumption|ultimate (Random Bit) (do random.monad |