diff options
Diffstat (limited to 'stdlib')
35 files changed, 1943 insertions, 889 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index f423a0ccd..c366207f9 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -1,21 +1,21 @@ (.using - [library - [lux {"-" list} - [abstract - [equivalence {"+" Equivalence}] - [functor {"+" Functor}] - [apply {"+" Apply}] - ["[0]" monad {"+" Monad do}]] - [control - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["[0]" io {"+" IO io}]] - [type {"+" :sharing} - abstract]]] - [// - ["[0]" atom {"+" Atom}] - ["[0]" async {"+" Async} ("[1]#[0]" functor)]]) + [library + [lux {"-" list} + [abstract + [equivalence {"+" Equivalence}] + [functor {"+" Functor}] + [apply {"+" Apply}] + ["[0]" monad {"+" Monad do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["[0]" io {"+" IO io}]] + [type {"+" :sharing} + abstract]]] + [// + ["[0]" atom {"+" Atom}] + ["[0]" async {"+" Async} ("[1]#[0]" monad)]]) (type: .public (Channel a) (Async (Maybe [a (Channel a)]))) @@ -209,16 +209,19 @@ (All (_ a b) (-> (-> b a (Async a)) a (Channel b) (Channel a))) - (do [! async.monad] - [item channel] - (case item - {.#None} - (in {.#Some [init (in {.#None})]}) - - {.#Some [head tail]} - (do ! - [init' (f head init)] - (in {.#Some [init (mixes f init' tail)]}))))) + (<| async#in + {.#Some} + [init] + (do [! async.monad] + [item channel] + (case item + {.#None} + (in {.#None}) + + {.#Some [head tail]} + (do ! + [init' (f head init)] + (mixes f init' tail)))))) (def: .public (poll milli_seconds action) (All (_ a) diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index d78e5ba58..ea16cddfc 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -1,22 +1,22 @@ (.using - [library - [lux {"-" list} - ["@" target] - [abstract - [monoid {"+" Monoid}] - [functor {"+" Functor}] - [equivalence {"+" Equivalence}] - [mix {"+" Mix}] - [predicate {"+" Predicate}]] - [control - ["[0]" maybe]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" mix)]]] - [math - [number - ["n" nat]]]]]) + [library + [lux {"-" list} + ["@" target] + [abstract + [monoid {"+" Monoid}] + [functor {"+" Functor}] + [equivalence {"+" Equivalence}] + [mix {"+" Mix}] + [predicate {"+" Predicate}]] + [control + ["[0]" maybe]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" mix)]]] + [math + [number + ["n" nat]]]]]) (def: .public type_name "#Array") @@ -401,3 +401,23 @@ [every? true and] [any? false or] ) + +(def: .public (one check items) + (All (_ a b) + (-> (-> a (Maybe b)) (Array a) (Maybe b))) + (let [size (..size items)] + (loop [idx 0] + (if (n.< size idx) + (with_expansions [<again> (again (++ idx))] + (case (..read! idx items) + {.#Some input} + (case (check input) + {.#None} + <again> + + output + output) + + {.#None} + <again>)) + {.#None})))) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 37e944bb8..28f4d3db7 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - ["@" target] - [abstract - [monoid {"+" Monoid}] - [apply {"+" Apply}] - [equivalence {"+" Equivalence}] - [hash {"+" Hash}] - [mix {"+" Mix}] - [predicate {"+" Predicate}] - ["[0]" functor {"+" Functor}] - ["[0]" monad {"+" Monad do}] - ["[0]" enum]] - [data - ["[0]" bit] - ["[0]" product]] - [math - [number - ["n" nat]]]]]) + [library + [lux "*" + ["@" target] + [abstract + [monoid {"+" Monoid}] + [apply {"+" Apply}] + [equivalence {"+" Equivalence}] + [hash {"+" Hash}] + [mix {"+" Mix}] + [predicate {"+" Predicate}] + ["[0]" functor {"+" Functor}] + ["[0]" monad {"+" Monad do}] + ["[0]" enum]] + [data + ["[0]" bit] + ["[0]" product]] + [math + [number + ["n" nat]]]]]) ... (type: (List a) ... #End @@ -613,3 +613,14 @@ _ {.#Left "Wrong syntax for when"})) + +(def: .public (revised item revision it) + (All (_ a) (-> Nat (-> a a) (List a) (List a))) + (case it + {.#End} + {.#End} + + {.#Item head tail} + (case item + 0 {.#Item (revision head) tail} + _ (revised (-- item) revision it)))) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 4a2beb94f..07ebeba76 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -2,35 +2,35 @@ ... https://hypirion.com/musings/understanding-persistent-vector-pt-2 ... https://hypirion.com/musings/understanding-persistent-vector-pt-3 (.using - [library - [lux {"-" list} - ["@" target] - [abstract - [functor {"+" Functor}] - [apply {"+" Apply}] - [monad {"+" Monad do}] - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}] - [mix {"+" Mix}] - [predicate {"+" Predicate}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" mix functor monoid)] - ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]] - [math - [number - ["n" nat] - ["[0]" i64]]]]]) + [library + [lux {"-" list} + ["@" target] + [abstract + [functor {"+" Functor}] + [apply {"+" Apply}] + [monad {"+" Monad do}] + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}] + [mix {"+" Mix}] + [predicate {"+" Predicate}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [math + [number + ["n" nat] + ["[0]" i64]]]]]) (type: (Node a) (Variant @@ -300,11 +300,11 @@ sequence))} (exception.except ..index_out_of_bounds [sequence idx])))) -(def: .public (revised idx f sequence) +(def: .public (revised idx revision it) (All (_ a) (-> Nat (-> a a) (Sequence a) (Try (Sequence a)))) (do try.monad - [val (..item idx sequence)] - (..has idx (f val) sequence))) + [val (..item idx it)] + (..has idx (revision val) it))) (def: .public (prefix sequence) (All (_ a) (-> (Sequence a) (Sequence a))) @@ -498,3 +498,36 @@ [every? array.every? #1 and] [any? array.any? #0 or] ) + +(def: .public (only when items) + (All (_ a) (-> (-> a Bit) (Sequence a) (Sequence a))) + (..mix (function (_ item output) + (if (when item) + (..suffix item output) + output)) + ..empty + items)) + +(def: (one|node check items) + (All (_ a b) + (-> (-> a (Maybe b)) (Node a) (Maybe b))) + (case items + {#Base items} + (array.one check items) + + {#Hierarchy items} + (array.one (one|node check) items))) + +(def: .public (one check items) + (All (_ a b) + (-> (-> a (Maybe b)) (Sequence a) (Maybe b))) + (case (|> items + (value@ #root) + (array.one (one|node check))) + {.#None} + (|> items + (value@ #tail) + (array.one check)) + + output + output)) diff --git a/stdlib/source/library/lux/data/color/named.lux b/stdlib/source/library/lux/data/color/named.lux index d5de847d4..c25c5fb16 100644 --- a/stdlib/source/library/lux/data/color/named.lux +++ b/stdlib/source/library/lux/data/color/named.lux @@ -5,6 +5,7 @@ [number {"+" hex}]]]] ["[0]" // {"+" Color}]) +... https://developer.mozilla.org/en-US/docs/Web/CSS/color_value (template [<red> <green> <blue> <name>] [(`` (def: .public <name> Color diff --git a/stdlib/source/library/lux/data/format/css/class.lux b/stdlib/source/library/lux/data/format/css/class.lux new file mode 100644 index 000000000..e3b1a67b7 --- /dev/null +++ b/stdlib/source/library/lux/data/format/css/class.lux @@ -0,0 +1,33 @@ +(.using + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" hash) + ["%" format {"+" format}]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [type + abstract]]]) + +(abstract: .public Class + Text + + (def: .public class + (-> Class Text) + (|>> :representation)) + + (def: .public custom + (-> Text Class) + (|>> :abstraction)) + + (syntax: .public (generic []) + (do meta.monad + [module meta.current_module_name + class meta.seed] + (in (list (` (..custom (~ (code.text (format "c" (%.nat/16 class) + "_" (%.nat/16 (text#hash module))))))))))) + ) diff --git a/stdlib/source/library/lux/data/format/css/id.lux b/stdlib/source/library/lux/data/format/css/id.lux new file mode 100644 index 000000000..c5a6f5862 --- /dev/null +++ b/stdlib/source/library/lux/data/format/css/id.lux @@ -0,0 +1,33 @@ +(.using + [library + [lux "*" + ["[0]" meta] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" hash) + ["%" format {"+" format}]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [type + abstract]]]) + +(abstract: .public ID + Text + + (def: .public id + (-> ID Text) + (|>> :representation)) + + (def: .public custom + (-> Text ID) + (|>> :abstraction)) + + (syntax: .public (generic []) + (do meta.monad + [module meta.current_module_name + id meta.seed] + (in (list (` (..custom (~ (code.text (format "i" (%.nat/16 id) + "_" (%.nat/16 (text#hash module))))))))))) + ) diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux index 35893766a..d19cbd9bb 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -1,23 +1,24 @@ (.using - [library - [lux {"-" Label or and for same? not} - ["[0]" locale {"+" Locale}] - [data - ["[0]" text - ["%" format {"+" format}]]] - [math - [number - ["i" int]]] - [type - abstract] - [macro - ["[0]" template]]]]) + [library + [lux {"-" Label or and for same? not} + ["[0]" locale {"+" Locale}] + [data + ["[0]" text + ["%" format {"+" format}]]] + [math + [number + ["i" int]]] + [type + abstract] + [macro + ["[0]" template]]]] + ["[0]" // "_" + ["[1][0]" id {"+" ID}] + ["[1][0]" class {"+" Class}]]) (type: .public Label Text) (type: .public Tag Label) -(type: .public ID Label) -(type: .public Class Label) (type: .public Attribute Label) (abstract: .public (Generic brand) Any) @@ -49,13 +50,13 @@ (-> Tag (Selector Cannot_Chain)) (|>> :abstraction)) - (template [<name> <type> <prefix> <kind>] + (template [<name> <type> <prefix> <kind> <out>] [(def: .public <name> (-> <type> (Selector <kind>)) - (|>> (format <prefix>) :abstraction))] + (|>> <out> (format <prefix>) :abstraction))] - [id ID "#" Unique] - [class Class "." Can_Chain] + [id ID "#" Unique //id.id] + [class Class "." Can_Chain //class.class] ) (template [<right> <left> <combinator>+] diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 79c3243c9..b6021695d 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -1,28 +1,28 @@ (.using - [library - [lux {"-" Meta Source comment and} - [control - ["[0]" function] - ["[0]" maybe ("[1]#[0]" functor)]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)]]] - [type - abstract] - [host - ["[0]" js]] - [macro - ["[0]" template]] - [world - [net {"+" URL}]]]] - [// - [css - ["[0]" selector] - ["[0]" style {"+" Style}]] - ["[0]" xml {"+" XML}]]) + [library + [lux {"-" Meta Source comment and template} + [control + ["[0]" function] + ["[0]" maybe ("[1]#[0]" functor)]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" Format format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)]]] + [macro + ["[0]" template]] + [target + ["[0]" js]] + [type + abstract] + [world + [net {"+" URL}]]]] + [// + ["[0]" xml {"+" XML}] + [css + ["[0]" selector] + ["[0]" style {"+" Style}]]]) (type: .public Tag selector.Tag) (type: .public ID selector.ID) @@ -37,19 +37,19 @@ (type: .public Target (Variant - #Blank - #Parent - #Self - #Top + {#Blank} + {#Parent} + {#Self} + {#Top} {#Frame Text})) (def: (target value) (-> Target Text) (case value - #Blank "_blank" - #Parent "_parent" - #Self "_self" - #Top "_top" + {#Blank} "_blank" + {#Parent} "_parent" + {#Self} "_self" + {#Top} "_top" {#Frame name} name)) ... Properly formats text to ensure no injection can happen on the HTML. @@ -65,14 +65,14 @@ (def: attributes (-> Attributes Text) (|>> (list#each (function (_ [key val]) - (format key "=" text.double_quote (..safe val) text.double_quote))) - (text.interposed " "))) + (format " " key "=" text.double_quote (..safe val) text.double_quote))) + text.together)) (def: (open tag attributes) (-> Tag Attributes Text) (|> attributes ..attributes - (format tag " ") + (format tag) (text.enclosed ["<" ">"]))) (def: close @@ -82,7 +82,7 @@ (abstract: .public (HTML brand) Text - (template [<name> <brand>] + (.template [<name> <brand>] [(abstract: <brand> Any) (type: .public <name> (HTML <brand>))] @@ -100,11 +100,11 @@ [Document Document'] ) - (template [<super> <super_raw> <sub>+] + (.template [<super> <super_raw> <sub>+] [(abstract: (<super_raw> brand) Any) (type: .public <super> (HTML (<super_raw> Any))) - (`` (template [<sub> <sub_raw>] + (`` (.template [<sub> <sub_raw>] [(abstract: <sub_raw> Any) (type: .public <sub> (HTML (<super_raw> <sub_raw>)))] @@ -159,7 +159,7 @@ content (..close tag)))) - (template [<name> <tag> <brand>] + (.template [<name> <tag> <brand>] [(def: .public <name> (-> Attributes <brand>) (..simple <tag>))] @@ -199,7 +199,7 @@ (|>> ..safe :abstraction)) - (template [<tag> <alias> <name>] + (.template [<tag> <alias> <name>] [(def: .public <name> Element (..simple <tag> (list))) @@ -271,7 +271,7 @@ {#Circle Circle} {#Polygon Polygon})) - (template [<name> <shape> <type> <format>] + (.template [<name> <shape> <type> <format>] [(def: (<name> attributes shape) (-> Attributes <type> (HTML Any)) (..simple "area" (list& ["shape" <shape>] @@ -307,7 +307,7 @@ (..tag "map" attributes (list#mix (function.flipped ..and) head tail))))) - (template [<name> <tag> <type>] + (.template [<name> <tag> <type>] [(def: .public <name> (-> Attributes <type>) (..empty <tag>))] @@ -319,7 +319,7 @@ [track "track" Track] ) - (template [<name> <tag>] + (.template [<name> <tag>] [(def: .public (<name> attributes media on_unsupported) (-> Attributes Media (Maybe Content) Element) (..tag <tag> attributes @@ -343,7 +343,7 @@ (-> ID Input) (|>> ["for"] list (..empty "label"))) - (template [<name> <container_tag> <description_tag> <type>] + (.template [<name> <container_tag> <description_tag> <type>] [(def: .public (<name> description attributes content) (-> (Maybe Content) Attributes <type> <type>) (..tag <container_tag> attributes @@ -361,7 +361,7 @@ [figure "figure" "figcaption" Element] ) - (template [<name> <tag> <type>] + (.template [<name> <tag> <type>] [(def: .public (<name> attributes content) (-> Attributes (Maybe Content) <type>) (|> content @@ -375,7 +375,7 @@ (type: .public Phrase (-> Attributes Content Element)) - (template [<name> <tag>] + (.template [<name> <tag>] [(def: .public <name> Phrase (..tag <tag>))] @@ -432,7 +432,7 @@ (type: .public Composite (-> Attributes Element Element)) - (template [<name> <tag>] + (.template [<name> <tag>] [(def: .public <name> Composite (..tag <tag>))] @@ -450,7 +450,7 @@ [span "span"] ) - (template [<tag> <name> <input>] + (.template [<tag> <name> <input>] [(def: <name> (-> <input> (HTML Any)) (..tag <tag> (list)))] @@ -475,7 +475,7 @@ (def: .public p ..paragraph) - (template [<name> <tag> <input> <output>] + (.template [<name> <tag> <input> <output>] [(def: .public <name> (-> Attributes <input> <output>) (..tag <tag>))] @@ -494,7 +494,7 @@ [object "object" Parameter Element] ) - (template [<name> <tag> <input> <output>] + (.template [<name> <tag> <input> <output>] [(def: .public <name> (-> <input> <output>) (..tag <tag> (list)))] @@ -508,7 +508,7 @@ [body "body" Element Body] ) - (template [<name> <tag> <input> <output>] + (.template [<name> <tag> <input> <output>] [(def: <name> (-> <input> <output>) (..tag <tag> (list)))] @@ -555,7 +555,7 @@ (..tag "table" attributes content))) - (template [<name> <doc_type>] + (.template [<name> <doc_type>] [(def: .public <name> (-> Head Body Document) (let [doc_type <doc_type>] diff --git a/stdlib/source/library/lux/ffi.js.lux b/stdlib/source/library/lux/ffi.js.lux index ece090ecd..ddcac1a30 100644 --- a/stdlib/source/library/lux/ffi.js.lux +++ b/stdlib/source/library/lux/ffi.js.lux @@ -197,13 +197,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/ffi.lua.lux b/stdlib/source/library/lux/ffi.lua.lux index 1a99178cd..151d1cf3c 100644 --- a/stdlib/source/library/lux/ffi.lua.lux +++ b/stdlib/source/library/lux/ffi.lua.lux @@ -178,13 +178,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index 2f58fd4f8..cfcfec9f8 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -198,13 +198,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux index 4cb39155c..6f6bc2b96 100644 --- a/stdlib/source/library/lux/ffi.py.lux +++ b/stdlib/source/library/lux/ffi.py.lux @@ -178,13 +178,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/ffi.rb.lux b/stdlib/source/library/lux/ffi.rb.lux index c911e8016..21dae9b6f 100644 --- a/stdlib/source/library/lux/ffi.rb.lux +++ b/stdlib/source/library/lux/ffi.rb.lux @@ -191,13 +191,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index d89e1833b..8beef44d5 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -163,13 +163,13 @@ (def: (with_io with? without) (-> Bit Code Code) (if with? - (` (io.io (~ without))) + (` ((~! io.io) (~ without))) without)) (def: (io_type io? rawT) (-> Bit Code Code) (if io? - (` (io.IO (~ rawT))) + (` ((~! io.IO) (~ rawT))) rawT)) (def: (with_try with? without_try) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 596b5544b..3967ca6d9 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - [abstract - [hash {"+" Hash}] - [enum {"+" Enum}] - [interval {"+" Interval}] - [monoid {"+" Monoid}] - [equivalence {"+" Equivalence}] - [codec {"+" Codec}] - [predicate {"+" Predicate}] - ["[0]" order {"+" Order}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}]] - [data - [text {"+" Char}]]]] - ["[0]" // "_" - ["[1][0]" nat] - ["[1][0]" i64]]) + [library + [lux "*" + [abstract + [hash {"+" Hash}] + [enum {"+" Enum}] + [interval {"+" Interval}] + [monoid {"+" Monoid}] + [equivalence {"+" Equivalence}] + [codec {"+" Codec}] + [predicate {"+" Predicate}] + ["[0]" order {"+" Order}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}]] + [data + [text {"+" Char}]]]] + ["[0]" // "_" + ["[1][0]" nat] + ["[1][0]" i64]]) (def: .public (= reference sample) (-> Int Int Bit) @@ -246,5 +246,11 @@ (def: .public (right_shifted parameter subject) (-> Nat Int Int) - (//i64.or (//i64.and //i64.sign subject) - (//i64.right_shifted parameter subject))) + (with_expansions [<positive> (//i64.right_shifted parameter subject)] + (if (< +0 subject) + (|> +1 + (//i64.left_shifted parameter) + -- + (//i64.left_shifted (//nat.- parameter //i64.width)) + (//i64.or <positive>)) + <positive>))) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 6ee7a793c..2e12d2c19 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Location Code Label or and function if cond undefined for comment not int try ++ --} + [lux {"-" Location Code Label or and function if undefined for comment not int try ++ --} [control [pipe {"+" case>}]] [data @@ -80,17 +80,17 @@ (def: .public (number value) (-> Frac Literal) (:abstraction - (.cond (f.not_a_number? value) - "NaN" + (cond (f.not_a_number? value) + "NaN" - (f.= f.positive_infinity value) - "Infinity" - - (f.= f.negative_infinity value) - "-Infinity" + (f.= f.positive_infinity value) + "Infinity" + + (f.= f.negative_infinity value) + "-Infinity" - ... else - (|> value %.frac ..expression)))) + ... else + (|> value %.frac ..expression)))) (def: safe (-> Text Text) @@ -322,9 +322,12 @@ (-> Expression Statement) (:abstraction (format "return " (:representation value) ..statement_suffix))) - (def: .public (delete value) - (-> Location Statement) - (:abstraction (format "delete " (:representation value) ..statement_suffix))) + (def: .public delete + (-> Location Expression) + (|>> :representation + (format "delete ") + ..expression + :abstraction)) (def: .public (if test then! else!) (-> Expression Statement Statement Statement) @@ -421,13 +424,6 @@ ..block)))) ) -(def: .public (cond clauses else!) - (-> (List [Expression Statement]) Statement Statement) - (list#mix (.function (_ [test then!] next!) - (..if test then! next!)) - else! - (list.reversed clauses))) - (template [<apply> <arg>+ <type>+ <function>+] [(`` (def: .public (<apply> function) (-> Expression (~~ (template.spliced <type>+)) Computation) 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 c91a7aa9f..449060cf0 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 @@ -1,65 +1,70 @@ (.using - [library - [lux {"-" Type Definition} - ["[0]" host] - [abstract - ["[0]" monad {"+" do}]] - [control - [pipe {"+" case>}] - ["<>" parser ("[1]#[0]" monad) - ["<c>" code {"+" Parser}] - ["<t>" text]]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" dictionary] - ["[0]" sequence]]] - [macro - ["[0]" template]] - [math - [number - ["[0]" i32]]] - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] - ["[0]" attribute] - ["[0]" field] - ["[0]" version] - ["[0]" class] - ["[0]" constant - ["[0]" pool {"+" Resource}]] - [encoding - ["[0]" name]] - ["[0]" type {"+" Type Constraint Argument Typed} - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] - ["[0]T" lux {"+" Mapping}] - ["[0]" signature] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" parser]]]] - [tool - [compiler - ["[0]" analysis] - ["[0]" synthesis] - ["[0]" generation] - ["[0]" directive {"+" Handler Bundle}] - ["[0]" phase - [analysis - ["[0]A" type]] - ["[0]" generation - [jvm - [runtime {"+" Anchor Definition}]]] - ["[0]" extension - ["[0]" bundle] + [library + [lux {"-" Type Definition Primitive} + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["<>" parser ("[1]#[0]" monad) + ["<c>" code {"+" Parser}] + ["<t>" text]]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" dictionary] + ["[0]" sequence]]] + [macro + ["[0]" template]] + [math + [number + ["[0]" i32]]] + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] + ["[0]" attribute] + ["[0]" field] + ["[0]" version] + ["[0]" class] + ["[0]" constant + ["[0]" pool {"+" Resource}]] + [encoding + ["[0]" name]] + ["[0]" type {"+" Type Constraint Argument Typed} + [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] + ["[0]T" lux {"+" Mapping}] + ["[0]" signature] + ["[0]" descriptor {"+" Descriptor}] + ["[0]" parser]]]] + [tool + [compiler + ["[0]" phase] + [meta + [archive {"+" Archive}]] + [language + [lux + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + ["[0]" directive {"+" Handler Bundle}] + [phase [analysis - ["[0]" jvm]] - [directive - ["/" lux]]]]]] - [type - ["[0]" check {"+" Check}]]]]) + ["[0]A" type]] + [generation + [jvm + [runtime {"+" Anchor Definition}]]] + ["[0]" extension + ["[0]" bundle] + [analysis + ["[0]" jvm]] + [directive + ["/" lux]]]]]]]] + [type + ["[0]" check {"+" Check}]]]]) (type: Operation (directive.Operation Anchor (Bytecode Any) Definition)) @@ -144,8 +149,9 @@ ))) (type: Field - {#Constant Constant} - {#Variable Variable}) + (Variant + {#Constant Constant} + {#Variable Variable})) (def: field (Parser Field) @@ -155,10 +161,11 @@ )) (type: Method_Definition - {#Constructor (jvm.Constructor Code)} - {#Virtual_Method (jvm.Virtual_Method Code)} - {#Static_Method (jvm.Static_Method Code)} - {#Overriden_Method (jvm.Overriden_Method Code)}) + (Variant + {#Constructor (jvm.Constructor Code)} + {#Virtual_Method (jvm.Virtual_Method Code)} + {#Static_Method (jvm.Static_Method Code)} + {#Overriden_Method (jvm.Overriden_Method Code)})) (def: method (Parser Method_Definition) @@ -199,7 +206,7 @@ [.#Int type.short [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.int [.i64 i32.i32 constant.integer pool.integer]] [.#Int type.long [constant.long pool.long]] - [.#Frac type.float [host.double_to_float constant.float pool.float]] + [.#Frac type.float [ffi.double_to_float constant.float pool.float]] [.#Frac type.double [constant.double pool.double]] [.#Nat type.char [.i64 i32.i32 constant.integer pool.integer]] [.#Text (type.class "java.lang.String" (list)) [pool.string]] @@ -214,8 +221,10 @@ (field.field (modifier#composite visibility state) name type (sequence.sequence)))) -(def: (method_definition [mapping selfT] [analyse synthesize generate]) - (-> [Mapping .Type] +(def: (method_definition archive supers [mapping selfT] [analyse synthesize generate]) + (-> Archive + (List (Type Class)) + [Mapping .Type] [analysis.Phase synthesis.Phase (generation.Phase Anchor (Bytecode Any) Definition)] @@ -226,18 +235,18 @@ (directive.lifted_analysis (case methodC {#Constructor method} - (jvm.analyse_constructor_method analyse selfT mapping method) + (jvm.analyse_constructor_method analyse archive selfT mapping method) {#Virtual_Method method} - (jvm.analyse_virtual_method analyse selfT mapping method) + (jvm.analyse_virtual_method analyse archive selfT mapping method) {#Static_Method method} - (jvm.analyse_static_method analyse mapping method) + (jvm.analyse_static_method analyse archive mapping method) {#Overriden_Method method} - (jvm.analyse_overriden_method analyse selfT mapping method))))] + (jvm.analyse_overriden_method analyse archive selfT mapping supers method))))] (directive.lifted_synthesis - (synthesize methodA))))) + (synthesize archive methodA))))) (def: jvm::class (Handler Anchor (Bytecode Any) Definition) @@ -250,7 +259,7 @@ (<c>.tuple (<>.some ..annotation)) (<c>.tuple (<>.some ..field)) (<c>.tuple (<>.some ..method))) - (function (_ extension phase + (function (_ extension phase archive [[name parameters] super_class super_interfaces @@ -282,7 +291,7 @@ .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 [mapping selfT] [analyse synthesize generate]) + methods (monad.each ! (..method_definition archive (list& super_class super_interfaces) [mapping selfT] [analyse synthesize generate]) methods) ... _ (directive.lifted_generation ... (generation.save! true ["" name] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 4c7cd1294..9ed84603f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -1,46 +1,47 @@ (.using - [library - [lux {"-" Type} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<s>" synthesis {"+" Parser}]]] - [data - ["[0]" product] - [number - ["[0]" i32] - ["f" frac]] - [collection - ["[0]" list ("[1]#[0]" monad)] - ["[0]" dictionary]]] - [target - [jvm - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] - [encoding - ["[0]" signed {"+" S4}]] - ["[0]" type {"+" Type} - [category {"+" Primitive Class}]]]]]] - ["[0]" ///// "_" - [generation - [extension {"+" Nullary Unary Binary Trinary Variadic - nullary unary binary trinary variadic}] - ["///" jvm "_" - ["[1][0]" value] - ["[1][0]" runtime {"+" Operation Phase Bundle Handler}] - ["[1][0]" function "_" - ["[1]" abstract]]]] - [extension - ["[1]extension" /] - ["[1][0]" bundle]] - [// - ["/[1][0]" synthesis {"+" Synthesis %synthesis}] - [/// - ["[1]" phase] - [meta - [archive {"+" Archive}]]]]]) + [library + [lux {"-" Type Label Primitive} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" synthesis {"+" Parser}]]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" monad)] + ["[0]" dictionary]]] + [math + [number + ["f" frac] + ["[0]" i32]]] + [target + [jvm + ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] + [encoding + ["[0]" signed {"+" S4}]] + ["[0]" type {"+" Type} + [category {"+" Primitive Class}]]]]]] + ["[0]" ///// "_" + [generation + [extension {"+" Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic}] + ["///" jvm "_" + ["[1][0]" value] + ["[1][0]" runtime {"+" Operation Phase Bundle Handler}] + ["[1][0]" function "_" + ["[1]" abstract]]]] + [extension + ["[1]extension" /] + ["[1][0]" bundle]] + [// + ["/[1][0]" synthesis {"+" Synthesis %synthesis}] + [/// + ["[1]" phase] + [meta + [archive {"+" Archive}]]]]]) (def: .public (custom [parser handler]) (All (_ s) @@ -48,7 +49,7 @@ (-> Text Phase Archive s (Operation (Bytecode Any)))] Handler)) (function (_ extension_name phase archive input) - (case (<s>.result parser input) + (case (<synthesis>.result parser input) {try.#Success input'} (handler extension_name phase archive input') @@ -99,11 +100,11 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + <synthesis>.any + <synthesis>.any + (<>.some (<synthesis>.tuple ($_ <>.and + (<synthesis>.tuple (<>.many <synthesis>.i64)) + <synthesis>.any)))) (function (_ extension_name phase archive [inputS elseS conditionalsS]) (do [! /////.monad] [@end ///runtime.forge_label @@ -227,7 +228,7 @@ (def: (::toString class from) (-> (Type Class) (Type Primitive) (Bytecode Any)) - (_.invokestatic class "toString" (type.method [(list from) ..$String (list)]))) + (_.invokestatic class "toString" (type.method [(list) (list from) ..$String (list)]))) (template [<name> <prepare> <transform>] [(def: (<name> inputG) @@ -304,7 +305,7 @@ ($_ _.composite inputG ..ensure_string - (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)])) + (_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)])) ..lux_int)) (def: no_op (Bytecode Any) (_#in [])) @@ -318,13 +319,13 @@ <op> <post>))] [text::= ..no_op ..no_op - (_.invokevirtual ..$Object "equals" (type.method [(list ..$Object) type.boolean (list)])) + (_.invokevirtual ..$Object "equals" (type.method [(list) (list ..$Object) type.boolean (list)])) (///value.wrap type.boolean)] [text::< ..ensure_string ..ensure_string - (_.invokevirtual ..$String "compareTo" (type.method [(list ..$String) type.int (list)])) + (_.invokevirtual ..$String "compareTo" (type.method [(list) (list ..$String) type.int (list)])) (..predicate _.iflt)] [text::char ..ensure_string ..jvm_int - (_.invokevirtual ..$String "charAt" (type.method [(list type.int) type.char (list)])) + (_.invokevirtual ..$String "charAt" (type.method [(list) (list type.int) type.char (list)])) ..lux_int] ) @@ -333,7 +334,7 @@ ($_ _.composite leftG ..ensure_string rightG ..ensure_string - (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)])))) + (_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)])))) (def: (text::clip [startG endG subjectG]) (Trinary (Bytecode Any)) @@ -341,9 +342,9 @@ subjectG ..ensure_string startG ..jvm_int endG ..jvm_int - (_.invokevirtual ..$String "substring" (type.method [(list type.int type.int) ..$String (list)])))) + (_.invokevirtual ..$String "substring" (type.method [(list) (list type.int type.int) ..$String (list)])))) -(def: index_method (type.method [(list ..$String type.int) type.int (list)])) +(def: index_method (type.method [(list) (list ..$String type.int) type.int (list)])) (def: (text::index [startG partG textG]) (Trinary (Bytecode Any)) (do _.monad @@ -377,7 +378,7 @@ (/////bundle.install "char" (binary ..text::char)) (/////bundle.install "clip" (trinary ..text::clip))))) -(def: string_method (type.method [(list ..$String) type.void (list)])) +(def: string_method (type.method [(list) (list ..$String) type.void (list)])) (def: (io::log messageG) (Unary (Bytecode Any)) ($_ _.composite diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index f367bd949..6b26d8cfb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -1,73 +1,74 @@ (.using - [library - [lux {"-" Type} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<t>" text] - ["<s>" synthesis {"+" Parser}]]] - [data - ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [number - ["[0]" i32]] - [collection - ["[0]" list ("[1]#[0]" monad)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" set] - ["[0]" sequence]] - ["[0]" format "_" - ["[1]" binary]]] - [target - [jvm - ["[0]" version] - ["[0]" modifier ("[1]#[0]" monoid)] - ["[0]" method {"+" Method}] - ["[0]" class {"+" Class}] - [constant - [pool {"+" Resource}]] - [encoding - ["[0]" name]] - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad) - ["__" instruction {"+" Primitive_Array_Type}]] - ["[0]" type {"+" Type Typed Argument} - ["[0]" category {"+" Void Value' Value Return' Return Primitive Object Array Var Parameter}] - ["[0]" box] - ["[0]" reflection] - ["[0]" signature] - ["[0]" parser]]]]]] - ["[0]" // "_" - [common {"+" custom}] - ["///[1]" //// "_" - [generation - [extension {"+" Nullary Unary Binary Trinary Variadic - nullary unary binary trinary variadic}] - ["///" jvm - ["[1][0]" runtime {"+" Operation Bundle Phase Handler}] - ["[1][0]" reference] - [function - [field - [variable - ["[0]" foreign]]]]]] - [extension - ["[1][0]" bundle] - [analysis - ["/" jvm]]] - ["/[1]" // "_" - [analysis {"+" Environment}] - ["[1][0]" synthesis {"+" Synthesis Path %synthesis}] - ["[1][0]" generation] - [/// - ["[1]" phase] - [reference - ["[1][0]" variable {"+" Variable}]] - [meta - ["[0]" archive {"+" Archive}]]]]]]) + [library + [lux {"-" Type Primitive} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<t>" text] + ["<s>" synthesis {"+" Parser}]]] + [data + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" list ("[1]#[0]" monad monoid)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set {"+" Set}] + ["[0]" sequence]] + ["[0]" format "_" + ["[1]" binary]]] + [math + [number + ["[0]" i32]]] + [target + [jvm + ["[0]" version] + ["[0]" modifier ("[1]#[0]" monoid)] + ["[0]" method {"+" Method}] + ["[0]" class {"+" Class}] + [constant + [pool {"+" Resource}]] + [encoding + ["[0]" name]] + ["_" bytecode {"+" Bytecode} ("[1]#[0]" monad) + ["__" instruction {"+" Primitive_Array_Type}]] + ["[0]" type {"+" Type Typed Argument} + ["[0]" category {"+" Void Value' Value Return' Return Primitive Object Array Var Parameter}] + ["[0]" box] + ["[0]" reflection] + ["[0]" signature] + ["[0]" parser]]]]]] + ["[0]" // "_" + [common {"+" custom}] + ["///[1]" //// "_" + [generation + [extension {"+" Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic}] + ["///" jvm + ["[1][0]" runtime {"+" Operation Bundle Phase Handler}] + ["[1][0]" reference] + [function + [field + [variable + ["[0]" foreign]]]]]] + [extension + ["[1][0]" bundle] + [analysis + ["/" jvm]]] + ["/[1]" // "_" + [analysis {"+" Environment}] + ["[1][0]" synthesis {"+" Synthesis Path %synthesis}] + ["[1][0]" generation] + [/// + ["[1]" phase] + ["[1][0]" reference + ["[2][0]" variable {"+" Variable}]] + [meta + ["[0]" archive {"+" Archive} + ["[0]" artifact] + ["[0]" dependency]]]]]]]) (template [<name> <0> <1>] [(def: <name> @@ -554,7 +555,7 @@ [] (in ($_ _.composite (_.string class) - (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))])) + (_.invokestatic ..$Class "forName" (type.method [(list) (list ..$String) ..$Class (list)]))))))])) (def: object::instance? Handler @@ -566,7 +567,7 @@ (in ($_ _.composite objectG (_.instanceof (type.class class (list))) - (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))])) + (_.invokestatic ..$Boolean "valueOf" (type.method [(list) (list type.boolean) ..$Boolean (list)]))))))])) (def: reflection (All (_ category) @@ -588,7 +589,7 @@ (let [$<object> (type.class <object> (list))] ($_ _.composite valueG - (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) + (_.invokestatic $<object> "valueOf" (type.method [(list) (list <type>) $<object> (list)])))) (and (text#= <object> from) @@ -598,7 +599,7 @@ ($_ _.composite valueG (_.checkcast $<object>) - (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))] + (_.invokevirtual $<object> <unwrap> (type.method [(list) (list) <type> (list)]))))] [box.boolean type.boolean "booleanValue"] [box.byte type.byte "byteValue"] @@ -634,7 +635,7 @@ [(reflection.reflection reflection.float) type.float] [(reflection.reflection reflection.double) type.double] [(reflection.reflection reflection.char) type.char]) - (dictionary.from_list text.hash))) + (dictionary.of_list text.hash))) (def: get::static Handler @@ -718,7 +719,8 @@ valueG putG))))])) -(type: Input (Typed Synthesis)) +(type: Input + (Typed Synthesis)) (def: input (Parser Input) @@ -755,7 +757,7 @@ [inputsTG (monad.each ! (generate_input generate archive) inputsTS)] (in ($_ _.composite (monad.each _.monad product.right inputsTG) - (_.invokestatic class method (type.method [(list#each product.left inputsTG) outputT (list)])) + (_.invokestatic class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) (prepare_output outputT)))))])) (template [<name> <invoke>] @@ -771,7 +773,7 @@ objectG (_.checkcast class) (monad.each _.monad product.right inputsTG) - (<invoke> class method (type.method [(list#each product.left inputsTG) outputT (list)])) + (<invoke> class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) (prepare_output outputT)))))]))] [invoke::virtual _.invokevirtual] @@ -790,7 +792,7 @@ (_.new class) _.dup (monad.each _.monad product.right inputsTG) - (_.invokespecial class "<init>" (type.method [(list#each product.left inputsTG) type.void (list)]))))))])) + (_.invokespecial class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))))))])) (def: bundle::member Bundle @@ -875,10 +877,10 @@ (function (again body) (case body (^template [<tag>] - [(^ {<tag> value}) + [(^ <tag>) body]) - ([//////synthesis.#Primitive] - [//////synthesis.constant]) + ([{//////synthesis.#Primitive _}] + [(//////synthesis.constant _)]) (^ (//////synthesis.variant [lefts right? sub])) (//////synthesis.variant [lefts right? (again sub)]) @@ -936,7 +938,8 @@ (def: (anonymous_init_method env) (-> (Environment Synthesis) (Type category.Method)) - (type.method [(list.repeated (list.size env) ..$Object) + (type.method [(list) + (list.repeated (list.size env) ..$Object) type.void (list)])) @@ -955,7 +958,7 @@ {.#Some ($_ _.composite (_.aload 0) (monad.each _.monad product.right inputsTG) - (_.invokespecial super_class "<init>" (type.method [(list#each product.left inputsTG) type.void (list)])) + (_.invokespecial super_class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)])) store_capturedG _.return)}))) @@ -999,6 +1002,28 @@ ... (# type.equivalence = type.double returnT) _.dreturn)))) +(def: (method_dependencies archive method) + (-> Archive (/.Overriden_Method Synthesis) (Operation (Set artifact.Dependency))) + (let [[_super _name _strict_fp? _annotations + _t_vars _this _arguments _return _exceptions + bodyS] method] + (dependency.dependencies archive bodyS))) + +(def: (anonymous_dependencies archive inputsTS overriden_methods) + (-> Archive (List Input) (List [(Environment Synthesis) (/.Overriden_Method Synthesis)]) + (Operation (Set artifact.Dependency))) + (do [! //////.monad] + [all_input_dependencies (monad.each ! (|>> product.right (dependency.dependencies archive)) inputsTS) + all_closure_dependencies (|> overriden_methods + (list#each product.left) + list.together + (monad.each ! (dependency.dependencies archive))) + all_method_dependencies (monad.each ! (|>> product.right (method_dependencies archive)) overriden_methods)] + (in (dependency.all ($_ list#composite + all_input_dependencies + all_closure_dependencies + all_method_dependencies))))) + (def: class::anonymous Handler (..custom @@ -1011,7 +1036,8 @@ inputsTS overriden_methods]) (do [! //////.monad] - [[context _] (//////generation.with_new_context archive (in [])) + [all_dependencies (anonymous_dependencies archive inputsTS overriden_methods) + [context _] (//////generation.with_new_context archive all_dependencies (in [])) .let [[module_id artifact_id] context anonymous_class_name (///runtime.class_name context) class (type.class anonymous_class_name (list)) @@ -1021,14 +1047,14 @@ ... Combine them. list#conjoint ... Remove duplicates. - (set.from_list //////synthesis.hash) + (set.of_list //////synthesis.hash) set.list) global_mapping (|> total_environment ... Give them names as "foreign" variables. list.enumeration (list#each (function (_ [id capture]) [capture {//////variable.#Foreign id}])) - (dictionary.from_list //////variable.hash)) + (dictionary.of_list //////synthesis.hash)) normalized_methods (list#each (function (_ [environment [ownerT name strict_fp? annotations vars @@ -1041,7 +1067,7 @@ (|> global_mapping (dictionary.value capture) maybe.trusted)])) - (dictionary.from_list //////variable.hash))] + (dictionary.of_list //////variable.hash))] [ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT @@ -1062,7 +1088,8 @@ method.strict modifier#identity)) name - (type.method [(list#each product.right arguments) + (type.method [(list) + (list#each product.right arguments) returnT exceptionsT]) (list) @@ -1081,7 +1108,7 @@ method_definitions) (sequence.sequence))) _ (//////generation.execute! [anonymous_class_name bytecode]) - _ (//////generation.save! (%.nat artifact_id) [anonymous_class_name bytecode])] + _ (//////generation.save! artifact_id {.#None} [anonymous_class_name bytecode])] (anonymous_instance generate archive class total_environment)))])) (def: bundle::class diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index 9be2267ea..0d2774331 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -1,39 +1,40 @@ (.using - [library - [lux {"-" Type if let case int} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" function]] - [data - [number - ["[0]" i32] - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" mix)]]] - [target - [jvm - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] - ["[0]" type {"+" Type} - [category {"+" Method}]]]]]] - ["[0]" // "_" - ["[1][0]" type] - ["[1][0]" runtime {"+" Operation Phase Generator}] - ["[1][0]" value] - ["[1][0]" structure] - [//// - ["[0]" synthesis {"+" Path Synthesis}] - ["[0]" generation] - [/// - ["[0]" phase ("operation#[0]" monad)] - [reference - [variable {"+" Register}]]]]]) + [library + [lux {"-" Type Label if let case int} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" function]] + [data + [collection + ["[0]" list ("[1]#[0]" mix)]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [target + [jvm + ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] + ["[0]" type {"+" Type} + [category {"+" Method}]]]]]] + ["[0]" // "_" + ["[1][0]" type] + ["[1][0]" runtime {"+" Operation Phase Generator}] + ["[1][0]" value] + ["[1][0]" structure] + [//// + ["[0]" synthesis {"+" Path Synthesis}] + ["[0]" generation] + [/// + ["[0]" phase ("operation#[0]" monad)] + [reference + [variable {"+" Register}]]]]]) (def: equals_name "equals") (def: equals_type - (type.method [(list //type.value) type.boolean (list)])) + (type.method [(list) (list //type.value) type.boolean (list)])) (def: (pop_alt stack_depth) (-> Nat (Bytecode Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index b9d62421b..fd110c5d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -1,62 +1,65 @@ (.using - [library - [lux {"-" Type} - [abstract - ["[0]" monad {"+" do}]] - [data - [number - ["[0]" i32] - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" monoid functor)] - ["[0]" sequence]] - ["[0]" format "_" - ["[1]" binary]]] - [target - [jvm - ["[0]" version] - ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] - ["[0]" field {"+" Field}] - ["[0]" method {"+" Method}] - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] - ["[0]" class {"+" Class}] - ["[0]" type {"+" Type} - [category {"+" Return' Value'}] - ["[0]" reflection]] - ["[0]" constant - [pool {"+" Resource}]] - [encoding - ["[0]" name {"+" External Internal}] - ["[0]" unsigned]]]] - [tool - [compiler - [meta - ["[0]" archive {"+" Archive}]]]]]] - ["[0]" / "_" - ["[1][0]" abstract] - [field - [constant - ["[1][0]" arity]] - [variable - ["[1][0]" foreign] - ["[1][0]" partial]]] - [method - ["[1][0]" init] - ["[1][0]" new] - ["[1][0]" implementation] - ["[1][0]" reset] - ["[1][0]" apply]] - ["/[1]" // "_" - ["[1][0]" runtime {"+" Operation Phase Generator}] - [//// - [analysis {"+" Environment}] - [synthesis {"+" Synthesis Abstraction Apply}] - ["[0]" generation] - [/// - ["[0]" arity {"+" Arity}] - ["[0]" phase] - [reference - [variable {"+" Register}]]]]]]) + [library + [lux {"-" Type Label} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" monoid functor)] + ["[0]" sequence]] + ["[0]" format "_" + ["[1]" binary]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [target + [jvm + ["[0]" version] + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] + ["[0]" field {"+" Field}] + ["[0]" method {"+" Method}] + ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] + ["[0]" class {"+" Class}] + ["[0]" type {"+" Type} + [category {"+" Return' Value'}] + ["[0]" reflection]] + ["[0]" constant + [pool {"+" Resource}]] + [encoding + ["[0]" name {"+" External Internal}] + ["[0]" unsigned]]]] + [tool + [compiler + [meta + ["[0]" archive {"+" Archive} + ["[0]" dependency]]]]]]] + ["[0]" / "_" + ["[1][0]" abstract] + [field + [constant + ["[1][0]" arity]] + [variable + ["[1][0]" foreign] + ["[1][0]" partial]]] + [method + ["[1][0]" init] + ["[1][0]" new] + ["[1][0]" implementation] + ["[1][0]" reset] + ["[1][0]" apply]] + ["/[1]" // "_" + ["[1][0]" runtime {"+" Operation Phase Generator}] + [//// + [analysis {"+" Environment}] + [synthesis {"+" Synthesis Abstraction Apply}] + ["[0]" generation] + [/// + ["[0]" arity {"+" Arity}] + ["[0]" phase] + [reference + [variable {"+" Register}]]]]]]) (def: .public (with generate archive @begin class environment arity body) (-> Phase Archive Label External (Environment Synthesis) Arity (Bytecode Any) @@ -98,8 +101,9 @@ (def: .public (abstraction generate archive [environment arity bodyS]) (Generator Abstraction) (do phase.monad - [@begin //runtime.forge_label - [function_context bodyG] (generation.with_new_context archive + [dependencies (dependency.dependencies archive bodyS) + @begin //runtime.forge_label + [function_context bodyG] (generation.with_new_context archive dependencies (generation.with_anchor [@begin ..this_offset] (generate archive bodyS))) .let [function_class (//runtime.class_name function_context)] @@ -111,9 +115,9 @@ fields methods (sequence.sequence))) - .let [bytecode (format.result class.writer class)] - _ (generation.execute! [function_class bytecode]) - _ (generation.save! function_class {.#None} [function_class bytecode])] + .let [bytecode [function_class (format.result class.writer class)]] + _ (generation.execute! bytecode) + _ (generation.save! (product.right function_context) {.#None} bytecode)] (in instance))) (def: .public (apply generate archive [abstractionS inputsS]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index cca523398..a0880a4e2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -1,33 +1,33 @@ (.using - [library - [lux {"-" Type} - [abstract - ["[0]" monad]] - [data - [number - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [target - [jvm - ["[0]" field {"+" Field}] - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] - [type {"+" Type} - [category {"+" Class}]] - [constant - [pool {"+" Resource}]]]]]] - ["[0]" / "_" - ["[1][0]" count] - ["/[1]" // - ["/[1]" // "_" + [library + [lux {"-" Type} + [abstract + ["[0]" monad]] + [data + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + [number + ["n" nat]]] + [target + [jvm + ["[0]" field {"+" Field}] + ["_" bytecode {"+" Bytecode} ("[1]#[0]" monad)] + [type {"+" Type} + [category {"+" Class}]] [constant - ["[1][0]" arity]] - ["//[1]" /// "_" - ["[1][0]" reference] - [////// - ["[0]" arity {"+" Arity}] - [reference - [variable {"+" Register}]]]]]]]) + [pool {"+" Resource}]]]]]] + ["[0]" // + ["[1][0]" count] + ["/[1]" // "_" + [constant + ["[1][0]" arity]] + ["//[1]" /// "_" + ["[1][0]" reference] + [////// + ["[0]" arity {"+" Arity}] + [reference + [variable {"+" Register}]]]]]]) (def: .public (initial amount) (-> Nat (Bytecode Any)) @@ -53,6 +53,6 @@ (-> Arity (Bytecode Any)) (if (arity.multiary? arity) ($_ _.composite - /count.initial + //count.initial (initial (n.- ///arity.minimum arity))) (_#in []))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index 094287f9a..050ca318a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -1,51 +1,52 @@ (.using - [library - [lux {"-" Type type} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" try]] - [data - [number - ["n" nat] - ["i" int] - ["[0]" i32]] - [collection - ["[0]" list ("[1]#[0]" monoid functor)]]] - [target - [jvm - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] - ["[0]" method {"+" Method}] - [constant - [pool {"+" Resource}]] - [encoding - ["[0]" signed]] - ["[0]" type {"+" Type} - ["[0]" category {"+" Class}]]]]]] - ["[0]" // - ["[1][0]" reset] - ["[1][0]" implementation] - ["[1][0]" init] - ["/[1]" // "_" - ["[1][0]" abstract] - [field + [library + [lux {"-" Type Label type} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list ("[1]#[0]" monoid functor)]]] + [math + [number + ["n" nat] + ["i" int] + ["[0]" i32]]] + [target + [jvm + ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)] + ["[0]" method {"+" Method}] [constant - ["[1][0]" arity]] - [variable - ["[1][0]" partial - ["[1]/[0]" count]] - ["[1][0]" foreign]]] - ["/[1]" // "_" - ["[1][0]" runtime] - ["[1][0]" value] - ["[1][0]" reference] - [//// - [analysis {"+" Environment}] - [synthesis {"+" Synthesis}] - [/// - [arity {"+" Arity}] - [reference - [variable {"+" Register}]]]]]]]) + [pool {"+" Resource}]] + [encoding + ["[0]" signed]] + ["[0]" type {"+" Type} + ["[0]" category {"+" Class}]]]]]] + ["[0]" // + ["[1][0]" reset] + ["[1][0]" implementation] + ["[1][0]" init] + ["/[1]" // "_" + ["[1][0]" abstract] + [field + [constant + ["[1][0]" arity]] + [variable + ["[1][0]" partial] + ["[1][0]" count] + ["[1][0]" foreign]]] + ["/[1]" // "_" + ["[1][0]" runtime] + ["[1][0]" value] + ["[1][0]" reference] + [//// + [analysis {"+" Environment}] + [synthesis {"+" Synthesis}] + [/// + [arity {"+" Arity}] + [reference + [variable {"+" Register}]]]]]]]) (def: (increment by) (-> Nat (Bytecode Any)) @@ -143,7 +144,7 @@ (_.new class) _.dup current_environment - ///partial/count.value + ///count.value (..increment apply_arity) current_partials (..inputs ..this_offset apply_arity) @@ -152,6 +153,6 @@ _.areturn))))))) (monad.all _.monad))]] ($_ _.composite - ///partial/count.value + ///count.value (_.tableswitch (try.trusted (signed.s4 +0)) @default [@labelsH @labelsT]) cases)))}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index 11e2013e2..664e0fbc8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -1,28 +1,29 @@ (.using - [library - [lux {"-" Type type} - [data - [collection - ["[0]" list]]] - [target - [jvm - ["[0]" method {"+" Method}] - ["_" bytecode {"+" Label Bytecode}] - [constant - [pool {"+" Resource}]] - ["[0]" type {"+" Type} - ["[0]" category]]]]]] - ["[0]" // - ["//[1]" /// "_" - ["[1][0]" type] - [////// - [arity {"+" Arity}]]]]) + [library + [lux {"-" Type Label type} + [data + [collection + ["[0]" list]]] + [target + [jvm + ["[0]" method {"+" Method}] + ["_" bytecode {"+" Label Bytecode}] + [constant + [pool {"+" Resource}]] + ["[0]" type {"+" Type} + ["[0]" category]]]]]] + ["[0]" // + ["//[1]" /// "_" + ["[1][0]" type] + [////// + [arity {"+" Arity}]]]]) (def: .public name "impl") (def: .public (type arity) (-> Arity (Type category.Method)) - (type.method [(list.repeated arity ////type.value) + (type.method [(list) + (list.repeated arity ////type.value) ////type.value (list)])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux index a4559bbd0..37278725b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux @@ -1,45 +1,46 @@ (.using - [library - [lux {"-" Type type} - [abstract - ["[0]" monad]] - [control - ["[0]" try]] - [data - [number - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" monoid functor)]]] - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" method {"+" Method}] - [encoding - ["[0]" unsigned]] - [constant - [pool {"+" Resource}]] - ["[0]" type {"+" Type} - ["[0]" category {"+" Class Value}]]]]]] - ["[0]" // - ["[1][0]" implementation] - ["/[1]" // "_" - ["[1][0]" abstract] - [field + [library + [lux {"-" Type type} + [abstract + ["[0]" monad]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list ("[1]#[0]" monoid functor)]]] + [math + [number + ["n" nat]]] + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" method {"+" Method}] + [encoding + ["[0]" signed]] [constant - ["[1][0]" arity]] - [variable - ["[1][0]" foreign] - ["[1][0]" partial]]] - ["/[1]" // "_" - ["[1][0]" type] - ["[1][0]" reference] - [//// - [analysis {"+" Environment}] - [synthesis {"+" Synthesis}] - [/// - ["[0]" arity {"+" Arity}] - [reference - [variable {"+" Register}]]]]]]]) + [pool {"+" Resource}]] + ["[0]" type {"+" Type} + ["[0]" category {"+" Class Value}]]]]]] + ["[0]" // + ["[1][0]" implementation] + ["/[1]" // "_" + ["[1][0]" abstract] + [field + [constant + ["[1][0]" arity]] + [variable + ["[1][0]" foreign] + ["[1][0]" partial]]] + ["/[1]" // "_" + ["[1][0]" type] + ["[1][0]" reference] + [//// + [analysis {"+" Environment}] + [synthesis {"+" Synthesis}] + [/// + ["[0]" arity {"+" Arity}] + [reference + [variable {"+" Register}]]]]]]]) (def: .public name "<init>") @@ -49,7 +50,8 @@ (def: .public (type environment arity) (-> (Environment Synthesis) Arity (Type category.Method)) - (type.method [(list#composite (///foreign.closure environment) + (type.method [(list) + (list#composite (///foreign.closure environment) (if (arity.multiary? arity) (list& ///arity.type (..partials arity)) (list))) @@ -57,8 +59,8 @@ (list)])) (def: no_partials - (|> 0 - unsigned.u1 + (|> +0 + signed.s1 try.trusted _.bipush)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index 5c059f5a7..5c03b472b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -1,46 +1,47 @@ (.using - [library - [lux {"-" Type type} - [abstract - ["[0]" monad {"+" do}]] - [data - [number - ["n" nat]] - [collection - ["[0]" list]]] - [target - [jvm - ["[0]" field {"+" Field}] - ["[0]" method {"+" Method}] - ["_" bytecode {"+" Bytecode}] - ["[0]" constant - [pool {"+" Resource}]] - [type {"+" Type} - ["[0]" category {"+" Class Value Return}]]]] - [tool - [compiler - [meta - ["[0]" archive {"+" Archive}]]]]]] - ["[0]" // - ["[1][0]" init] - ["[1][0]" implementation] + [library + [lux {"-" Type type} + [abstract + ["[0]" monad {"+" do}]] + [data + [collection + ["[0]" list]]] + [math + [number + ["n" nat]]] + [target + [jvm + ["[0]" field {"+" Field}] + ["[0]" method {"+" Method}] + ["_" bytecode {"+" Bytecode}] + ["[0]" constant + [pool {"+" Resource}]] + [type {"+" Type} + ["[0]" category {"+" Class Value Return}]]]] + [tool + [compiler + [meta + ["[0]" archive {"+" Archive}]]]]]] + ["[0]" // + ["[1][0]" init] + ["[1][0]" implementation] + ["/[1]" // "_" + [field + [constant + ["[1][0]" arity]] + [variable + ["[1][0]" foreign] + ["[1][0]" partial]]] ["/[1]" // "_" - [field - [constant - ["[1][0]" arity]] - [variable - ["[1][0]" foreign] - ["[1][0]" partial]]] - ["/[1]" // "_" - [runtime {"+" Operation Phase}] - ["[1][0]" value] - ["[1][0]" reference] - [//// - [analysis {"+" Environment}] - [synthesis {"+" Synthesis}] - [/// - ["[0]" arity {"+" Arity}] - ["[0]" phase]]]]]]) + [runtime {"+" Operation Phase}] + ["[1][0]" value] + ["[1][0]" reference] + [//// + [analysis {"+" Environment}] + [synthesis {"+" Synthesis}] + [/// + ["[0]" arity {"+" Arity}] + ["[0]" phase]]]]]]) (def: .public (instance' foreign_setup class environment arity) (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index 112f1b0fc..d1a78ce86 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -30,7 +30,7 @@ (def: .public (type class) (-> (Type Class) (Type category.Method)) - (type.method [(list) class (list)])) + (type.method [(list) (list) class (list)])) (def: (current_environment class) (-> (Type Class) (Environment Synthesis) (List (Bytecode Any))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index 60c42160b..60f6c3b2a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -1,29 +1,30 @@ (.using - [library - [lux "*" - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" function]] - [data - ["[0]" product] - [number - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [target - [jvm - ["_" bytecode {"+" Label Bytecode} ("[1]#[0]" monad)]]]]] - ["[0]" // "_" - ["[1][0]" runtime {"+" Operation Phase Generator}] - ["[1][0]" value] - [//// - ["[0]" synthesis {"+" Path Synthesis}] - ["[0]" generation] - [/// - ["[0]" phase] - [reference - [variable {"+" Register}]]]]]) + [library + [lux "*" + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" function]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + [number + ["n" nat]]] + [target + [jvm + ["_" bytecode {"+" Bytecode} ("[1]#[0]" monad)]]]]] + ["[0]" // "_" + ["[1][0]" runtime {"+" Operation Phase Generator}] + ["[1][0]" value] + [//// + ["[0]" synthesis {"+" Path Synthesis}] + ["[0]" generation] + [/// + ["[0]" phase] + [reference + [variable {"+" Register}]]]]]) (def: (invariant? register changeS) (-> Register Synthesis Bit) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux index 12bddd14d..44200c2d2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -1,17 +1,22 @@ (.using - [library - [lux {"-" i64} - ["[0]" ffi {"+" import:}] - [abstract - [monad {"+" do}]] - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" type] - [encoding - ["[0]" signed]]]]]] - ["[0]" // "_" - ["[1][0]" runtime]]) + [library + [lux {"-" i64} + ["[0]" ffi {"+" import:}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try]] + [math + [number + ["i" int]]] + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" type] + [encoding + ["[0]" signed]]]]]] + ["[0]" // "_" + ["[1][0]" runtime]]) (def: $Boolean (type.class "java.lang.Boolean" (list))) (def: $Long (type.class "java.lang.Long" (list))) @@ -22,7 +27,7 @@ (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) (def: wrap_i64 - (_.invokestatic $Long "valueOf" (type.method [(list type.long) $Long (list)]))) + (_.invokestatic $Long "valueOf" (type.method [(list) (list type.long) $Long (list)]))) (def: .public (i64 value) (-> (I64 Any) (Bytecode Any)) @@ -71,10 +76,15 @@ ..wrap_i64))))) (def: wrap_f64 - (_.invokestatic $Double "valueOf" (type.method [(list type.double) $Double (list)]))) + (_.invokestatic $Double "valueOf" (type.method [(list) (list type.double) $Double (list)]))) (import: java/lang/Double - ("static" doubleToRawLongBits "manual" [double] int)) + ["[1]::[0]" + ("static" doubleToRawLongBits "manual" [double] int)]) + +(def: d0_bits + Int + (java/lang/Double::doubleToRawLongBits +0.0)) (def: .public (f64 value) (-> Frac (Bytecode Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index f06e89e38..0f0012727 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -1,39 +1,42 @@ (.using - [library - [lux "*" - [abstract - ["[0]" monad {"+" do}]] - [data - [number - ["[0]" i32]] - [collection - ["[0]" list]]] - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" type] - [encoding - ["[0]" signed]]]]]] - ["[0]" // "_" - ["[1][0]" runtime {"+" Operation Phase Generator}] - ["[1][0]" primitive] - ["///[1]" //// "_" - [analysis {"+" Variant Tuple}] - ["[1][0]" synthesis {"+" Synthesis}] - [/// - ["[0]" phase]]]]) + [library + [lux {"-" Variant Tuple} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list]]] + [math + [number + ["[0]" i32]]] + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" type] + [encoding + ["[0]" signed]]]]]] + ["[0]" // "_" + ["[1][0]" runtime {"+" Operation Phase Generator}] + ["[1][0]" primitive] + ["///[1]" //// "_" + [analysis {"+" Variant Tuple}] + ["[1][0]" synthesis {"+" Synthesis}] + [/// + ["[0]" phase]]]]) (def: $Object (type.class "java.lang.Object" (list))) -(def: .public (tuple generate archive membersS) +(def: .public (tuple phase archive membersS) (Generator (Tuple Synthesis)) (case membersS {.#End} (# phase.monad in //runtime.unit) {.#Item singletonS {.#End}} - (generate archive singletonS) + (phase archive singletonS) _ (do [! phase.monad] @@ -41,7 +44,7 @@ list.enumeration (monad.each ! (function (_ [idx member]) (do ! - [memberI (generate archive member)] + [memberI (phase archive member)] (in (do _.monad [_ _.dup _ (_.int (.i64 idx)) @@ -81,15 +84,16 @@ //runtime.right_flag //runtime.left_flag)) -(def: .public (variant generate archive [lefts right? valueS]) +(def: .public (variant phase archive [lefts right? valueS]) (Generator (Variant Synthesis)) (do phase.monad - [valueI (generate archive valueS)] + [valueI (phase archive valueS)] (in (do _.monad [_ (..tag lefts right?) _ (..flag right?) _ valueI] (_.invokestatic //runtime.class "variant" - (type.method [(list type.int $Object $Object) + (type.method [(list) + (list type.int $Object $Object) (type.array $Object) (list)])))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/version.lux b/stdlib/source/library/lux/tool/compiler/language/lux/version.lux index c9ffff258..25f68450d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/version.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/version.lux @@ -6,4 +6,4 @@ (def: .public version Version - 00,06,05) + 00,07,00) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 7026c0a48..c200a0316 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,72 +1,71 @@ -(.with_expansions [<target>' (.for ["{old}" (.as_is ["[1]/[0]" jvm]) - "JVM" (.as_is ["[1]/[0]" jvm])] - (.as_is)) - <target> <target>'] - (.using - [library - ["/" lux "*" - [program {"+" program:}] - ["_" test {"+" Test}] - ["@" target] - [abstract - [monad {"+" do}]] - [control - ["[0]" io] - ["[0]" maybe ("[1]#[0]" functor)] - [concurrency - ["[0]" atom {"+" Atom}]] - [parser - ["<[0]>" code]]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" set {"+" Set} ("[1]#[0]" equivalence)] - [dictionary - ["[0]" plist]]]] - ["[0]" macro - [syntax {"+" syntax:}] - ["[0]" code ("[1]#[0]" equivalence)] - ["[0]" template]] - ["[0]" math - ["[0]" random ("[1]#[0]" functor)] - [number - [i8 {"+"}] - [i16 {"+"}] - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac] - ["[0]" i64]]] - ["[0]" meta - ["[0]" location ("[1]#[0]" equivalence)]]]] - ... TODO: Must have 100% coverage on tests. - ["[0]" / "_" - ["[1][0]" abstract] - ["[1][0]" control] - ["[1][0]" data] - ["[1][0]" debug] - ["[1][0]" documentation] - ["[1][0]" locale] - ["[1][0]" macro - ["[1]/[0]" code]] - ["[1][0]" math] - ["[1][0]" meta] - ["[1][0]" program] - ["[1][0]" static] - ["[1][0]" target] - ["[1][0]" test] - ["[1][0]" time] - ... ["[1][0]" tool] ... TODO: Update & expand tests for this - ["[1][0]" type] - ["[1][0]" world] - ["[1][0]" ffi] - ["[1][0]" extension] - ["[1][0]" target "_" - <target>]])) +(.`` (.`` (.using + [library + ["/" lux "*" + [program {"+" program:}] + ["_" test {"+" Test}] + ["@" target] + [abstract + [monad {"+" do}]] + [control + ["[0]" io] + ["[0]" maybe ("[1]#[0]" functor)] + [concurrency + ["[0]" atom {"+" Atom}]] + [parser + ["<[0]>" code]]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" set {"+" Set} ("[1]#[0]" equivalence)] + [dictionary + ["[0]" plist]]]] + ["[0]" macro + [syntax {"+" syntax:}] + ["[0]" code ("[1]#[0]" equivalence)] + ["[0]" template]] + ["[0]" math + ["[0]" random ("[1]#[0]" functor)] + [number + [i8 {"+"}] + [i16 {"+"}] + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac] + ["[0]" i64]]] + ["[0]" meta + ["[0]" location ("[1]#[0]" equivalence)]]]] + ... TODO: Must have 100% coverage on tests. + ["[0]" / "_" + ["[1][0]" abstract] + ["[1][0]" control] + ["[1][0]" data] + ["[1][0]" debug] + ["[1][0]" documentation] + ["[1][0]" locale] + ["[1][0]" macro + ["[1]/[0]" code]] + ["[1][0]" math] + ["[1][0]" meta] + ["[1][0]" program] + ["[1][0]" static] + ["[1][0]" target] + ["[1][0]" test] + ["[1][0]" time] + ... ["[1][0]" tool] ... TODO: Update & expand tests for this + ["[1][0]" type] + ["[1][0]" world] + ["[1][0]" ffi] + ["[1][0]" extension] + ["[1][0]" target "_" + (~~ (.for ["{old}" (~~ (.as_is ["[1]/[0]" jvm])) + "JVM" (~~ (.as_is ["[1]/[0]" jvm])) + "JavaScript" (~~ (.as_is ["[1]/[0]" js]))] + (~~ (.as_is))))]]))) ... TODO: Get rid of this ASAP (template: (!bundle body) @@ -79,7 +78,8 @@ Test (with_expansions [... TODO: Update & expand tests for this <target> (for [@.jvm (~~ (as_is /target/jvm.test)) - @.old (~~ (as_is /target/jvm.test))] + @.old (~~ (as_is /target/jvm.test)) + @.js (~~ (as_is /target/js.test))] (~~ (as_is))) <extension> (for [@.old (~~ (as_is))] (~~ (as_is /extension.test)))] @@ -865,12 +865,11 @@ (hide left)) true))))) (_.cover [/.same?] - (let [not_left (|> left ++ -- %.nat) - left (%.nat left)] - (and (and (/.same? left left) - (/.same? not_left not_left)) - (and (text#= left not_left) - (not (/.same? left not_left)))))) + (let [not_left (atom.atom left) + left (atom.atom left)] + (and (/.same? left left) + (/.same? not_left not_left) + (not (/.same? left not_left))))) (_.cover [/.Rec] (let [list (: (/.Rec NList (Maybe [Nat NList])) diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index d67d0d853..394c34c15 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" interval] - ["$[0]" monoid] - ["$[0]" codec]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" / - [// - ["n" nat] - ["f" frac] - ["[0]" i64]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" interval] + ["$[0]" monoid] + ["$[0]" codec]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" / + [// + ["n" nat] + ["f" frac] + ["[0]" i64]]]]) (def: signature Test @@ -193,7 +193,8 @@ (/.= pattern (/.right_shifted i64.width pattern)) sign_mask (i64.left_shifted (-- i64.width) 1) - mantissa_mask (i64.not sign_mask) + mantissa_mask (-- (i64.left_shifted (n.- idx i64.width) 1)) + co_mantissa_mask (i64.not mantissa_mask) sign_preservation! (/.= (i64.and sign_mask pattern) @@ -201,11 +202,21 @@ mantissa_parity! (/.= (i64.and mantissa_mask (i64.right_shifted idx pattern)) - (i64.and mantissa_mask (/.right_shifted idx pattern)))] + (i64.and mantissa_mask (/.right_shifted idx pattern))) + + co_mantissa_disparity! + (or (n.= 0 idx) + (and (/.= +0 (i64.and co_mantissa_mask (i64.right_shifted idx pattern))) + (/.= (if (/.< +0 pattern) + (.int co_mantissa_mask) + +0) + (i64.and co_mantissa_mask (/.right_shifted idx pattern)))))] (and nullity! idempotency! sign_preservation! - mantissa_parity!)))) + mantissa_parity! + co_mantissa_disparity! + )))) ..predicate ..signature diff --git a/stdlib/source/test/lux/target/js.lux b/stdlib/source/test/lux/target/js.lux new file mode 100644 index 000000000..cc60dd896 --- /dev/null +++ b/stdlib/source/test/lux/target/js.lux @@ -0,0 +1,845 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" static] + [abstract + [monad {"+" do}] + ["[0]" predicate]] + [control + [pipe {"+" case>}] + ["[0]" function] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try {"+" Try} ("[1]#[0]" functor)]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text {"+" \n} ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [macro + ["[0]" template]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat] + ["i" int] + ["f" frac] + ["[0]" i64]]]]] + [\\library + ["[0]" /]]) + +(def: (eval code) + (-> /.Expression (Try (Maybe Any))) + ... Note: I have to call "eval" this way + ... in order to avoid a quirk of calling eval in Node + ... when the code is running under "use strict";. + (try (let [return ("js apply" (function.identity ("js constant" "eval")) (/.code code))] + (if ("js object null?" return) + {.#None} + {.#Some return})))) + +(def: (expression ??? it) + (-> (-> Any Bit) /.Expression Bit) + (|> it + ..eval + (try#each (|>> (maybe#each ???) + (maybe.else false))) + (try.else false))) + +(template [<range>] + [(`` (def: (~~ (template.symbol ["as_int/" <range>])) + (-> Int Int) + (|>> (i64.and (static.nat (-- (i64.left_shifted <range> 1))))))) + (`` (def: (~~ (template.symbol ["int/" <range>])) + (Random Int) + (do [! random.monad] + [negative? random.bit + mantissa (# ! each (|>> (i64.and (static.nat (-- (i64.left_shifted (-- <range>) 1)))) + .int) + random.nat)] + (in (if negative? + (i.* -1 mantissa) + mantissa)))))] + + [16] + [32] + ) + +(def: test|literal + Test + (do [! random.monad] + [boolean random.bit + number random.frac + int ..int/32 + string (random.ascii/upper 5)] + ($_ _.and + (_.cover [/.null] + (|> /.null + ..eval + (try#each (function (_ it) + (case it + {.#None} true + {.#Some _} true))) + (try.else false))) + (_.cover [/.boolean] + (expression (|>> (:as Bit) (bit#= boolean)) + (/.boolean boolean))) + (_.cover [/.number] + (expression (|>> (:as Frac) (f.= number)) + (/.number number))) + (_.cover [/.int] + (expression (|>> (:as Frac) f.int (i.= int)) + (/.int int))) + (_.cover [/.string] + (expression (|>> (:as Text) (text#= string)) + (/.string string))) + ))) + +(def: test|boolean + Test + (do [! random.monad] + [left random.bit + right random.bit] + (`` ($_ _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> left right)] + (expression (|>> (:as Bit) (bit#= expected)) + (<js> (/.boolean left) (/.boolean right)))))] + + [/.or .or] + [/.and .and] + )) + (_.cover [/.not] + (expression (|>> (:as Bit) (bit#= (not left))) + (/.not (/.boolean left)))) + )))) + +(def: test|number + Test + (do [! random.monad] + [parameter (random.only (|>> (f.= +0.0) not) + random.safe_frac) + subject random.safe_frac] + (`` ($_ _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (:as Frac) (f.= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.+ f.+] + [/.- f.-] + [/.* f.*] + [/./ f./] + [/.% f.%] + )) + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (:as Bit) (bit#= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) + +(def: test|i32 + Test + (do [! random.monad] + [left ..int/32 + right ..int/32 + + i32 ..int/32 + i16 ..int/16 + shift (# ! each (n.% 16) random.nat)] + (`` ($_ _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> left right)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (<js> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.cover [/.opposite] + (expression (|>> (:as Frac) f.int (i.= (i.* -1 i32))) + (/.opposite (/.i32 i32)))) + + (_.cover [/.i32] + (expression (|>> (:as Frac) f.int (i.= i32)) + (/.i32 i32))) + (_.cover [/.to_i32] + (expression (|>> (:as Frac) f.int (i.= i32)) + (/.to_i32 (/.int i32)))) + (_.cover [/.left_shift] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.left_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.logic_right_shift] + (let [expected (i64.right_shifted shift (as_int/32 i16))] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.logic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.arithmetic_right_shift] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.arithmetic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.bit_not] + (let [expected (if (i.< +0 i32) + (as_int/32 (i64.not i32)) + (i64.not (as_int/32 i32)))] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.bit_not (/.i32 i32))))) + )))) + +(def: test|array + Test + (do [! random.monad] + [size (# ! each (|>> (n.% 10) ++) random.nat) + index (# ! each (n.% size) random.nat) + items (random.list size random.safe_frac) + .let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))]] + ($_ _.and + (_.cover [/.array /.at] + (and (expression (|>> (:as Frac) (f.= expected)) + (/.at (/.int (.int index)) + (/.array (list#each /.number items)))) + (expression (|>> (:as Bit)) + (|> (/.array (list#each /.number items)) + (/.at (/.int (.int size))) + (/.= /.undefined))))) + ))) + +(def: test|object + Test + (do [! random.monad] + [expected random.safe_frac + field (random.ascii/upper 5) + dummy (random.only (|>> (text#= field) not) + (random.ascii/upper 5)) + + size (# ! each (|>> (n.% 10) ++) random.nat) + index (# ! each (n.% size) random.nat) + items (random.list size random.safe_frac)] + ($_ _.and + (_.cover [/.object /.the] + (expression (|>> (:as Frac) (f.= expected)) + (/.the field (/.object (list [field (/.number expected)]))))) + (let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + (_.cover [/.do] + (expression (|>> (:as Frac) f.int (i.= (.int index))) + (|> (/.array (list#each /.number items)) + (/.do "lastIndexOf" (list (/.number expected))))))) + (_.cover [/.undefined] + (expression (|>> (:as Bit)) + (|> (/.object (list [field (/.number expected)])) + (/.the dummy) + (/.= /.undefined)))) + ))) + +(def: test|computation + Test + (do [! random.monad] + [test random.bit + then random.safe_frac + else random.safe_frac + + boolean random.bit + number random.frac + string (random.ascii/upper 5) + + comment (random.ascii/upper 10)] + ($_ _.and + ..test|boolean + ..test|number + ..test|i32 + ..test|array + ..test|object + (_.cover [/.?] + (let [expected (if test then else)] + (expression (|>> (:as Frac) (f.= expected)) + (/.? (/.boolean test) + (/.number then) + (/.number else))))) + (_.cover [/.not_a_number?] + (and (expression (|>> (:as Bit)) + (/.not_a_number? (/.number f.not_a_number))) + (expression (|>> (:as Bit) not) + (/.not_a_number? (/.number then))))) + (_.cover [/.type_of] + (and (expression (|>> (:as Text) (text#= "boolean")) + (/.type_of (/.boolean boolean))) + (expression (|>> (:as Text) (text#= "number")) + (/.type_of (/.number number))) + (expression (|>> (:as Text) (text#= "string")) + (/.type_of (/.string string))) + (expression (|>> (:as Text) (text#= "object")) + (/.type_of /.null)) + (expression (|>> (:as Text) (text#= "object")) + (/.type_of (/.object (list [string (/.number number)])))) + (expression (|>> (:as Text) (text#= "object")) + (/.type_of (/.array (list (/.boolean boolean) + (/.number number) + (/.string string))))) + (expression (|>> (:as Text) (text#= "undefined")) + (/.type_of /.undefined)))) + (_.cover [/.comment] + (expression (|>> (:as Frac) (f.= then)) + (/.comment comment + (/.number 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) + (_.cover [/.,] + (expression (|>> (:as Frac) (f.= expected)) + (/., (/.number dummy) (/.number expected)))) + )))) + +(def: test/var + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + foreign (random.ascii/lower 10) + local (random.only (|>> (text#= foreign) not) + (random.ascii/lower 10)) + .let [$foreign (/.var foreign) + $local (/.var local)]] + ($_ _.and + (_.cover [/.var] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/* (/.closure (list $foreign) (/.return $foreign)) + (list (/.number number/0))))) + (_.cover [/.define] + (expression (|>> (:as Frac) (f.= number/1)) + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.define $local (/.number number/1)) + (/.return $local))) + (list (/.number number/0))))) + (_.cover [/.declare] + (expression (|>> (:as Frac) (f.= number/1)) + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.declare $local) + (/.set $local (/.number number/1)) + (/.return $local))) + (list (/.number number/0))))) + ))) + +(def: test/location + Test + (do [! random.monad] + [number/0 random.safe_frac + int/0 ..int/16 + $foreign (# ! each /.var (random.ascii/lower 10)) + field (random.ascii/upper 10)] + ($_ _.and + (_.cover [/.set] + (and (expression (|>> (:as Frac) (f.= (f.+ number/0 number/0))) + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.+ $foreign $foreign)) + (/.return $foreign))) + (list (/.number number/0)))) + (expression (|>> (:as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.array (list $foreign))) + (/.set @ (/.+ @ @)) + (/.return @))) + (list (/.number number/0))))) + (expression (|>> (:as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.the field $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.set @ (/.+ @ @)) + (/.return @))) + (list (/.number number/0))))))) + (_.cover [/.delete] + (and (and (expression (|>> (:as Bit)) + (/.apply/* (/.closure (list) + ($_ /.then + (/.set $foreign (/.number number/0)) + (/.return (/.delete $foreign)))) + (list))) + (expression (|>> (:as Bit) not) + (/.apply/* (/.closure (list $foreign) + (/.return (/.delete $foreign))) + (list (/.number number/0))))) + (expression (|>> (:as Bit)) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.array (list $foreign))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + (expression (|>> (:as Bit)) + (let [@ (/.the field $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + )) + (_.cover [/.Access] + (`` (and (~~ (template [<js> <lux>] + [(expression (|>> (:as Frac) f.int (i.= (<lux> int/0))) + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.statement (<js> $foreign)) + (/.return $foreign))) + (list (/.int int/0)))) + (expression (|>> (:as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.array (list $foreign))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0))))) + (expression (|>> (:as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.the field $foreign)] + (/.apply/* (/.closure (list $foreign) + ($_ /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0)))))] + + [/.++ .++] + [/.-- .--] + ))))) + (_.for [/.Var] + ..test/var) + ))) + +(def: test|label + Test + (do [! random.monad] + [input ..int/16 + + full_inner_iterations (# ! each (|>> (n.% 20) ++) random.nat) + expected_inner_iterations (# ! each (n.% full_inner_iterations) random.nat) + + @outer (# ! each /.label (random.ascii/upper 5)) + full_outer_iterations (# ! each (|>> (n.% 10) ++) random.nat) + expected_outer_iterations (# ! each (n.% full_outer_iterations) random.nat) + + .let [$input (/.var "input") + $output (/.var "output") + $inner_index (/.var "inner_index") + $outer_index (/.var "outer_index")]] + ($_ _.and + (_.cover [/.break] + (let [expected (i.* (.int expected_inner_iterations) input)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + ($_ /.then + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set $output (/.+ $input $output)) + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + )) + (/.return $output))) + (list (/.int input)))))) + (_.cover [/.continue] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + ($_ /.then + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.set $output (/.+ $input $output)) + )) + (/.return $output))) + (list (/.int input)))))) + (_.for [/.label /.with_label] + ($_ _.and + (_.cover [/.break_at] + (let [expected (i.* (.int (n.* expected_outer_iterations + expected_inner_iterations)) + input)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + ($_ /.then + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + ($_ /.then + (/.when (/.= (/.int (.int expected_outer_iterations)) $outer_index) + (/.break_at @outer)) + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set $output (/.+ $input $output)) + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + )) + (/.set $outer_index (/.+ (/.int +1) $outer_index)) + ))) + (/.return $output))) + (list (/.int input)))))) + (_.cover [/.continue_at] + (let [expected (i.* (.int (n.* (n.- expected_outer_iterations full_outer_iterations) + (n.- expected_inner_iterations full_inner_iterations))) + input)] + (expression (|>> (:as Frac) f.int (i.= expected)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + ($_ /.then + (/.set $outer_index (/.+ (/.int +1) $outer_index)) + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + ($_ /.then + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_outer_iterations)) $outer_index) + (/.continue_at @outer)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.set $output (/.+ $input $output)) + )) + ) + )) + (/.return $output))) + (list (/.int input)))))) + )) + ))) + +(def: test|loop + Test + (do [! random.monad] + [input ..int/16 + iterations (# ! each (n.% 10) random.nat) + .let [$input (/.var "input") + $output (/.var "output") + $index (/.var "index") + expected|while (i.* (.int iterations) input) + expected|do_while (i.* (.int (n.max 1 iterations)) input)]] + ($_ _.and + (_.cover [/.while] + (expression (|>> (:as Frac) f.int (i.= expected|while)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + ($_ /.then + (/.set $output (/.+ $input $output)) + (/.set $index (/.+ (/.int +1) $index)) + )) + (/.return $output))) + (list (/.int input))))) + (_.cover [/.do_while] + (expression (|>> (:as Frac) f.int (i.= expected|do_while)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.do_while (/.< (/.int (.int iterations)) $index) + ($_ /.then + (/.set $output (/.+ $input $output)) + (/.set $index (/.+ (/.int +1) $index)) + )) + (/.return $output))) + (list (/.int input))))) + (_.cover [/.for] + (expression (|>> (:as Frac) f.int (i.= expected|while)) + (/.apply/* (/.closure (list $input) + ($_ /.then + (/.define $output (/.int +0)) + (/.for $index (/.int +0) + (/.< (/.int (.int iterations)) $index) + (/.++ $index) + (/.set $output (/.+ $input $output))) + (/.return $output))) + (list (/.int input))))) + (_.for [/.Label] + ..test|label) + ))) + +(def: test|exception + Test + (do [! random.monad] + [expected random.safe_frac + dummy (random.only (|>> (f.= expected) not) + random.safe_frac) + $ex (# ! each /.var (random.ascii/lower 10))] + ($_ _.and + (_.cover [/.try] + (expression (|>> (:as Frac) (f.= expected)) + (/.apply/* (/.closure (list) + (/.try (/.return (/.number expected)) + [$ex (/.return (/.number dummy))])) + (list)))) + (_.cover [/.throw] + (expression (|>> (:as Frac) (f.= expected)) + (/.apply/* (/.closure (list) + (/.try ($_ /.then + (/.throw (/.number expected)) + (/.return (/.number dummy))) + [$ex (/.return $ex)])) + (list)))) + ))) + +(def: test|apply + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + $arg/0 (# ! each /.var (random.ascii/lower 10)) + $arg/1 (# ! each /.var (random.ascii/lower 11)) + $arg/2 (# ! each /.var (random.ascii/lower 12))] + (`` ($_ _.and + (_.cover [/.apply/1] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/1 (/.closure (list $arg/0) (/.return $arg/0)) + (/.number number/0)))) + (_.cover [/.apply/2] + (expression (|>> (:as Frac) (f.= ($_ f.+ number/0 number/1))) + (/.apply/2 (/.closure (list $arg/0 $arg/1) (/.return ($_ /.+ $arg/0 $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.cover [/.apply/3] + (expression (|>> (:as Frac) (f.= ($_ f.+ number/0 number/1 number/2))) + (/.apply/3 (/.closure (list $arg/0 $arg/1 $arg/2) (/.return ($_ /.+ $arg/0 $arg/1 $arg/2))) + (/.number number/0) + (/.number number/1) + (/.number number/2)))) + (_.cover [/.apply/*] + (expression (|>> (:as Frac) (f.= ($_ f.+ number/0 number/1 number/2))) + (/.apply/* (/.closure (list $arg/0 $arg/1 $arg/2) (/.return ($_ /.+ $arg/0 $arg/1 $arg/2))) + (list (/.number number/0) + (/.number number/1) + (/.number number/2))))) + )))) + +(def: test|function + Test + (do [! random.monad] + [number/0 random.safe_frac + iterations (# ! each (n.% 10) random.nat) + $self (# ! each /.var (random.ascii/lower 1)) + $arg/0 (# ! each /.var (random.ascii/lower 2)) + field (random.ascii/lower 3) + $class (# ! each /.var (random.ascii/upper 4))] + ($_ _.and + (_.cover [/.closure /.return] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/* (/.closure (list) (/.return (/.number number/0))) + (list)))) + (_.cover [/.function] + (expression (|>> (:as Frac) f.nat (n.= iterations)) + (/.apply/1 (/.function $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply/1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.int +0)))) + (_.cover [/.function!] + (expression (|>> (:as Frac) f.nat (n.= iterations)) + (/.apply/* (/.closure (list) + ($_ /.then + (/.function! $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply/1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.return (/.apply/1 $self (/.int +0))))) + (list)))) + (_.cover [/.new] + (let [$this (/.var "this")] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/1 (/.closure (list $arg/0) + ($_ /.then + (/.function! $class (list) + (/.set (/.the field $this) $arg/0)) + (/.return (/.the field (/.new $class (list)))))) + (/.number number/0))))) + ..test|apply + ))) + +(def: test|branching + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + arg/0 (random.ascii/lower 10) + arg/1 (random.only (|>> (text#= arg/0) not) + (random.ascii/lower 10)) + arg/2 (random.only (predicate.and (|>> (text#= arg/0) not) + (|>> (text#= arg/1) not)) + (random.ascii/lower 10)) + .let [$arg/0 (/.var arg/0) + $arg/1 (/.var arg/1) + $arg/2 (/.var arg/2)] + ??? random.bit + int ..int/16] + ($_ _.and + (_.cover [/.if] + (expression (|>> (:as Frac) (f.= (if ??? number/0 number/1))) + (/.apply/* (/.closure (list) + (/.if (/.boolean ???) + (/.return (/.number number/0)) + (/.return (/.number number/1)))) + (list)))) + (_.cover [/.when] + (expression (|>> (:as Frac) (f.= (if ??? number/0 number/1))) + (/.apply/* (/.closure (list) + ($_ /.then + (/.when (/.boolean ???) + (/.return (/.number number/0))) + (/.return (/.number number/1)))) + (list)))) + (_.cover [/.switch] + (let [number/0' (%.frac number/0) + number/1' (%.frac number/1) + number/2' (%.frac number/2)] + (and (expression (|>> (:as Text) (text#= number/0')) + (/.apply/* (/.closure (list) + (/.switch (/.number number/0) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#None})) + (list))) + (expression (|>> (:as Text) (text#= number/1')) + (/.apply/* (/.closure (list) + (/.switch (/.number number/1) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + (expression (|>> (:as Text) (text#= number/2')) + (/.apply/* (/.closure (list) + (/.switch (/.number number/2) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + ))) + ))) + +(def: test|statement + Test + (do [! random.monad] + [number/0 random.safe_frac + number/1 random.safe_frac + number/2 random.safe_frac + $arg/0 (# ! each /.var (random.ascii/lower 10)) + $arg/1 (# ! each /.var (random.ascii/lower 11)) + $arg/2 (# ! each /.var (random.ascii/lower 12)) + ??? random.bit + int ..int/16] + (`` ($_ _.and + (_.cover [/.statement] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/1 (/.closure (list $arg/0) + ($_ /.then + (/.statement (/.+ $arg/0 $arg/0)) + (/.return $arg/0))) + (/.number number/0)))) + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (expression (|>> (:as Frac) f.int (i.= (<lux> int))) + (/.apply/1 (/.closure (list $arg/0) + (/.return (/., (<js> $arg/0) + $arg/0))) + (/.int int))))] + + [/.++ .++] + [/.-- .--] + )) + (_.cover [/.then] + (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/2 (/.closure (list $arg/0 $arg/1) + ($_ /.then + (/.return $arg/0) + (/.return $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.cover [/.use_strict] + (and (expression (|>> (:as Frac) (f.= number/0)) + (/.apply/* (/.closure (list) + ($_ /.then + /.use_strict + (/.declare $arg/0) + (/.set $arg/0 (/.number number/0)) + (/.return $arg/0))) + (list))) + (|> (/.apply/* (/.closure (list) + ($_ /.then + /.use_strict + ... (/.declare $arg/0) + (/.set $arg/0 (/.number number/0)) + (/.return $arg/0))) + (list)) + ..eval + (case> {try.#Success it} + false + + {try.#Failure error} + true)))) + ..test|exception + ..test|function + ..test|branching + (_.for [/.Location] + ..test/location) + (_.for [/.Loop] + ..test|loop) + )))) + +(def: .public test + Test + (do [! random.monad] + [] + (<| (_.covering /._) + (_.for [/.Code /.code]) + (`` ($_ _.and + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + ))))) |