diff options
Diffstat (limited to '')
15 files changed, 759 insertions, 131 deletions
diff --git a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux index 560068499..7651b58a1 100644 --- a/stdlib/source/library/lux/math/arithmetic/fixed_point.lux +++ b/stdlib/source/library/lux/math/arithmetic/fixed_point.lux @@ -21,6 +21,8 @@ ["i" int] ["[0]" i64]]] [meta + ["[0]" macro + ["[1]" local]] [type ["[0]" nominal]]]]] [// (.only Arithmetic)]) @@ -126,7 +128,6 @@ [(Fixed @) nominal.abstraction + i.+] [(Fixed @) nominal.abstraction - i.-] - [(Fixed @) nominal.abstraction % i.%] [Bit |> = i.=] [Bit |> < i.<] @@ -135,20 +136,95 @@ [Bit |> >= i.>=] ) - (with_template [<fp> <u> <s>] - [(def .public (<fp> @ parameter subject) - (All (_ @) - (-> (Point @) (Fixed @) (Fixed @) - (Fixed @))) - (fixed @ - (<u> (units @ parameter) - (units @ subject)) - (.rev (<s> (.nat (sub_units @ parameter)) - (.nat (sub_units @ subject))))))] - - [* i.* n.*] - [/ i./ n./] + (with_template [<quarter> <name>] + [(def <name> + (All (_ of) + (-> (I64 of) + (I64 of))) + (let [left (n.- (n.* (++ <quarter>) 16) i64.width) + right (n.+ (n.* <quarter> 16) left)] + (|>> (i64.left_shifted left) + (i64.right_shifted right))))] + + [0 ll] + [1 lh] + [2 hl] + [3 hh] + ) + + (def low + (All (_ of) + (-> (I64 of) + (I64 of))) + (i64.and (i64.mask 32))) + + (def high + (All (_ of) + (-> (I64 of) + (I64 of))) + (i64.right_shifted 32)) + + (with_template [<shift> <name>] + [(def <name> + (All (_ of) + (-> (I64 of) + (I64 of))) + (i64.left_shifted <shift>))] + + [16 up/16] + [32 up/32] ) + + (def .public (* @ parameter subject) + (All (_ @) + (-> (Point @) (Fixed @) (Fixed @) + (Fixed @))) + (let [mask (i64.mask (nominal.representation Point @))] + (macro.let [units' (template (_ <it>) + [(i.right_shifted (nominal.representation Point @) <it>)]) + sub_units' (template (_ <it>) + [(i64.and mask <it>)]) + high_sub_units' (template (_ <it>) + [(i64.right_shifted (nominal.representation Point @) <it>)])] + (let [parameter (nominal.representation parameter) + subject (nominal.representation subject) + + s::u (units' subject) + s::s (sub_units' subject) + + p::u (units' parameter) + p::s (sub_units' parameter) + + s*p (i.* s::u p::s) + p*s (i.* p::u s::s) + + x::u (all i.+ + (i.* p::u + s::u) + (units' s*p) + (units' p*s) + ) + x::s (all i.+ + (high_sub_units' + (i.* p::s + s::s)) + (sub_units' s*p) + (sub_units' p*s) + )] + (nominal.abstraction + (.int (i64.or (of_units @ x::u) + x::s))))))) + + (def .public (/ @ parameter subject) + (All (_ @) + (-> (Point @) (Fixed @) (Fixed @) + (Fixed @))) + (|> subject + nominal.representation + (i64.left_shifted (nominal.representation Point @)) + (i./ (nominal.representation parameter)) + (i.right_shifted (nominal.representation Point @)) + nominal.abstraction)) ) ) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux index 6b1423ba0..207a9e98e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux @@ -28,7 +28,7 @@ ["[1][0]" primitive] ["[1][0]" complex] ["[1][0]" reference] - ... ["[1][0]" function] + ["[1][0]" function] ["[1][0]" when] ... ["[1][0]" loop] [/// @@ -62,7 +62,7 @@ [@ {synthesis.#Reference it}] (when it {reference.#Variable it} - (/reference.variable it) + (phase#in (/reference.variable it)) {reference.#Constant it} (/reference.constant archive it)) @@ -88,11 +88,14 @@ ... (synthesis.loop/again @ updates) ... (/loop.again phase archive updates) + (synthesis.function/abstraction @ [environment arity (synthesis.loop/scope @ [1 (list) iteration])]) + (/function.abstraction phase archive [environment arity iteration]) + ... (synthesis.function/abstraction @ abstraction) ... (/function.abstraction phase archive abstraction) - ... (synthesis.function/apply @ application) - ... (/function.apply phase archive application) + (synthesis.function/apply @ it) + (/function.reification phase archive it) ... [@ {synthesis.#Extension [name parameters]}] ... (extension.application extender lux phase archive .Translation false name parameters diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/function.lux new file mode 100644 index 000000000..b7d1ab4d7 --- /dev/null +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/function.lux @@ -0,0 +1,59 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [data + [collection + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [meta + [compiler + [target + ["_" c++]]]]]] + ["[0]" // + ["[0]" runtime] + ["[0]" reference] + [//// + [analysis (.only Reification)] + [synthesis (.only Abstraction)] + ["[0]" phase] + [/// + [meta + ["[0]" cache + [dependency + ["[1]" artifact]]]]]]]) + +(def .public (reification expression archive [abstraction arguments]) + (runtime.Term Reification) + (do [! phase.monad] + [abstraction (expression archive abstraction) + arguments (monad.each ! (expression archive) arguments)] + (in (runtime.on arguments abstraction)))) + +(def .public (abstraction next archive [environment arity body]) + (runtime.Term Abstraction) + (do [! phase.monad] + [dependencies (cache.dependencies archive body) + body (next archive body) + .let [$self (reference.local 0) + $arguments (reference.local (-- 0))]] + (in (<| (runtime.function (_.int (.int arity))) + (_.lambda (|> environment + list.enumeration + (list#each (function (_ [register variable]) + (_.alias (reference.foreign register) + (reference.variable variable))))) + (list [runtime.value_type $self] + [(_.* runtime.value_type) $arguments]) + {.#Some runtime.value_type} + (list#mix _.then + (_.return body) + (list#each (function (_ register') + (_.variable (reference.local (++ register')) + runtime.value_type + (_.item (_.int (.int register')) + $arguments))) + (list.indices arity)))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux index f449c76bf..d5c64b4ec 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux @@ -48,14 +48,13 @@ (def .public variable (-> Variable - (Operation _.Local)) + _.Local) (|>> (|.when {variable.#Local it} (..local it) {variable.#Foreign it} - (..foreign it)) - phase#in)) + (..foreign it)))) (def .public (constant archive it) (-> Archive Symbol 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 aff1774a1..14e791d31 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 @@ -4,7 +4,8 @@ (.require [library [lux (.except Type Declaration - Bit I64 F64 Text Variant Tuple) + Bit I64 F64 Text Variant Tuple + function) [abstract ["[0]" monad (.only do)]] [data @@ -70,34 +71,40 @@ (def name (syntax (_ []) (|> meta.seed - (meta#each (|>> %.nat - (%.format ..namespace) + (meta#each (|>> %.nat_16 + (%.format "_") code.text list))))) (with_expansions [<clean_up> (..name) <Variant> (..name) - <lefts> (..name) - <right?> (..name) - <choice> (..name) + <Variant#lefts> (..name) + <Variant#right?> (..name) + <Variant#choice> (..name) <Tuple> (..name) - <arity> (..name) - <values> (..name) + <Tuple#arity> (..name) + <Tuple#values> (..name) + + <Function> (..name) + <Function#arity> (..name) + <Function#partiality> (..name) + <Function#partials> (..name) + <Function#closure> (..name) <Type> (..name) - <bit?> (..name) - <i64?> (..name) - <f64?> (..name) - <text?> (..name) - <variant?> (..name) - <tuple?> (..name) - <function?> (..name) + <Type#Bit> (..name) + <Type#I64> (..name) + <Type#F64> (..name) + <Type#Text> (..name) + <Type#Variant> (..name) + <Type#Tuple> (..name) + <Type#Function> (..name) <Object> (..name) - <Object/type> (..name) - <Object/value> (..name) + <Object#type> (..name) + <Object#value> (..name) <unit> (..name) @@ -110,8 +117,10 @@ <variant_right?> (..name) <variant_choice> (..name) - <tuple_arity> (..name) - <tuple_member> (..name)] + <tuple::arity> (..name) + <tuple::member> (..name) + + <function::on> (..name)] (with_template [<code> <name>] [(def .public <name> Nat @@ -140,8 +149,8 @@ [variant_right? <variant_right?>] [variant_choice <variant_choice>] - [tuple_arity <tuple_arity>] - [tuple_member <tuple_member>] + [tuple::arity <tuple::arity>] + [tuple::member <tuple::member>] ) (def object_type @@ -151,6 +160,10 @@ (def .public value_type _.Type (type.shared_ptr object_type)) + + (def closure_type + _.Type + (type.function (list value_type (_.* value_type)) value_type)) (def .public clean_up (-> _.Type @@ -167,18 +180,23 @@ (def tuple_type (_.type (_.global [(list ..namespace) <Tuple>] (list)))) + (def function_type + _.Type + (_.type (_.global [(list ..namespace) <Function>] (list)))) + (with_template [<name> <tag> <type>] [(def .public <name> ..Type [(_.global [(list ..namespace <Type>) <tag>] (list)) <type>])] - [Bit <bit?> //type.bit] - [I64 <i64?> //type.i64] - [F64 <f64?> //type.f64] - [Text <text?> //type.text] - [Variant <variant?> ..variant_type] - [Tuple <tuple?> ..tuple_type] + [Bit <Type#Bit> //type.bit] + [I64 <Type#I64> //type.i64] + [F64 <Type#F64> //type.f64] + [Text <Type#Text> //type.text] + [Variant <Type#Variant> ..variant_type] + [Tuple <Type#Tuple> ..tuple_type] + [Function <Type#Function> ..function_type] ) (def (lux_value [tag of] it) @@ -188,11 +206,20 @@ (clean_up of)) (_.global [(list _.standard) "shared_ptr"] (list object_type)))) + (def .public (on arguments abstraction) + (-> (List _.Expression) _.Expression + _.Expression) + (let [arity (|> arguments list.size .int _.int)] + (_.on (list arity + (_.new (_.array value_type arity arguments)) + abstraction) + (_.global [(list ..namespace) <function::on>] (list))))) + (def .public (host_value of it) (-> _.Type _.Expression _.Expression) (|> it - (_.the* <Object/value>) + (_.the* <Object#value>) (_.is (_.* of)))) (def .public (simple [tag of] it) @@ -221,28 +248,53 @@ _.new (lux_value ..Tuple)))) + (def .public (function' partiality partials arity it) + (-> _.Expression _.Expression _.Expression _.Expression + _.Expression) + (|> (list arity + partiality + partials + it) + (_.structure ..function_type) + _.new + (lux_value ..Function))) + + (def .public (function arity it) + (-> _.Expression _.Expression + _.Expression) + (let [partiality (_.int +0)] + (function' partiality + (_.new (_.array value_type partiality (list))) + arity + it))) + (def .public declaration _.Declaration (let [$Variant (_.local <Variant>) + $Tuple (_.local <Tuple>) - $values (_.local <values>) + $values (_.local <Tuple#values>) + + $Function (_.local <Function>) + $Function/partials (_.local <Function#partials>) $Type (_.local <Type>) - $bit? (_.local <bit?>) - $i64? (_.local <i64?>) - $f64? (_.local <f64?>) - $text? (_.local <text?>) - $variant? (_.local <variant?>) - $tuple? (_.local <tuple?>) - $function? (_.local <function?>) + $bit? (_.local <Type#Bit>) + $i64? (_.local <Type#I64>) + $f64? (_.local <Type#F64>) + $text? (_.local <Type#Text>) + $variant? (_.local <Type#Variant>) + $tuple? (_.local <Type#Tuple>) + $function? (_.local <Type#Function>) $Object (_.local <Object>) - $value (_.local <Object/value>) + $value (_.local <Object#value>) :Object (_.type $Object)] (all _.also (_.include "memory") (_.include "codecvt") (_.include "locale") + (_.include "functional") (<| (_.namespace ..namespace) (`` (all _.also @@ -256,24 +308,32 @@ $function?)) (<| (_.structure_definition $Object) - [(list [(_.local <Object/type>) (_.type $Type)] - [(_.local <Object/value>) (_.* type.void)]) + [(list [(_.local <Object#type>) (_.type $Type)] + [(_.local <Object#value>) (_.* type.void)]) (list)]) (<| (_.structure_definition $Variant) - [(list [(_.local <lefts>) //type.lefts] - [(_.local <right?>) //type.right?] - [(_.local <choice>) value_type]) + [(list [(_.local <Variant#lefts>) //type.lefts] + [(_.local <Variant#right?>) //type.right?] + [(_.local <Variant#choice>) value_type]) (list)]) (<| (_.structure_definition $Tuple) - [(list [(_.local <arity>) //type.arity] + [(list [(_.local <Tuple#arity>) //type.arity] [$values (_.* value_type)]) - (list (<| (_.destructor $Tuple) + (list (<| _.destructor (_.delete_array $values)))]) - (let [of (_.type_name "Of") - it (_.local "it")] + (<| (_.structure_definition (_.local <Function>)) + [(list [(_.local <Function#arity>) //type.arity] + [(_.local <Function#partiality>) //type.arity] + [$Function/partials (_.* value_type)] + [(_.local <Function#closure>) ..closure_type]) + (list (<| _.destructor + (_.delete_array $Function/partials)))]) + + (let [of (_.type_name (..name)) + it (_.local (..name))] (_.function (_.local <clean_up>) (list of) (list [(_.* :Object) it]) @@ -288,15 +348,15 @@ (..simple ..Text (_.u32_string ""))) ... Out functions - (let [it (_.local "it")] + (let [it (_.local (..name))] (_.function (_.local <object_tag>) (list) (list [..value_type it]) //type.i64 - (_.return (_.the* <Object/type> it)))) + (_.return (_.the* <Object#type> it)))) (,, (with_template [<name> <type>] - [(let [it (_.local "it")] + [(let [it (_.local (..name))] (_.function (_.local <name>) (list) (list [..value_type it]) @@ -307,8 +367,8 @@ [<lux_i64> //type.i64] )) - (let [it (_.local "it") - converter (_.local "converter") + (let [it (_.local (..name)) + converter (_.local (..name)) converter_type (_.type (_.global [(list _.standard) "wstring_convert"] (list (_.type (_.global [(list _.standard) "codecvt_utf8"] (list type.char32))) @@ -325,33 +385,212 @@ converter))))) (,, (with_template [<name> <field> <type>] - [(let [it (_.local "it")] + [(let [it (_.local (..name))] (_.function (_.local <name>) (list) (list [..value_type it]) <type> (_.return (_.the* <field> (host_value ..variant_type it)))))] - [<variant_lefts> <lefts> //type.i64] - [<variant_right?> <right?> //type.bit] - [<variant_choice> <choice> ..value_type] + [<variant_lefts> <Variant#lefts> //type.i64] + [<variant_right?> <Variant#right?> //type.bit] + [<variant_choice> <Variant#choice> ..value_type] )) - (let [it (_.local "it")] - (_.function (_.local <tuple_arity>) + (let [it (_.local (..name))] + (_.function (_.local <tuple::arity>) (list) (list [..value_type it]) //type.i64 - (_.return (_.the* <arity> (host_value ..tuple_type it))))) + (_.return (_.the* <Tuple#arity> (host_value ..tuple_type it))))) - (let [item (_.local "item") - it (_.local "it")] - (_.function (_.local <tuple_member>) + (let [item (_.local (..name)) + it (_.local (..name))] + (_.function (_.local <tuple::member>) (list) (list [//type.i64 item] [..value_type it]) ..value_type - (_.return (_.item item (_.the* <values> (host_value ..tuple_type it)))))) + (_.return (_.item item (_.the* <Tuple#values> (host_value ..tuple_type it)))))) + + (let [function::on (_.local <function::on>) + + current_arity (_.local (..name)) + arguments (_.local (..name)) + it (_.local (..name)) + + partiality (_.local (..name)) + expected_arity (_.local (..name)) + actual_arity (_.local (..name)) + + partials (is (-> _.Local _.Local _.Local _.Local + _.Local + _.Statement) + (.function (_ old_partiality old_values new_partiality new_values + output) + (let [full_partiality (_.local (..name)) + item (_.local (..name))] + (all _.then + (_.constant full_partiality + //type.arity + (_.+ old_partiality new_partiality)) + (_.constant output + (_.* ..value_type) + (_.new (_.array value_type full_partiality (list)))) + (_.for (list [type.int item (_.int +0)]) + (_.< old_partiality item) + (_.:= item (_.+ (_.int +1) item)) + (_.:= (_.item item output) + (_.item item old_values))) + (_.for (list [type.int item (_.int +0)]) + (_.< new_partiality item) + (_.:= item (_.+ (_.int +1) item)) + (_.:= (_.item (_.+ old_partiality item) output) + (_.item item new_values))) + )))) + on#exact (is (-> _.Local _.Local _.Local + _.Local + _.Statement) + (.function (_ current_arity arguments it + partiality) + (let [output (_.local (..name)) + all_arguments (_.local (..name)) + old_partials (_.local (..name))] + (_.if (_.= (_.int +0) partiality) + (all _.then + (_.constant output + ..value_type + (|> it + (host_value function_type) + (_.the* <Function#closure>) + (_.on (list it arguments)))) + (_.delete_array arguments) + (_.return output) + ) + (all _.then + (_.constant old_partials + (_.* ..value_type) + (|> it + (host_value function_type) + (_.the* <Function#partials>))) + (partials partiality old_partials current_arity arguments + all_arguments) + (_.delete_array arguments) + (_.constant output + ..value_type + (|> it + (host_value function_type) + (_.the* <Function#closure>) + (_.on (list it all_arguments)))) + (_.delete_array all_arguments) + (_.return output) + ))))) + on#under (is (-> _.Local _.Local _.Local + _.Local _.Local _.Local + _.Statement) + (.function (_ current_arity arguments it + partiality expected_arity actual_arity) + (let [all_partials (_.local (..name)) + old_partials (_.local (..name))] + (all _.then + (_.constant old_partials + (_.* ..value_type) + (|> it + (host_value function_type) + (_.the* <Function#partials>))) + (partials partiality old_partials current_arity arguments + all_partials) + (_.delete_array arguments) + (_.return (|> it + (host_value function_type) + (_.the* <Function#closure>) + (function' actual_arity all_partials expected_arity))) + )))) + on#over (is (-> _.Local _.Local _.Local + _.Local _.Local + _.Statement) + (.function (_ current_arity arguments it + old_partiality expected_arity) + (let [old_values (_.local (..name)) + cap_arity (_.local (..name)) + complete_arguments (_.local (..name)) + temporary (_.local (..name)) + new_partiality (_.local (..name)) + new_partials (_.local (..name)) + item (_.local (..name)) + + assemble_all_arguments! + (all _.then + (_.constant old_values + (_.* ..value_type) + (|> it + (host_value function_type) + (_.the* <Function#partials>))) + (_.constant cap_arity + //type.arity + (_.- old_partiality expected_arity)) + (partials old_partiality old_values cap_arity arguments + complete_arguments)) + + calculate_intermediate_result! + (all _.then + (_.constant temporary + ..value_type + (|> it + (host_value function_type) + (_.the* <Function#closure>) + (_.on (list it complete_arguments)))) + (_.delete_array complete_arguments) + ) + + prepare_next_arguments! + (all _.then + (_.constant new_partiality + //type.arity + (_.- cap_arity current_arity)) + (_.constant new_partials + (_.* ..value_type) + (_.new (_.array value_type new_partiality (list)))) + (_.for (list [type.int item (_.int +0)]) + (_.< new_partiality item) + (_.:= item (_.+ (_.int +1) item)) + (_.:= (_.item item new_partials) + (_.item (_.+ cap_arity item) arguments))) + (_.delete_array arguments) + )] + (all _.then + assemble_all_arguments! + calculate_intermediate_result! + prepare_next_arguments! + (_.return (_.on (list new_partiality new_partials temporary) + function::on)) + ))))] + (_.function function::on + (list) + (list [//type.arity current_arity] + [(_.* ..value_type) arguments] + [..value_type it]) + ..value_type + (all _.then + (_.constant partiality + //type.arity + (_.the* <Function#partiality> (host_value function_type it))) + (_.constant expected_arity + //type.arity + (_.the* <Function#arity> (host_value function_type it))) + (_.constant actual_arity + //type.arity + (_.+ current_arity partiality)) + (_.if (_.= expected_arity actual_arity) + (on#exact current_arity arguments it + partiality) + (_.if (_.< expected_arity actual_arity) + (on#under current_arity arguments it + partiality expected_arity actual_arity) + (on#over current_arity arguments it + partiality expected_arity))) + ) + )) )))))) (def .public unit diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux index 0ac6a86a6..1ea54e4a2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux @@ -56,3 +56,10 @@ (//new.instance' (..current_environment class environment) class environment arity) ////reference.this) _.areturn)})) + +(def .public (call :it: arity) + (-> (Type Class) Arity + (Bytecode Any)) + (if (arity.multiary? arity) + (_.invokevirtual :it: ..name (..type :it:)) + _.nop)) diff --git a/stdlib/source/library/lux/meta/compiler/target/c++.lux b/stdlib/source/library/lux/meta/compiler/target/c++.lux index dc080c656..b29ce98ad 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++.lux @@ -4,7 +4,7 @@ (.require [library [lux (.except Code Type Global Declaration Definition - int as function template local global type also of is) + int as function template local global type also of is if for alias) [abstract [equivalence (.only Equivalence)]] [control @@ -73,33 +73,39 @@ [Code [[Capture []] - [Type [of]] + [Parameter [of]] [Expression [of]] [Statement [of]]]] + + [Parameter + [[Type [of]]]] [Type [[Type_Name []]]] [Expression - [[Computation [of]] - [Reference [of]]]] + [[LValue [of]] + [RValue [of]]]] - [Computation - [[Literal []] - [Instantiation []]]] + [LValue + [[Reference [of]]]] [Reference [[Local []] [Global []]]] + [RValue + [[Literal []] + [Computation [of]]]] + + [Computation + [[Instantiation []]]] + [Statement [[Declaration [of]]]] [Declaration [[Definition [of]]]] - - [Definition - [[Method []]]] ) (def .public bool @@ -139,7 +145,7 @@ (|>> <%)) (def instantiation - (-> (List Type) + (-> (List Parameter) Text) (|>> (|.when (list) @@ -152,7 +158,7 @@ (text.enclosed ..template_delimiters))))) (def .public (global [ns/* name] parameters) - (-> [(List Namespace) Text] (List Type) + (-> [(List Namespace) Text] (List Parameter) Global) (<% (let [instance (%.format name (instantiation parameters))] (when ns/* @@ -166,6 +172,16 @@ Type) (|>> nominal.transmutation)) + (def .public (function_type_parameter arguments return) + (-> (List Parameter) Parameter + Parameter) + (|> arguments + (list#each ..code) + (text.interposed ..parameter_separator) + (text.enclosed ..term_delimiters) + (%.format (%> return)) + <%)) + (def .public type_name (-> Text Type_Name) @@ -185,12 +201,17 @@ (text.prefix "*") <%)) + (def term + (-> Text + Text) + (text.enclosed ..term_delimiters)) + (def .public (is type term) (-> Type Expression Computation) (<| <% - (text.enclosed ..term_delimiters) - (%.format "(" (%> type) ")" + ..term + (%.format (..term (%> type)) " " (%> term)))) (def .public int @@ -388,11 +409,16 @@ (%.format "U") <%)) - (def .public (destructor of body) - (-> Local Statement + (.type Method + (-> Local + Definition)) + + (def .public (destructor body) + (-> Statement Method) - (<% (%.format "~" (%> of) "()" - " " (block (%> body))))) + (.function (_ of) + (<% (%.format "~" (%> of) "()" + " " (block (%> body)))))) (def .public (var_declaration name type) (-> Local Type @@ -410,6 +436,11 @@ Definition) (..statement (%.format (%> type) " " (%> name) " = " (%> value)))) + (def .public (:= location value) + (-> LValue Expression + Statement) + (..statement (%.format (%> location) " = " (%> value)))) + (def .public (structure_definition name [fields methods]) (-> Local [(List [Local Type]) (List Method)] Definition) @@ -420,7 +451,8 @@ (list#each (.function (_ [name type]) (%> (var_declaration name type))) fields) - (list#each ..code + (list#each (.function (_ it) + (..code (it name))) methods)) (text.interposed \n)))))) @@ -450,11 +482,16 @@ ["&" all_by_reference] ) + (def .public (alias name original) + (-> Local Local + Capture) + (<% (%.format (%> name) " = " (%> original)))) + (def .public (lambda captures inputs output body) (-> (List Capture) (List Argument) (Maybe Type) Statement Expression) (<| <% - (text.enclosed ..term_delimiters) + ..term (%.format (..captures captures) (..arguments inputs) (|> output (maybe#each (|>> %> (%.format " -> "))) @@ -465,7 +502,7 @@ (-> Expression Expression Expression Expression) (<| <% - (text.enclosed ..term_delimiters) + ..term (%.format (%> when) " ? " (%> then) " : " (%> else)))) @@ -477,6 +514,57 @@ (def .public (item index array) (-> Expression Expression - Expression) + LValue) (<% (%.format (%> array) "[" (%> index) "]"))) + + (with_template [<name> <operator>] + [(def .public (<name> parameter subject) + (-> Expression Expression + Expression) + (|> (%.format (%> subject) <operator> (%> parameter)) + ..term + <%))] + + [+ " + "] + [- " - "] + ... [* " * "] + [/ " / "] + [% " % "] + + [= " == "] + [< " < "] + [> " > "] + [<= " <= "] + [>= " >= "] + ) + + (def .public (if when then else) + (-> Expression Statement Statement + Statement) + (<% (%.format "if" (..term (%> when)) + " " (..block (%> then)) + " else " (..block (%> else))))) + + (def (for_initialization [type variable value]) + (-> [Type Local Expression] + Text) + (%.format (%> type) " " (%> variable) " = " (%> value))) + + (def for_initializations + (-> (List [Type Local Expression]) + Text) + (|>> (list#each ..for_initialization) + (text.interposed ..parameter_separator))) + + (def .public (for inits when after body) + (-> (List [Type Local Expression]) Expression Statement Statement + Statement) + (let [setup (|> (list (for_initializations inits) + (%> when) + (|> (%> after) + (text.replaced_once ..statement_separator ""))) + (text.interposed (%.format ..statement_separator " ")) + (text.enclosed ..term_delimiters))] + (<% (%.format "for" setup + " " (..block (%> body)))))) ) diff --git a/stdlib/source/library/lux/meta/compiler/target/c++/type.lux b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux index e8365ff52..3ee6de6fb 100644 --- a/stdlib/source/library/lux/meta/compiler/target/c++/type.lux +++ b/stdlib/source/library/lux/meta/compiler/target/c++/type.lux @@ -3,7 +3,7 @@ (.require [library - [lux (.except char int) + [lux (.except char int function) [meta [macro ["[0]" template]]]]] @@ -93,3 +93,9 @@ (|>> list (/.global [(list /.standard) "shared_ptr"]) /.type)) + +(def .public (function arguments return) + (-> (List /.Parameter) /.Parameter + /.Type) + (/.type (/.global [(list /.standard) "function"] + (list (/.function_type_parameter arguments return))))) diff --git a/stdlib/source/library/lux/meta/macro/local.lux b/stdlib/source/library/lux/meta/macro/local.lux index f5eb2561d..84fbc8b91 100644 --- a/stdlib/source/library/lux/meta/macro/local.lux +++ b/stdlib/source/library/lux/meta/macro/local.lux @@ -130,12 +130,12 @@ (syntax (_ [locals (<code>.tuple (<>.some (<>.and <code>.local <code>.any))) body <code>.any]) (do [! meta.monad] - [here_name meta.current_module_name + [here meta.current_module_name locals (monad.each ! (function (_ [name value]) (|> value (meta.eval .Macro) (of ! each (|>> (as .Macro) - [[here_name name]])))) + [[here name]])))) locals) expression? (is (Meta Bit) (function (_ lux) diff --git a/stdlib/source/library/lux/meta/type/unit.lux b/stdlib/source/library/lux/meta/type/unit.lux index 0473ab18a..454fd8660 100644 --- a/stdlib/source/library/lux/meta/type/unit.lux +++ b/stdlib/source/library/lux/meta/type/unit.lux @@ -88,24 +88,24 @@ (.type .public (Unit of) (Interface - (is (-> (Measure Any of) - Text) - format) (is (-> Int (Measure Any of)) in) (is (-> (Measure Any of) Int) - out))) + out) + (is (-> (Measure Any of) + Text) + format))) (def .public (unit descriptor) (Ex (_ of) (-> Text (Unit of))) (implementation - (def format (|>> ..number %.int (text.suffix descriptor))) (def in ..measure) - (def out ..number))) + (def out ..number) + (def format (|>> ..number %.int (text.suffix descriptor))))) ) (def .public type diff --git a/stdlib/source/test/lux/math/arithmetic/fixed_point.lux b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux index 9c8fde31c..aa1288918 100644 --- a/stdlib/source/test/lux/math/arithmetic/fixed_point.lux +++ b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux @@ -20,7 +20,8 @@ [math ["[0]" random (.only Random)] [number - ["n" nat]] + ["n" nat] + ["i" int]] ["[0]" arithmetic ["[1]T" \\test]]] [test @@ -32,8 +33,8 @@ (All (_ @) (-> (/.Point @) (Random (/.Fixed @)))) - (do random.monad - [units random.int + (do [! random.monad] + [units (of ! each (i.% +1,000) random.int) sub_units random.rev] (in (/.fixed @ units sub_units)))) @@ -103,15 +104,20 @@ (/.+ @ parameter) (/.- @ parameter) (/.= @ subject))) + (_.coverage [/.*] + (and (|> subject + (/.* @ (/.of_int @ +1)) + (/.= @ subject)) + (|> subject + (/.* @ (/.of_int @ +0)) + (/.= @ (/.of_int @ +0))) + (/.= @ + (/.* @ parameter subject) + (/.* @ subject parameter)))) (_.coverage [/./] (/.= @ (/.of_int @ +1) (/./ @ expected expected))) - (_.coverage [/.* /.%] - (let [rem (/.% @ parameter subject) - div (|> subject (/.- @ rem) (/./ @ parameter))] - (/.= @ subject - (|> div (/.* @ parameter) (/.+ @ rem))))) (_.coverage [/.format] (let [it (/.format @ expected)] diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux index a1ab1b312..3e3ec7a84 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux @@ -19,7 +19,8 @@ [\\library ["[0]" /]] ["[0]" / - ["[1][0]" implementation]]) + ["[1][0]" implementation] + ["[1][0]" reset]]) (def (valid_modifier? it) (-> (Modifier Method) @@ -38,4 +39,5 @@ (modifier.has? method.strict /.modifier))) (/implementation.test valid_modifier?) + /reset.test ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux new file mode 100644 index 000000000..105161cd1 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux @@ -0,0 +1,128 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.use "[1]#[0]" functor)]] + [math + ["[0]" random (.only Random)] + [number + ["[0]" i64 (.use "[1]#[0]" equivalence)] + ["n" nat]]] + [meta + [compiler + [target + [jvm + ["[0]" modifier (.only Modifier)] + ["[0]" method (.only Method)] + ["[0]" type] + ["!" bytecode]]] + [meta + ["[0]" archive]]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + [field + [constant + ["[0]" arity]]] + ["[0]" // (.only) + ["[0]" host] + ["[0]" runtime] + [/// + ["[0]" extension] + [// + ["[0]" phase] + ["[0]" synthesis] + ["[0]" translation]]]]]]] + [//// + ["[0]T" complex]]) + +(ffi.import (java/lang/Class of) + "[1]::[0]" + (getCanonicalName [] java/lang/String)) + +(ffi.import java/lang/Object + "[1]::[0]" + (getClass [] (java/lang/Class java/lang/Object))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [module (random.lower_cased 1) + + dummy_i64 random.i64 + expected_i64 (random.only (|>> (i64#= dummy_i64) not) + random.i64) + + .let [extender (is extension.Extender + (function (_ _) + (undefined))) + next (//.translate extender complexT.lux) + @ [module 0 0]] + + arity (of ! each (|>> (n.% (-- arity.maximum)) (n.+ 2)) random.nat) + inner_arity (of ! each (|>> (n.% arity) (n.+ 1)) random.nat)]) + (all _.and + (_.coverage [/.name /.type /.method /.call] + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + parameter (next archive (synthesis.i64 @ expected_i64)) + partially_applied_function (next archive (<| (synthesis.function/apply @) + [(synthesis.function/abstraction @ [(list) 2 (synthesis.variable/local @ 1)]) + (list (synthesis.i64 @ dummy_i64))])) + it (|> partially_applied_function + [{.#None}] + (of host evaluate) + phase.of_try) + .let [class (type.class (|> it + (as java/lang/Object) + java/lang/Object::getClass + java/lang/Class::getCanonicalName + ffi.of_string) + (list))] + .let [what_happens_when_its_not_reset! + (|> partially_applied_function + [{.#None}] + (of host evaluate) + (try#each (function (_ it) + (i64#= dummy_i64 + ((as (-> I64 I64) + it) + expected_i64)))) + (try.else false) + ) + + can_reset! + (|> (do !.monad + [_ partially_applied_function] + (/.call class 2)) + [{.#None}] + (of host evaluate) + (try#each (function (_ it) + (i64#= expected_i64 + ((as (-> I64 I64 I64) + it) + expected_i64 + expected_i64)))) + (try.else false) + )]] + (in (and what_happens_when_its_not_reset! + can_reset!))))) + (try.else false))) + ))) diff --git a/stdlib/source/test/lux/meta/symbol.lux b/stdlib/source/test/lux/meta/symbol.lux index f7c2d7db4..b6aca8568 100644 --- a/stdlib/source/test/lux/meta/symbol.lux +++ b/stdlib/source/test/lux/meta/symbol.lux @@ -29,10 +29,26 @@ ["[0]" /]]) (def .public (random module_size short_size) - (-> Nat Nat (Random Symbol)) + (-> Nat Nat + (Random Symbol)) (random.and (random.alphabetic module_size) (random.alphabetic short_size))) +(def .public (relative module short_size) + (-> Text Nat + (Random Symbol)) + (do [! random.monad] + [relative? random.bit + short (random.alphabetic short_size)] + (if relative? + (do ! + [in_prelude? random.bit] + (in [(if in_prelude? + .prelude + "") + short])) + (in [module short])))) + (def .public test Test (<| (_.covering /._) @@ -56,11 +72,9 @@ (_.for [/.order] (orderT.spec /.order (..random sizeM1 sizeS1))) (_.for [/.absolute] - (_.and (codecT.spec /.equivalence /.absolute (..random sizeM1 sizeS1)) - (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." - (if (text.empty? module1) - (same? short1 (of /.absolute encoded symbol1)) - true)))) + (codecT.spec /.equivalence /.absolute (..relative module1 sizeS1))) + (_.for [/.relative] + (codecT.spec /.equivalence (/.relative module1) (..relative module1 sizeS1))) (_.coverage [/.separator] (let [it (of /.absolute encoded symbol1)] @@ -73,7 +87,7 @@ (_.for [.symbol] (let [(open "/#[0]") /.equivalence] (all _.and - (_.test "Can obtain Symbol from a symbol." + (_.test "Can obtain a Symbol from a symbol." (and (/#= [.prelude "yolo"] (.symbol .yolo)) (/#= ["test/lux/meta/symbol" "yolo"] (.symbol ..yolo)) (/#= ["" "yolo"] (.symbol yolo)) diff --git a/stdlib/source/test/lux/meta/type/unit.lux b/stdlib/source/test/lux/meta/type/unit.lux index 0b166b9c6..8db2a66c4 100644 --- a/stdlib/source/test/lux/meta/type/unit.lux +++ b/stdlib/source/test/lux/meta/type/unit.lux @@ -62,7 +62,8 @@ Test (do random.monad [expected random.int] - (_.for [/.Unit] + (_.for [/.Unit + /.in /.out /.format] (`` (all _.and (,, (with_template [<type> <unit>] [(_.coverage [<type> <unit>] |