From fe0d9fc74740f1b51e2f498d4516579d3e48ed02 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 27 Jan 2022 04:41:30 -0400 Subject: Fixes for the pure-Lux JVM compiler machinery. [Part 11] --- .../library/lux/control/concurrency/thread.lux | 105 ++++--- stdlib/source/library/lux/target/jvm/field.lux | 58 ++-- stdlib/source/library/lux/target/ruby.lux | 10 + .../library/lux/tool/compiler/default/init.lux | 6 +- .../library/lux/tool/compiler/default/platform.lux | 7 +- .../library/lux/tool/compiler/language/lux.lux | 35 +-- .../tool/compiler/language/lux/analysis/module.lux | 216 +++++++++++++ .../language/lux/phase/analysis/module.lux | 227 -------------- .../language/lux/phase/extension/analysis/jvm.lux | 62 +++- .../language/lux/phase/extension/directive/jvm.lux | 144 ++++----- .../language/lux/phase/extension/directive/lux.lux | 11 +- .../generation/jvm/function/field/constant.lux | 2 +- .../generation/jvm/function/field/variable.lux | 2 +- .../language/lux/phase/generation/jvm/host.lux | 2 +- .../language/lux/phase/generation/jvm/runtime.lux | 8 +- .../lux/tool/compiler/meta/packager/ruby.lux | 21 +- .../lux/tool/compiler/meta/packager/script.lux | 7 +- stdlib/source/test/lux/program.lux | 42 +-- stdlib/source/test/lux/target/jvm.lux | 4 +- stdlib/source/test/lux/target/ruby.lux | 146 ++++++--- .../lux/tool/compiler/language/lux/analysis.lux | 2 + .../tool/compiler/language/lux/analysis/module.lux | 341 +++++++++++++++++++++ 22 files changed, 963 insertions(+), 495 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux create mode 100644 stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux (limited to 'stdlib/source') 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 [ (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 [ ] @@ -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 @@ ))] + [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 - ["" 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 + ["" 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/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux new file mode 100644 index 000000000..e0798d438 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -0,0 +1,216 @@ +(.using + [library + [lux {"-" Label} + [abstract + ["[0]" monad {"+" do}]] + [control + pipe + ["[0]" try] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" mix functor)] + [dictionary + ["[0]" plist]]]] + ["[0]" meta]]] + ["/" // {"+" Operation} + ["//[1]" // "_" + [phase + ["[1][0]" extension]] + [/// + ["[1]" phase]]]]) + +(type: .public Label + Text) + +(exception: .public (unknown_module [module Text]) + (exception.report + ["Module" module])) + +(template [] + [(exception: .public ( [labels (List Label) + owner Type]) + (exception.report + ["Labels" (text.interposed " " labels)] + ["Type" (%.type owner)]))] + + [cannot_declare_labels_for_anonymous_type] + [cannot_declare_labels_for_foreign_type] + ) + +(exception: .public (cannot_define_more_than_once [name Symbol + already_existing Global]) + (exception.report + ["Definition" (%.symbol name)] + ["Original" (case already_existing + {.#Alias alias} + (format "alias " (%.symbol alias)) + + {.#Definition definition} + (format "definition " (%.symbol name)) + + {.#Type _} + (format "type " (%.symbol name)) + + {.#Tag _} + (format "tag " (%.symbol name)) + + {.#Slot _} + (format "slot " (%.symbol name)))])) + +(exception: .public (can_only_change_state_of_active_module [module Text + state Module_State]) + (exception.report + ["Module" module] + ["Desired state" (case state + {.#Active} "Active" + {.#Compiled} "Compiled" + {.#Cached} "Cached")])) + +(def: .public (empty hash) + (-> Nat Module) + [.#module_hash hash + .#module_aliases (list) + .#definitions (list) + .#imports (list) + .#module_state {.#Active}]) + +(def: .public (import module) + (-> Text (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised@ .#modules + (plist.revised self_name (revised@ .#imports (function (_ current) + (if (list.any? (text#= module) + current) + current + {.#Item module current})))) + state) + []]})))) + +(def: .public (alias alias module) + (-> Text Text (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised@ .#modules + (plist.revised self_name (revised@ .#module_aliases (: (-> (List [Text Text]) (List [Text Text])) + (|>> {.#Item [alias module]})))) + state) + []]})))) + +(def: .public (exists? module) + (-> Text (Operation Bit)) + (///extension.lifted + (function (_ state) + (|> state + (value@ .#modules) + (plist.value module) + (case> {.#Some _} #1 {.#None} #0) + [state] {try.#Success})))) + +(def: .public (define name definition) + (-> Text Global (Operation Any)) + (///extension.lifted + (do ///.monad + [self_name meta.current_module_name + self meta.current_module] + (function (_ state) + (case (plist.value name (value@ .#definitions self)) + {.#None} + {try.#Success [(revised@ .#modules + (plist.has self_name + (revised@ .#definitions + (: (-> (List [Text Global]) (List [Text Global])) + (|>> {.#Item [name definition]})) + self)) + state) + []]} + + {.#Some already_existing} + ((///extension.up (/.except ..cannot_define_more_than_once [[self_name name] already_existing])) + state)))))) + +(def: .public (create hash name) + (-> Nat Text (Operation Any)) + (///extension.lifted + (function (_ state) + {try.#Success [(revised@ .#modules + (plist.has name (..empty hash)) + state) + []]}))) + +(def: .public (with_module hash name action) + (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) + (do ///.monad + [_ (..create hash name) + output (/.with_current_module name + action) + module (///extension.lifted (meta.module name))] + (in [module output]))) + +(template [ ] + [(def: .public ( module_name) + (-> Text (Operation Any)) + (///extension.lifted + (function (_ state) + (case (|> state (value@ .#modules) (plist.value module_name)) + {.#Some module} + (let [active? (case (value@ .#module_state module) + {.#Active} #1 + _ #0)] + (if active? + {try.#Success [(revised@ .#modules + (plist.has module_name (with@ .#module_state {} module)) + state) + []]} + ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {}])) + state))) + + {.#None} + ((///extension.up (/.except ..unknown_module module_name)) + state))))) + + (def: .public ( module_name) + (-> Text (Operation Bit)) + (///extension.lifted + (function (_ state) + (case (|> state (value@ .#modules) (plist.value module_name)) + {.#Some module} + {try.#Success [state + (case (value@ .#module_state module) + {} #1 + _ #0)]} + + {.#None} + ((///extension.up (/.except ..unknown_module module_name)) + state)))))] + + [set_active active? .#Active] + [set_compiled compiled? .#Compiled] + [set_cached cached? .#Cached] + ) + +(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 + {.#Named type_name _} + (in type_name) + + _ + (/.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 labels index]} + {.#Tag [exported? type labels index]}))) + (list.enumeration labels)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux deleted file mode 100644 index 3ca157f38..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ /dev/null @@ -1,227 +0,0 @@ -(.using - [library - [lux "*" - [abstract - ["[0]" monad {"+" do}]] - [control - pipe - ["[0]" try] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" mix functor)] - [dictionary - ["[0]" plist]]]] - ["[0]" meta]]] - ["[0]" /// "_" - ["[1][0]" extension] - [// - ["/" analysis {"+" Operation}] - [/// - ["[1]" phase]]]]) - -(type: .public Tag Text) - -(exception: .public (unknown_module [module Text]) - (exception.report - ["Module" module])) - -(template [] - [(exception: .public ( [tags (List Text) - owner Type]) - (exception.report - ["Tags" (text.interposed " " tags)] - ["Type" (%.type owner)]))] - - [cannot_declare_tags_for_unnamed_type] - [cannot_declare_tags_for_foreign_type] - ) - -(exception: .public (cannot_define_more_than_once [name Symbol - already_existing Global]) - (exception.report - ["Definition" (%.symbol name)] - ["Original" (case already_existing - {.#Alias alias} - (format "alias " (%.symbol alias)) - - {.#Definition definition} - (format "definition " (%.symbol name)) - - {.#Type _} - (format "type " (%.symbol name)) - - {.#Tag _} - (format "tag " (%.symbol name)) - - {.#Slot _} - (format "slot " (%.symbol name)))])) - -(exception: .public (can_only_change_state_of_active_module [module Text - state Module_State]) - (exception.report - ["Module" module] - ["Desired state" (case state - {.#Active} "Active" - {.#Compiled} "Compiled" - {.#Cached} "Cached")])) - -(def: .public (empty hash) - (-> Nat Module) - [.#module_hash hash - .#module_aliases (list) - .#definitions (list) - .#imports (list) - .#module_state {.#Active}]) - -(def: .public (import module) - (-> Text (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name] - (function (_ state) - {try.#Success [(revised@ .#modules - (plist.revised self_name (revised@ .#imports (function (_ current) - (if (list.any? (text#= module) - current) - current - {.#Item module current})))) - state) - []]})))) - -(def: .public (alias alias module) - (-> Text Text (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name] - (function (_ state) - {try.#Success [(revised@ .#modules - (plist.revised self_name (revised@ .#module_aliases (: (-> (List [Text Text]) (List [Text Text])) - (|>> {.#Item [alias module]})))) - state) - []]})))) - -(def: .public (exists? module) - (-> Text (Operation Bit)) - (///extension.lifted - (function (_ state) - (|> state - (value@ .#modules) - (plist.value module) - (case> {.#Some _} #1 {.#None} #0) - [state] {try.#Success})))) - -(def: .public (define name definition) - (-> Text Global (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name - self meta.current_module] - (function (_ state) - (case (plist.value name (value@ .#definitions self)) - {.#None} - {try.#Success [(revised@ .#modules - (plist.has self_name - (revised@ .#definitions - (: (-> (List [Text Global]) (List [Text Global])) - (|>> {.#Item [name definition]})) - self)) - state) - []]} - - {.#Some already_existing} - ((///extension.up (/.except ..cannot_define_more_than_once [[self_name name] already_existing])) - state)))))) - -(def: .public (create hash name) - (-> Nat Text (Operation Any)) - (///extension.lifted - (function (_ state) - {try.#Success [(revised@ .#modules - (plist.has name (..empty hash)) - state) - []]}))) - -(def: .public (with_module hash name action) - (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) - (do ///.monad - [_ (create hash name) - output (/.with_current_module name - action) - module (///extension.lifted (meta.module name))] - (in [module output]))) - -(template [ ] - [(def: .public ( module_name) - (-> Text (Operation Any)) - (///extension.lifted - (function (_ state) - (case (|> state (value@ .#modules) (plist.value module_name)) - {.#Some module} - (let [active? (case (value@ .#module_state module) - {.#Active} #1 - _ #0)] - (if active? - {try.#Success [(revised@ .#modules - (plist.has module_name (with@ .#module_state {} module)) - state) - []]} - ((///extension.up (/.except can_only_change_state_of_active_module [module_name {}])) - state))) - - {.#None} - ((///extension.up (/.except unknown_module module_name)) - state))))) - - (def: .public ( module_name) - (-> Text (Operation Bit)) - (///extension.lifted - (function (_ state) - (case (|> state (value@ .#modules) (plist.value module_name)) - {.#Some module} - {try.#Success [state - (case (value@ .#module_state module) - {} #1 - _ #0)]} - - {.#None} - ((///extension.up (/.except unknown_module module_name)) - state)))))] - - [set_active active? .#Active] - [set_compiled compiled? .#Compiled] - [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)) - (do [! ///.monad] - [self_name (///extension.lifted meta.current_module_name) - [type_module type_name] (case type - {.#Named type_name _} - (in type_name) - - _ - (/.except ..cannot_declare_tags_for_unnamed_type [tags type])) - _ (///.assertion cannot_declare_tags_for_foreign_type [tags 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)))) 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)) + (<| .form + (<>.after (.text! ..abstract_tag)) + ($_ <>.and + .text + ..visibility + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..var)) + (.tuple (<>.some ..argument)) + ..return + (.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 @@ .bit (.tuple (<>.some ..annotation)) (.tuple (<>.some ..var)) - (.tuple (<>.some ..class)) (.tuple (<>.some ..argument)) ..return + (.tuple (<>.some ..class)) .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 )))) attribute (attribute.constant constant)] - (field.field ..constant::modifier name (sequence.sequence attribute)))]) + (field.field ..constant::modifier name 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 "" ..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& ::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 (<| .form (<>.after (.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 [] + [(|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it ?] (/.with_module hash name + (do ! + [_ (if + (/.import expected_import) + (in []))] + (/extension.lifted + (meta.imported? expected_import))))] + (in ?)) + (/phase.result state) + (try#each (bit#= )) + (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 [ ] + [(_.cover [ ] + (|> (do [! /phase.monad] + [[it ?] (/.with_module hash name + (do ! + [_ ( name) + ? ( name) + ~0 ( name) + ~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 [
 ]
+                                [(|> (/.with_module hash name
+                                       (do /phase.monad
+                                         [_ (
 name)]
+                                         ( 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 []
+                                [(|> ( 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 []
+                                [(|> (/.with_module hash module_name
+                                       (/.define def_name ))
+                                     (/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 []
+                                [(|> (/.with_module hash module_name
+                                       (do /phase.monad
+                                         [_ (/.define def_name )]
+                                         (/.define def_name )))
+                                     (/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 [   ]
+                                [(|> (/.with_module hash module_name
+                                       (do [! /phase.monad]
+                                         [.let [it {.#Named [module_name def_name] def_type}]
+                                          _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})
+                                          _ (/.declare_labels  (list& labels|head labels|tail) public? it)]
+                                         (monad.each ! (|>> [module_name]  /extension.lifted)
+                                                     (list& labels|head labels|tail))))
+                                     (/phase.result state)
+                                     (case> {try.#Success _} 
+                                            {try.#Failure _} (not )))]
+
+                                [.#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 [ ]
+                                [(|> (/.with_module hash module_name
+                                       (do [! /phase.monad]
+                                         [.let [it def_type]
+                                          _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})]
+                                         (/.declare_labels  (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 [ ]
+                                [(|> (/.with_module hash module_name
+                                       (do [! /phase.monad]
+                                         [.let [it {.#Named [foreign_module def_name] def_type}]
+                                          _ (/.define def_name {.#Type [public? it { [labels|head labels|tail]}]})]
+                                         (/.declare_labels  (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)
+          )))
-- 
cgit v1.2.3