From 913171900fd11272ca328ded6553a56423db1e13 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 13 Jan 2023 16:14:20 -0400 Subject: Can now compile complex values (i.e. variants & tuples) in C++. --- stdlib/source/library/lux/meta.lux | 10 +- .../language/lux/phase/translation/c++/complex.lux | 39 +++ .../lux/phase/translation/c++/primitive.lux | 2 +- .../language/lux/phase/translation/c++/runtime.lux | 131 ++++++++-- .../language/lux/phase/translation/c++/type.lux | 25 +- .../language/lux/phase/translation/jvm/runtime.lux | 3 +- .../library/lux/meta/compiler/target/c++.lux | 246 ++++++++++-------- .../library/lux/meta/compiler/target/c++/type.lux | 92 +++++++ stdlib/source/library/lux/meta/symbol.lux | 46 +++- stdlib/source/library/lux/meta/type.lux | 4 +- .../library/lux/world/time/series/average.lux | 19 +- .../program/aedifex/dependency/resolution.lux | 3 +- stdlib/source/test/aedifex/artifact/versioning.lux | 3 +- stdlib/source/test/lux/meta.lux | 276 +++++++++++---------- .../test/lux/meta/compiler/language/lux/phase.lux | 4 +- .../language/lux/phase/translation/jvm/runtime.lux | 52 ++++ .../test/lux/meta/compiler/meta/archive/module.lux | 7 +- stdlib/source/test/lux/world/finance/money.lux | 33 ++- .../source/test/lux/world/time/series/average.lux | 83 ++++--- 19 files changed, 744 insertions(+), 334 deletions(-) create mode 100644 stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux create mode 100644 stdlib/source/library/lux/meta/compiler/target/c++/type.lux create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux (limited to 'stdlib') diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 4219acd70..7b09f37c9 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -133,10 +133,10 @@ (def .public current_module (Meta Module) - (let [(open "#[0]") ..monad] + (let [(open "/#[0]") ..monad] (|> ..current_module_name - (#each ..module) - #conjoint))) + (/#each ..module) + /#conjoint))) (def (macro_type? type) (-> Type Bit) @@ -748,7 +748,9 @@ (eval type code))) (def .public (try computation) - (All (_ it) (-> (Meta it) (Meta (Try it)))) + (All (_ of) + (-> (Meta of) + (Meta (Try of)))) (function (_ lux) {try.#Success (when (computation lux) {try.#Success [lux' output]} diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux new file mode 100644 index 000000000..9741d67b0 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/complex.lux @@ -0,0 +1,39 @@ +(.require + [library + [lux (.except Variant Tuple Synthesis Translation) + [abstract + ["[0]" monad (.only do)]] + [meta + [compiler + [target + ["_" c++]]]]]] + [// + ["[0]" runtime (.only Translation)] + [//// + ["[0]" phase] + [synthesis (.only Synthesis)] + [analysis + [complex (.only Variant Tuple)]]]]) + +(def .public (variant phase archive [lefts right? value]) + (Translation (Variant Synthesis)) + (do phase.monad + [value (phase archive value)] + (in (runtime.variant (_.int (.int lefts)) + (_.bool right?) + value)))) + +(def .public (tuple phase archive values) + (Translation (Tuple Synthesis)) + (let [! phase.monad] + (when values + {.#End} + (of ! in runtime.unit) + + {.#Item it {.#End}} + (phase archive it) + + _ + (|> values + (monad.each ! (phase archive)) + (of ! each runtime.tuple))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux index a3e90178d..b4935dd1f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/primitive.lux @@ -26,4 +26,4 @@ (def .public text (-> Text Literal) - _.u32string) + _.u32_string) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux index c03a1a813..57d354c5f 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux @@ -1,16 +1,49 @@ (.require [library - [lux (.except) + [lux (.except Declaration Translation) [data [text - ["%" \\format]]] + ["%" \\format]] + [collection + ["[0]" list]]] ["[0]" meta (.use "[1]#[0]" functor) ["[0]" code] [macro [syntax (.only syntax)]] [compiler [target - ["_" c++]]]]]]) + ["_" c++ (.only) + ["[0]" type]]]]]]] + ["[0]" // + ["[1][0]" type]] + [///// + ["[0]" translation] + [/// + [meta + [archive (.only Archive)]]]]) + +(type .public Anchor + Any) + +(type .public Value + _.Expression) + +(type .public Declaration + _.Statement) + +(with_template [ ] + [(type .public + ( Anchor Value Declaration))] + + [Operation translation.Operation] + [Phase translation.Phase] + [Handler translation.Handler] + [Bundle translation.Bundle] + ) + +(type .public (Translation of) + (-> Phase Archive of + (Operation Value))) (def .public (host_value of it) (-> _.Type _.Expression @@ -31,7 +64,51 @@ code.text list))))) -(with_expansions [ (..name)] +(with_expansions [ (..name) + + (..name) + (..name) + (..name) + (..name) + + (..name) + (..name) + (..name) + + (..name)] + (def .public clean_up + (-> _.Type + _.Expression) + (|>> (list) + (_.global [..namespace ]))) + + (def .public (lux_value of it) + (-> _.Type _.Expression + _.Expression) + (_.on (list it (clean_up of)) + (_.global [_.standard "shared_ptr"] (list type.void)))) + + (def .public (simple of it) + (-> _.Type _.Expression + _.Expression) + (lux_value of + (_.new (_.of (list it) of)))) + + (def .public (variant lefts right? choice) + (-> _.Expression _.Expression _.Expression + _.Expression) + (let [type (_.type (_.global [..namespace ] (list)))] + (lux_value type + (_.new (_.structure type (list lefts right? choice)))))) + + (def .public (tuple values) + (-> (List _.Expression) + _.Expression) + (let [arity (_.int (.int (list.size values))) + type (_.type (_.global [..namespace ] (list)))] + (lux_value type + (_.new (_.structure type (list arity (_.new (_.array type arity values)))))))) + (def .public declaration _.Declaration (let [clean_up (let [of (_.type_name "Of") @@ -39,26 +116,40 @@ (_.function (_.local ) (list of) (list [(_.* of) it]) - _.void - (_.delete it)))] - (all _.then + type.void + (_.delete it))) + + $variant (_.local ) + $tuple (_.local ) + $values (_.local ) + + :variant (_.type $variant) + :tuple (_.type $tuple)] + (all _.also (_.include "memory") (<| (_.namespace ..namespace) - (all _.then + (all _.also clean_up + + (_.constant (_.local ) + //type.value + (..simple //type.text (_.u32_string ""))) + + (<| (_.structure_definition $variant) + [(list [(_.local ) //type.lefts] + [(_.local ) //type.right?] + [(_.local ) //type.value]) + (list)]) + + (<| (_.structure_definition $tuple) + [(list [(_.local ) //type.arity] + [$values (_.* //type.value)]) + (list (<| (_.destructor $tuple) + (_.delete_array $values)))]) ))))) - (def .public clean_up - (-> _.Type - _.Expression) - (|>> (list) - (_.global [..namespace ]))) + (def .public unit + _.Expression + (_.global [..namespace ] (list))) ) - -(def .public (lux_value of it) - (-> _.Type _.Expression - _.Expression) - (_.on (list (_.new of (list it)) - (clean_up of)) - (_.global [_.standard "shared_ptr"] (list _.void)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux index 9aac0541c..4e995e566 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/type.lux @@ -4,24 +4,37 @@ [meta [compiler [target - ["_" c++]]]]]]) + ["_" c++ (.only) + ["[0]" type]]]]]]]) (def .public bit _.Type - (_.type ["" "bool"] (list))) + type.bool) (def .public i64 _.Type - (_.type ["" "int64_t"] (list))) + type.int_64) (def .public f64 _.Type - (_.type ["" "double"] (list))) + type.double) (def .public text _.Type - (_.type [_.standard "u32string"] (list))) + type.u32_string) (def .public value _.Type - (_.type [_.standard "shared_ptr"] (list (_.type ["" "void"] (list))))) + (type.shared_ptr type.void)) + +(def .public lefts + _.Type + type.char) + +(def .public right? + _.Type + ..bit) + +(def .public arity + _.Type + ..lefts) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux index cfdf7ac2a..3d25c9723 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux @@ -82,6 +82,7 @@ [(type .public ( Anchor Value Declaration))] + [State translation.State] [Operation translation.Operation] [Phase translation.Phase] [Handler translation.Handler] @@ -655,7 +656,7 @@ ] (in [])))) -(def .public translate +(def .public translation (Operation [Registry Output]) (do phase.monad [runtime_payload ..translate_runtime diff --git a/stdlib/source/library/lux/meta/compiler/target/c++.lux b/stdlib/source/library/lux/meta/compiler/target/c++.lux index 952cc0c0b..c13ab7c0d 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++.lux @@ -1,6 +1,7 @@ (.require [library - [lux (.except Code Type Global Declaration int as function template local global type) + [lux (.except Code Type Global Declaration Definition + int as function template local global type also of) [abstract [equivalence (.only Equivalence)]] [control @@ -9,7 +10,7 @@ ["[0]" text (.only \n \t) (.use "[1]#[0]" equivalence) ["%" \\format]] [collection - ["[0]" list (.use "[1]#[0]" functor)]]] + ["[0]" list (.use "[1]#[0]" functor monoid)]]] [math [number ["f" frac]]] @@ -19,9 +20,14 @@ [type ["[0]" nominal]]]]]) -(def parameter_separator ", ") +(def <% nominal.abstraction) +(def %> nominal.representation) + +(def statement_separator ";") +(def parameter_separator (%.format "," " ")) (def term_delimiters ["(" ")"]) -(def type_delimiters ["<" ">"]) +(def template_delimiters ["<" ">"]) +(def initialization_delimiters ["{" "}"]) (nominal.def .public (Code of) Text @@ -31,13 +37,13 @@ (Equivalence (Code of))) (implementation (def (= refererence it) - (text#= (nominal.representation refererence) - (nominal.representation it))))) + (text#= (%> refererence) + (%> it))))) (def .public code (-> (Code Any) Text) - (|>> nominal.representation)) + (|>> %>)) (with_template [ +] [(`` (with_template [ *'] @@ -57,22 +63,29 @@ [Expression [of]] [Statement [of]]]] + [Type + [[Type_Name []]]] + [Expression [[Computation [of]] [Reference [of]]]] - [Type - [[Type_Name []]]] - [Computation - [[Literal []]]] + [[Literal []] + [Instantiation []]]] [Reference [[Local []] [Global []]]] [Statement - [[Declaration []]]] + [[Declaration [of]]]] + + [Declaration + [[Definition [of]]]] + + [Definition + [[Method []]]] ) (def .public bool @@ -81,7 +94,7 @@ (|>> (|.when .false "false" .true "true") - nominal.abstraction)) + <%)) (def .public double (-> Frac @@ -97,7 +110,7 @@ ... else [%.frac]) - nominal.abstraction)) + <%)) (.type .public Namespace Text) @@ -109,7 +122,7 @@ (def .public local (-> Text Local) - (|>> nominal.abstraction)) + (|>> <%)) (def instantiation (-> (List Type) @@ -122,62 +135,51 @@ (|> it (list#each ..code) (text.interposed ..parameter_separator) - (text.enclosed ..type_delimiters))))) + (text.enclosed ..template_delimiters))))) (def .public (global [ns name] parameters) (-> [Namespace Text] (List Type) Global) - (nominal.abstraction - (let [instance (%.format name (instantiation parameters))] - (when ns - "" instance - _ (%.format ns "::" instance))))) + (<% (let [instance (%.format name (instantiation parameters))] + (when ns + "" instance + _ (%.format ns "::" instance))))) - (def .public (type name parameters) - (-> [Namespace Text] (List Type) + (def .public type + (-> Reference Type) - (|> (..global name parameters) - nominal.transmutation)) + (|>> nominal.transmutation)) (def .public type_name (-> Text Type_Name) - (|>> nominal.abstraction)) - - (with_template [ ] - [(def .public - Type - (..type [ (template.text [])] (list)))] - - ["" void] - ) + (|>> <%)) (def .public * (-> Type Type) - (|>> nominal.representation + (|>> %> (text.suffix "*") - nominal.abstraction)) + <%)) (def .public deref (-> Expression Expression) - (|>> nominal.representation + (|>> %> (text.prefix "*") - nominal.abstraction)) + <%)) (def .public (as type term) (-> Type Expression Computation) - (nominal.abstraction - (%.format "(" (nominal.representation type) ")" - " " (nominal.representation term)))) + (<% (%.format "(" (%> type) ")" + " " (%> term)))) (def .public int (-> Int Literal) (|>> %.int - nominal.abstraction)) + <%)) (def application (-> (List Expression) @@ -189,67 +191,85 @@ (def .public (on parameters function) (-> (List Expression) Expression Expression) - (nominal.abstraction - (%.format (nominal.representation function) - (application parameters)))) + (<% (%.format (%> function) (application parameters)))) + + (def .public (of parameters constructor) + (-> (List Expression) Type + Instantiation) + (<% (%.format (%> constructor) (application parameters)))) + + (def initialization + (-> (List Expression) + Text) + (|>> (list#each ..code) + (text.interposed ..parameter_separator) + (text.enclosed ..initialization_delimiters))) - (def .public (new of parameters) + (def .public (structure name parameters) (-> Type (List Expression) + Instantiation) + (<% (%.format (%> name) (initialization parameters)))) + + (def .public (array type arity initials) + (-> Type Expression (List Expression) + Instantiation) + (<% (%.format (%> type) "[" (%> arity) "]" " " (initialization initials)))) + + (def .public (new it) + (-> Instantiation Expression) - (nominal.abstraction - (%.format "new " - (nominal.representation of) - (application parameters)))) + (<% (%.format "new " (%> it)))) (def .public (do method types parameters object) (-> Text (List Type) (List Expression) Expression Expression) - (nominal.abstraction - (%.format (nominal.representation object) - "." method - (instantiation types) - (application parameters)))) + (<% (%.format (%> object) "." method (instantiation types) (application parameters)))) (def .public (<< it to) (-> Expression Expression Expression) - (nominal.abstraction - (%.format (nominal.representation to) - " << " - (nominal.representation it)))) + (<% (%.format (%> to) " << " (%> it)))) (def .public (include it) (-> Text Declaration) - (nominal.abstraction - (%.format "#include <" it ">"))) + (<% (%.format "#include <" it ">"))) - (def .public (then before after) - (All (_ of) - (-> (Statement of) (Statement of) - (Statement of))) - (nominal.abstraction - (%.format (nominal.representation before) - \n (nominal.representation after)))) + (with_template [ ] + [(def .public ( before after) + (-> + ) + (<% (%.format (%> before) + \n (%> after))))] + + [then Statement] + [also Declaration] + ) (def statement - (-> Text - Statement) - (|>> (text.suffix ";") - nominal.abstraction)) + (All (_ of) + (-> Text + (Statement of))) + (|>> (text.suffix ..statement_separator) + <%)) (def .public ; (-> Expression Statement) - (|>> nominal.representation + (|>> %> ..statement)) - (def .public delete - (-> Expression - Statement) - (|>> nominal.representation - (%.format "delete ") - ..statement)) + (with_template [ ] + [(def .public + (-> Expression + Statement) + (|>> %> + (%.format " ") + ..statement))] + + [delete "delete"] + [delete_array "delete[]"] + ) (def template (-> (List Type_Name) @@ -261,9 +281,9 @@ it (%.format "template" " " (|> it - (list#each (|>> nominal.representation (%.format "typename "))) + (list#each (|>> %> (%.format "typename "))) (text.interposed ..parameter_separator) - (text.enclosed ..type_delimiters)) + (text.enclosed ..template_delimiters)) " ")))) (.type Argument @@ -272,8 +292,7 @@ (def (argument [type it]) (-> Argument Text) - (%.format (nominal.representation type) - " " (nominal.representation it))) + (%.format (%> type) " " (%> it))) (def arguments (-> (List Argument) @@ -283,31 +302,27 @@ (text.enclosed ..term_delimiters))) (def block - (-> Statement + (-> Text Text) (let [\n\t (%.format \n \t) - <| (%.format "{" \n) + <| (%.format "{" \n\t) |> (%.format \n "}")] - (|>> nominal.representation - (text.replaced \n \n\t) + (|>> (text.replaced \n \n\t) (text.enclosed [<| |>])))) (def .public (function name types inputs output body) (-> Local (List Type_Name) (List Argument) Type Statement - Declaration) - (nominal.abstraction - (%.format (..template types) (nominal.representation output) - " " (nominal.representation name) - (..arguments inputs) - " " (..block body)))) + Definition) + (<% (%.format (..template types) + (%> output) " " (%> name) (..arguments inputs) + " " (..block (%> body))))) (def .public (namespace it body) (-> Namespace Declaration Declaration) - (nominal.abstraction - (%.format "namespace" - " " it - " " (..block body)))) + (<% (%.format "namespace" + " " it + " " (..block (%> body))))) ... https://en.cppreference.com/w/cpp/types/integer (with_template [] @@ -315,7 +330,7 @@ (-> Expression Expression) (..on (list it) - (nominal.abstraction (template.text []))))] + (<% (template.text []))))] [int64_t] ) @@ -340,11 +355,42 @@ )))) ... https://en.cppreference.com/w/cpp/string/basic_string - (def .public u32string + (def .public u32_string (-> Text Literal) (|>> ..safe %.text (%.format "U") - nominal.abstraction)) + <%)) + + (def .public (destructor of body) + (-> Local Statement + Method) + (<% (%.format "~" (%> of) "()" + " " (block (%> body))))) + + (def .public (var_declaration name type) + (-> Local Type + Declaration) + (|> (%.format (%> type) " " (%> name)) + ..statement)) + + (def .public (constant name type value) + (-> Local Type Expression + Definition) + (..statement (%.format (%> type) " const " (%> name) " = " (%> value)))) + + (def .public (structure_definition name [fields methods]) + (-> Local [(List [Local Type]) (List Method)] + Definition) + (..statement + (%.format "struct" + " " (%> name) + " " (block (|> (all list#composite + (list#each (.function (_ [name type]) + (%> (var_declaration name type))) + fields) + (list#each ..code + methods)) + (text.interposed \n)))))) ) diff --git a/stdlib/source/library/lux/meta/compiler/target/c++/type.lux b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux new file mode 100644 index 000000000..a5a296da3 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux @@ -0,0 +1,92 @@ +(.require + [library + [lux (.except char int) + [meta + [macro + ["[0]" template]]]]] + ["/" //]) + +(with_template [ /*] + [(`` (with_template [] + [(def .public + /.Type + (/.type (/.global [ (template.text [])] (list))))] + + (,, (template.spliced /*))))] + + ["" + [[void] + [bool] + [char] + [short] + [int] + [long] + [float] + [double]]] + ) + +(with_template [ /*] + [(`` (with_template [ ] + [(def .public + /.Type + (/.type (/.global [ ] (list))))] + + (,, (template.spliced /*))))] + + ... https://en.cppreference.com/w/cpp/string/basic_string + [/.standard + [[string "string"] + [wide_string "wstring"] + [u08_string "u8string"] + [u16_string "u16string"] + [u32_string "u32string"]]] + ) + +(with_template [ ] + [(def .public + /.Type + (/.type (/.global ["" ] (list))))] + + [int_08 "int8_t"] + [int_16 "int16_t"] + [int_32 "int32_t"] + [int_64 "int64_t"] + + [int_fast_08 "int_fast8_t"] + [int_fast_16 "int_fast16_t"] + [int_fast_32 "int_fast32_t"] + [int_fast_64 "int_fast64_t"] + + [int_least_08 "int_least8_t"] + [int_least_16 "int_least16_t"] + [int_least_32 "int_least32_t"] + [int_least_64 "int_least64_t"] + + [int_max "intmax_t"] + [int_ptr "intptr_t"] + + [uint_08 "uint8_t"] + [uint_16 "uint16_t"] + [uint_32 "uint32_t"] + [uint_64 "uint64_t"] + + [uint_fast_08 "uint_fast8_t"] + [uint_fast_16 "uint_fast16_t"] + [uint_fast_32 "uint_fast32_t"] + [uint_fast_64 "uint_fast64_t"] + + [uint_least_08 "uint_least8_t"] + [uint_least_16 "uint_least16_t"] + [uint_least_32 "uint_least32_t"] + [uint_least_64 "uint_least64_t"] + + [uint_max "uintmax_t"] + [uint_ptr "uintptr_t"] + ) + +(def .public shared_ptr + (-> /.Type + /.Type) + (|>> list + (/.global [/.standard "shared_ptr"]) + /.type)) diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index 36d4b4256..3ea717f65 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -15,7 +15,8 @@ (with_template [] [(def .public ( [module short]) - (-> Symbol Text) + (-> Symbol + Text) )] [module] @@ -47,8 +48,11 @@ (implementation (def (encoded [module short]) (when module - "" short - _ (all text#composite module ..separator short))) + "" + short + + _ + (all text#composite module ..separator short))) (def (decoded input) (when (text.all_split_by ..separator input) @@ -60,3 +64,39 @@ _ {.#Left (text#composite "Invalid format for Symbol: " input)})))) + +(def .public (relative_codec expected) + (-> Text + (Codec Text Symbol)) + (implementation + (def (encoded [module short]) + (when module + "" + short + + .prelude + (all text#composite ..separator short) + + _ + (all text#composite + (if (text#= expected module) + ..separator + module) + ..separator short))) + + (def (decoded input) + (when (text.all_split_by ..separator input) + (list short) + {.#Right ["" short]} + + (list "" short) + {.#Right [.prelude short]} + + (list module short) + {.#Right [module short]} + + (list "" "" short) + {.#Right [expected short]} + + _ + {.#Left (text#composite "Invalid format for Symbol: " input)})))) diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index 68bfbb5bd..ff6862ace 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -133,8 +133,8 @@ [.#UnivQ "All"] [.#ExQ "Ex"])) - {.#Named [module name] type} - (all text#composite module "." name) + {.#Named name type} + (symbol#encoded name) ))) ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction diff --git a/stdlib/source/library/lux/world/time/series/average.lux b/stdlib/source/library/lux/world/time/series/average.lux index 553cfee7f..bc791bb34 100644 --- a/stdlib/source/library/lux/world/time/series/average.lux +++ b/stdlib/source/library/lux/world/time/series/average.lux @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" try (.only Try)] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception (.only Exception)]] [data ["[0]" product] @@ -40,11 +40,12 @@ (list ["Maximum" (%.nat maximum)] ["Actual" (%.nat actual)]))) -(def .public (windows size it) +(def .public (windows additional it) (All (_ of) (-> Nat (Series of) (Try (Series (Series of))))) - (let [maximum (//.size it)] + (let [size (++ additional) + maximum (//.size it)] (if (n.< size maximum) (exception.except ..window_size_is_too_large [maximum size]) (let [limit (n.- size maximum)] @@ -59,7 +60,9 @@ [current (//.window offset size it)] (again (++ offset) (sequence.suffix current output))) - {try.#Success (has //.#data output it)})))))) + {try.#Success (|> it + (has //.#data output) + (has //.#start (//.at size it)))})))))) (type .public (Average of) (-> (Series of) @@ -70,12 +73,8 @@ (All (_ of) (-> (Average of) Nat (Series of) (Try (Series of)))) - (do try.monad - [.let [size (++ additional)] - it (windows size it)] - (in (|> it - (revised //.#data (sequence#each average)) - (has //.#start (//.at size it)))))) + (try#each (revised //.#data (sequence#each average)) + (windows additional it))) ... https://en.wikipedia.org/wiki/Moving_average#Exponential_moving_average ... https://en.wikipedia.org/wiki/Exponential_smoothing diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index ae05fb4c1..6dd207f4a 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -33,7 +33,8 @@ ["n" nat] ["[0]" i64]]] [meta - ["@" target]] + [compiler + ["@" target]]] [world [console (.only Console)] [net (.only URL) diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index 62408f573..b10d75108 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -33,7 +33,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Versioning]) + (_.for [/.Versioning + /.#snapshot /.#last_updated /.#versions]) (all _.and (_.for [/.equivalence] (equivalenceT.spec /.equivalence ..random)) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index bb5da38b8..03ac91796 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -802,144 +802,154 @@ (try.else false)))) ))) -... (def label_related -... Test -... (do [! random.monad] -... [current_module (random.upper_cased 1) -... label_module (random.only (|>> (text#= current_module) not) -... (random.upper_cased 1)) +(def label_related + Test + (do [! random.monad] + [current_module (random.upper_cased 1) + label_module (random.upper_cased 2) -... name_0 (random.upper_cased 1) -... name_1 (random.only (|>> (text#= name_0) not) -... (random.upper_cased 1)) + name_0 (random.upper_cased 3) + ... name_1 (random.upper_cased 4) -... .let [random_tag (of ! each (|>> [label_module]) -... (random.upper_cased 1)) -... random_labels (is (Random [Text (List Text)]) -... (do ! -... [head (random.lower_cased 5)] -... (|> (random.lower_cased 5) -... (random.only (|>> (text#= head) not)) -... (random.set text.hash 3) -... (of ! each set.list) -... (random.and (in head)))))] -... tags_0 random_labels -... tags_1 (let [set/0 (set.of_list text.hash {.#Item tags_0})] -... (random.only (|>> {.#Item} -... (list.any? (set.member? set/0)) -... not) -... random_labels)) -... .let [type_0 {.#Nominal name_0 (list)} -... type_1 {.#Nominal name_1 (list)} + .let [random_tag (of ! each (|>> [label_module]) + (random.upper_cased 1)) + random_labels (is (-> Nat + (Random [Text (List Text)])) + (function (_ size) + (do ! + [head (random.lower_cased size)] + (|> (random.lower_cased size) + (random.only (|>> (text#= head) not)) + (random.set text.hash 3) + (of ! each set.list) + (random.and (in head))))))] + tags_0 (random_labels 5) + ... tags_1 (let [set/0 (set.of_list text.hash {.#Item tags_0})] + ... (random.only (|>> {.#Item} + ... (list.any? (set.member? set/0)) + ... not) + ... random_labels)) + .let [type_0 {.#Nominal name_0 (list)} + ... type_1 {.#Nominal name_1 (list)} -... expected_lux -... (is Lux -... [.#info [.#target "" -... .#version "" -... .#mode {.#Build} -... .#configuration (list)] -... .#source [location.dummy 0 ""] -... .#location location.dummy -... .#current_module {.#Some current_module} -... .#modules (list [current_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list) -... .#imports (list label_module) -... .#module_state {.#Active}]] -... [label_module -... [.#module_hash 0 -... .#module_aliases (list) -... .#definitions (list.partial [name_0 {.#Type [true type_0 {.#Left tags_0}]}] -... [name_1 {.#Type [true type_1 {.#Right tags_1}]}] -... (all list#composite -... (|> {.#Item tags_0} -... list.enumeration -... (list#each (function (_ [index short]) -... [short {.#Tag [true type_0 {.#Item tags_0} index]}]))) -... (|> {.#Item tags_1} -... list.enumeration -... (list#each (function (_ [index short]) -... [short {.#Slot [true type_1 {.#Item tags_1} index]}]))))) -... .#imports (list) -... .#module_state {.#Active}]]) -... .#scopes (list) -... .#type_context [.#ex_counter 0 -... .#var_counter 0 -... .#var_bindings (list)] -... .#expected {.#None} -... .#seed 0 -... .#scope_type_vars (list) -... .#extensions [] -... .#eval (as (-> Type Code (Meta Any)) []) -... .#host []])]] -... (all _.and -... (_.coverage [/.tag_lists] -... (let [equivalence (list.equivalence -... (product.equivalence -... (list.equivalence symbol.equivalence) -... type.equivalence))] -... (|> (/.tag_lists label_module) -... (/.result expected_lux) -... (try#each (of equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0}) -... type_0] -... [(list#each (|>> [label_module]) {.#Item tags_1}) -... type_1]))) -... (try.else false)))) -... (_.coverage [/.tags_of] -... (|> (/.tags_of [label_module name_1]) -... (/.result expected_lux) -... (try#each (of (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})})) -... (try.else false))) -... ... (_.coverage [/.tag] -... ... (|> {.#Item tags_0} -... ... list.enumeration -... ... (list.every? (function (_ [expected_index label]) -... ... (|> [label_module label] -... ... /.tag -... ... (/.result expected_lux) -... ... (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} -... ... (let [correct_index! -... ... (n.= expected_index -... ... actual_index) + expected_lux + (is Lux + [.#info [.#target "" + .#version "" + .#mode {.#Build} + .#configuration (list)] + .#source [location.dummy 0 ""] + .#location location.dummy + .#current_module {.#Some current_module} + .#modules (list [current_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions (list) + .#imports (list label_module) + .#module_state {.#Active}]] + [label_module + [.#module_hash 0 + .#module_aliases (list) + .#definitions (list.partial [name_0 [true {.#Definition [.Type type_0]}]] + ... [name_1 {.#Type [true type_1 {.#Right tags_1}]}] + (all list#composite + (let [cohort (is (List Symbol) + (list#each (|>> [label_module]) + {.#Item tags_0})) + last (-- (list.size cohort)) + right? (n.= last)] + (|> {.#Item tags_0} + list.enumeration + (list#each (function (_ [index short]) + [short [true {.#Definition [.Tag + (|> [{.#Some [index (right? index) cohort]} type_0] + (is Label) + (as Tag))]}]])))) + ... (|> {.#Item tags_1} + ... list.enumeration + ... (list#each (function (_ [index short]) + ... [short {.#Slot [true type_1 {.#Item tags_1} index]}]))) + )) + .#imports (list) + .#module_state {.#Active}]]) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#None} + .#seed 0 + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []])]] + (all _.and + (_.coverage [/.tag_lists] + (let [equivalence (list.equivalence + (product.equivalence + (list.equivalence symbol.equivalence) + type.equivalence))] + (|> (/.tag_lists label_module) + (/.result expected_lux) + (try#each (of equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0}) + type_0] + ... [(list#each (|>> [label_module]) {.#Item tags_1}) + ... type_1] + ))) + (try.else false)))) + ... (_.coverage [/.tags_of] + ... (|> (/.tags_of [label_module name_1]) + ... (/.result expected_lux) + ... (try#each (of (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})})) + ... (try.else false))) + ... (_.coverage [/.tag] + ... (|> {.#Item tags_0} + ... list.enumeration + ... (list.every? (function (_ [expected_index label]) + ... (|> [label_module label] + ... /.tag + ... (/.result expected_lux) + ... (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} + ... (let [correct_index! + ... (n.= expected_index + ... actual_index) -... ... correct_tags! -... ... (of (list.equivalence symbol.equivalence) = -... ... (list#each (|>> [label_module]) {.#Item tags_0}) -... ... actual_tags) + ... correct_tags! + ... (of (list.equivalence symbol.equivalence) = + ... (list#each (|>> [label_module]) {.#Item tags_0}) + ... actual_tags) -... ... correct_type! -... ... (type#= type_0 -... ... actual_type)] -... ... (and correct_index! -... ... correct_tags! -... ... correct_type!)))) -... ... ))))) -... ... (_.coverage [/.slot] -... ... (|> {.#Item tags_1} -... ... list.enumeration -... ... (list.every? (function (_ [expected_index label]) -... ... (|> [label_module label] -... ... /.slot -... ... (/.result expected_lux) -... ... (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} -... ... (let [correct_index! -... ... (n.= expected_index -... ... actual_index) + ... correct_type! + ... (type#= type_0 + ... actual_type)] + ... (and correct_index! + ... correct_tags! + ... correct_type!)))) + ... ))))) + ... (_.coverage [/.slot] + ... (|> {.#Item tags_1} + ... list.enumeration + ... (list.every? (function (_ [expected_index label]) + ... (|> [label_module label] + ... /.slot + ... (/.result expected_lux) + ... (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} + ... (let [correct_index! + ... (n.= expected_index + ... actual_index) -... ... correct_tags! -... ... (of (list.equivalence symbol.equivalence) = -... ... (list#each (|>> [label_module]) {.#Item tags_1}) -... ... actual_tags) + ... correct_tags! + ... (of (list.equivalence symbol.equivalence) = + ... (list#each (|>> [label_module]) {.#Item tags_1}) + ... actual_tags) -... ... correct_type! -... ... (type#= type_1 -... ... actual_type)] -... ... (and correct_index! -... ... correct_tags! -... ... correct_type!)))) -... ... ))))) -... ))) + ... correct_type! + ... (type#= type_1 + ... actual_type)] + ... (and correct_index! + ... correct_tags! + ... correct_type!)))) + ... ))))) + ))) (def injection (Injection Meta) @@ -1030,8 +1040,8 @@ ..definition_related ..search_related ..locals_related - ... (_.for [.Label] - ... ..label_related) + (_.for [.Label] + ..label_related) )) /code.test diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux index ba39fe79e..d9af04496 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase.lux @@ -31,7 +31,8 @@ ["[1]/[0]" host] ["[1]/[0]" primitive] ["[1]/[0]" type] - ["[1]/[0]" value]]]]) + ["[1]/[0]" value] + ["[1]/[0]" runtime]]]]) (def (injection value) (All (_ of) @@ -219,4 +220,5 @@ /translation/jvm/primitive.test /translation/jvm/type.test /translation/jvm/value.test + /translation/jvm/runtime.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux new file mode 100644 index 000000000..97035f3c5 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/runtime.lux @@ -0,0 +1,52 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try]] + [math + ["[0]" random (.only Random)]] + [meta + [type + ["[0]" check]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" host] + [//// + ["[0]" phase] + ["[0]" translation]]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [module (random.lower_cased 1)]) + (`` (all _.and + (,, (with_template [ ] + [(_.coverage [] + (check.subsumes? ))] + + [/.State translation.State] + [/.Operation translation.Operation] + [/.Phase translation.Phase] + [/.Handler translation.Handler] + [/.Bundle translation.Bundle] + [/.Extender translation.Extender] + )) + (_.coverage [/.translation] + (let [[_ host] (io.run! host.host) + state (is /.State + (translation.state host module))] + (|> (do try.monad + [_ (phase.result state + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer)] + /.translation))] + (in true)) + (try.else false)))) + )))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive/module.lux b/stdlib/source/test/lux/meta/compiler/meta/archive/module.lux index a8075cc24..f965326b8 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive/module.lux @@ -21,7 +21,9 @@ ["[1][0]" descriptor]]) (def .public (random it) - (All (_ a) (-> (Random a) (Random (/.Module a)))) + (All (_ of) + (-> (Random of) + (Random (/.Module of)))) (all random.and random.nat (/descriptor.random 0) @@ -34,7 +36,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Module]) + (_.for [/.Module + /.#id /.#descriptor /.#document]) (all _.and (_.coverage [/.ID /.runtime] (n.= 0 /.runtime)) diff --git a/stdlib/source/test/lux/world/finance/money.lux b/stdlib/source/test/lux/world/finance/money.lux index cc798afdd..798b1966f 100644 --- a/stdlib/source/test/lux/world/finance/money.lux +++ b/stdlib/source/test/lux/world/finance/money.lux @@ -39,10 +39,11 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected_amount random.nat + [.let [random_amount (of ! each (n.% 1000,00) random.nat)] + expected_amount random_amount - expected_parameter (random.only (n.> 0) random.nat) - expected_subject random.nat]) + expected_parameter (random.only (n.> 0) random_amount) + expected_subject random_amount]) (_.for [/.Money]) (all _.and (_.for [/.equivalence /.=] @@ -56,16 +57,22 @@ (same? expected_amount (/.amount it))))) (_.coverage [/.+ /.-] (let [parameter (/.money currency.usd expected_parameter) - subject (/.money currency.usd expected_subject)] - (and (|> subject - (/.+ parameter) - (of /.equivalence = subject) - not) - (|> subject - (/.+ parameter) - (/.- parameter) - (maybe#each (of /.equivalence = subject)) - (maybe.else false))))) + subject (/.money currency.usd expected_subject) + + addition_shifts_the_value! + (|> subject + (/.+ parameter) + (of /.equivalence = subject) + not) + + addition_and_subtraction_are_inverses! + (|> subject + (/.+ parameter) + (/.- parameter) + (maybe#each (of /.equivalence = subject)) + (maybe.else false))] + (and addition_shifts_the_value! + addition_and_subtraction_are_inverses!))) (_.coverage [/.min] (let [expected_parameter (/.money currency.usd expected_parameter) expected_subject (/.money currency.usd expected_subject)] diff --git a/stdlib/source/test/lux/world/time/series/average.lux b/stdlib/source/test/lux/world/time/series/average.lux index 5cd02181a..fcc65673f 100644 --- a/stdlib/source/test/lux/world/time/series/average.lux +++ b/stdlib/source/test/lux/world/time/series/average.lux @@ -9,7 +9,8 @@ [math ["[0]" random (.only Random)] [number - ["n" nat]]] + ["n" nat] + ["f" frac]]] [world [time ["[0]" instant (.use "[1]#[0]" order)] @@ -35,13 +36,27 @@ //.#interval interval //.#data data]))) +(def (well_windowed? input additional output) + (All (_ input output) + (-> (/.Series input) Nat (/.Series output) + Bit)) + (let [correct_start! + (instant#< (//.start output) + (//.start input)) + + correct_size! + (n.= (n.- (++ additional) (//.size input)) + (//.size output))] + (and correct_start! + correct_size!))) + (def .public test Test (<| (_.covering /._) (do [! random.monad] [expected_events (of ! each (|>> (n.% 10) ++) random.nat) input (series expected_events) - expected_window_extras (of ! each (n.% expected_events) random.nat)]) + additional (of ! each (n.% expected_events) random.nat)]) (all _.and (_.coverage [/.cumulative] (let [output (/.cumulative input)] @@ -52,11 +67,8 @@ (_.coverage [/.windows] (<| (try.else false) (do try.monad - [output (/.windows expected_window_extras input)] - (in (and (instant#= (//.start input) - (//.start output)) - (n.= (n./ (++ expected_window_extras) (//.size input)) - (//.size output))))))) + [output (/.windows additional input)] + (in (well_windowed? input additional output))))) (_.coverage [/.window_size_is_too_large] (when (/.windows (++ expected_events) input) {try.#Failure error} @@ -64,37 +76,36 @@ {try.#Success _} false)) - (<| (_.for [/.Average /.moving]) + (<| (_.for [/.Average]) (all _.and - (_.coverage [/.Factor /.simple_factor /.exponential] - (<| (try.else false) - (do try.monad - [output (/.moving (/.exponential /.simple_factor) - expected_window_extras - input)] - (in (and (instant#< (//.start output) - (//.start input)) - (n.= (n.- expected_window_extras (//.size input)) - (//.size output))))))) - (_.coverage [/.simple] - (<| (try.else false) - (do try.monad - [output (/.moving /.simple - expected_window_extras - input)] - (in (and (instant#< (//.start output) - (//.start input)) - (n.= (n.- expected_window_extras (//.size input)) - (//.size output))))))) - (_.coverage [/.weighted] + (_.coverage [/.exponential /.simple /.weighted + + /.Factor /.simple_factor] + (let [exponential (/.exponential /.simple_factor input) + simple (/.simple input) + weighted (/.weighted input)] + (and (not (f.= exponential simple)) + (not (f.= exponential weighted)) + (not (f.= simple weighted))))) + (_.coverage [/.moving] (<| (try.else false) (do try.monad - [output (/.moving /.weighted - expected_window_extras - input)] - (in (and (instant#< (//.start output) - (//.start input)) - (n.= (n.- expected_window_extras (//.size input)) - (//.size output))))))) + [exponential (/.moving (/.exponential /.simple_factor) + additional + input) + simple (/.moving /.simple + additional + input) + weighted (/.moving /.weighted + additional + input) + .let [(open "//#[0]") (//.equivalence f.equivalence)]] + (in (and (and (well_windowed? input additional exponential) + (well_windowed? input additional simple) + (well_windowed? input additional weighted)) + (and (not (//#= exponential simple)) + (not (//#= exponential weighted)) + (not (//#= simple weighted))) + ))))) )) ))) -- cgit v1.2.3