aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2023-01-25 17:40:20 -0400
committerEduardo Julian2023-01-25 17:40:20 -0400
commit70aa7154e64c0ab2352c00e5f993e88737929ccc (patch)
tree209c6c14946900ed845f71e22b83dec1cfef678b
parentf19f246aad0bce5449b89d5b0c7bb2596c9e1e41 (diff)
Can now compile functions (and apply them) in C++.
-rw-r--r--lux-c++/source/program.lux16
-rw-r--r--stdlib/source/library/lux/math/arithmetic/fixed_point.lux104
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++.lux11
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/function.lux59
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/reference.lux5
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/c++/runtime.lux363
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux7
-rw-r--r--stdlib/source/library/lux/meta/compiler/target/c++.lux132
-rw-r--r--stdlib/source/library/lux/meta/compiler/target/c++/type.lux8
-rw-r--r--stdlib/source/library/lux/meta/macro/local.lux4
-rw-r--r--stdlib/source/library/lux/meta/type/unit.lux12
-rw-r--r--stdlib/source/test/lux/math/arithmetic/fixed_point.lux22
-rw-r--r--stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux4
-rw-r--r--stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux128
-rw-r--r--stdlib/source/test/lux/meta/symbol.lux28
-rw-r--r--stdlib/source/test/lux/meta/type/unit.lux3
16 files changed, 767 insertions, 139 deletions
diff --git a/lux-c++/source/program.lux b/lux-c++/source/program.lux
index 3f734b572..1094c455a 100644
--- a/lux-c++/source/program.lux
+++ b/lux-c++/source/program.lux
@@ -131,7 +131,7 @@
[variant_right? Bit]
[variant_choice Value]
- [tuple_arity Nat]
+ [tuple::arity Nat]
)
(def (lux_variant lefts right? choice)
@@ -145,23 +145,23 @@
(array.has! 2 choice)
..tuple))
-(def (tuple_member @ member it)
+(def (tuple::member @ member it)
(-> Runtime Nat Any
Value)
(let [on (as (-> Nat Any
Value)
- (getattr @ /runtime.tuple_member))]
+ (getattr @ /runtime.tuple::member))]
(on member it)))
(def (lux_tuple @ lux_value input)
(-> Runtime (-> Runtime Any Value) Any
Any)
- (let [arity (tuple_arity @ input)]
+ (let [arity (tuple::arity @ input)]
(loop (next [member 0
output (array.empty arity)])
(if (n.< arity member)
(next (++ member)
- (array.has! member (lux_value @ (tuple_member @ member input))
+ (array.has! member (lux_value @ (tuple::member @ member input))
output))
output))))
@@ -188,12 +188,12 @@
/runtime.tuple_tag
(lux_tuple @ lux_value it)
- ... /runtime.function_tag
+ /runtime.function_tag
+ it
tag
(panic! (when tag
2 "F64"
- 6 "FUNCTION"
_ "???"))))
(def host
@@ -290,7 +290,7 @@
(def _
(program [service cli.service]
- (let [context (context.jvm (cli.target service))]
+ (let [context (context.c++ (cli.target service))]
(exec
(do async.monad
[[host platform] (async.future ..platform)
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>]