From 70aa7154e64c0ab2352c00e5f993e88737929ccc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 25 Jan 2023 17:40:20 -0400 Subject: Can now compile functions (and apply them) in C++. --- .../test/lux/math/arithmetic/fixed_point.lux | 22 ++-- .../lux/phase/translation/jvm/function/method.lux | 4 +- .../translation/jvm/function/method/reset.lux | 128 +++++++++++++++++++++ stdlib/source/test/lux/meta/symbol.lux | 28 +++-- stdlib/source/test/lux/meta/type/unit.lux | 3 +- 5 files changed, 168 insertions(+), 17 deletions(-) create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/reset.lux (limited to 'stdlib/source/test') 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 [ ] [(_.coverage [ ] -- cgit v1.2.3