diff --git a/README.md b/README.md index 0b928f1e9..dc1c21bec 100644 --- a/README.md +++ b/README.md @@ -98,9 +98,9 @@ Then, select one of the following targets and `make` it according to your purpos | Target | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.304.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.308.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.304_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.304_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.308_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.308_amd64.deb`. | `test` | Test executable `meevax`. This target requires Valgrind to be installed. | `uninstall` | Remove files copied to `/usr/local` directly by target `install`. diff --git a/VERSION b/VERSION index 053f8ec38..eee70f4b6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.304 +0.5.308 diff --git a/include/meevax/kernel/complex.hpp b/include/meevax/kernel/complex.hpp index 108681df1..22ea5b31a 100644 --- a/include/meevax/kernel/complex.hpp +++ b/include/meevax/kernel/complex.hpp @@ -41,14 +41,6 @@ namespace meevax::inline kernel }; auto operator <<(std::ostream &, complex const&) -> std::ostream &; - - auto real_part(object const&) -> object const&; - - auto imag_part(object const&) -> object const&; - - auto magnitude(object const&) -> object; - - auto angle(object const&) -> object; } // namespace meevax::kernel #endif // INCLUDED_MEEVAX_KERNEL_COMPLEX_HPP diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 4e5aaf229..b6ea8f105 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -337,6 +337,14 @@ inline namespace number auto pow(object const&, object const&) -> object; + auto real(object const&) -> object; + + auto imag(object const&) -> object; + + auto magnitude(object const&) -> object; + + auto angle(object const&) -> object; + auto numerator(object const&) -> object; auto denominator(object const&) -> object; diff --git a/include/meevax/kernel/syntactic_environment.hpp b/include/meevax/kernel/syntactic_environment.hpp index ff844d2dc..c6839581c 100644 --- a/include/meevax/kernel/syntactic_environment.hpp +++ b/include/meevax/kernel/syntactic_environment.hpp @@ -146,8 +146,6 @@ namespace meevax::inline kernel object const& /* continuation */, bool /* tail */) -> object; - static inline std::unordered_map contexts; - template explicit syntax(std::string const& name, Expander const& expand, Generator const& generate) : describable { name } @@ -155,44 +153,6 @@ namespace meevax::inline kernel , generate { generate } {} - struct constructor : private object - { - explicit constructor(let const& form) - : object { form } - {} - - template - auto cons(let const& a, - let const& b, Ts&&... xs) const - { - auto cons2 = [&](let const& a, let const& b) - { - let const& x = meevax::cons(a, b); - contexts[x.get()] = *this; - return x; - }; - - if constexpr (0 < sizeof...(Ts)) - { - return cons2(a, cons(b, std::forward(xs)...)); - } - else - { - return cons2(a, b); - } - } - - template - auto list(Ts&&... xs) const -> decltype(auto) - { - return cons(std::forward(xs)..., unit); - } - }; - - #define CONS typename syntax::constructor(form).cons - - #define LIST typename syntax::constructor(form).list - friend auto operator <<(std::ostream & os, syntax const& datum) -> std::ostream & { return os << magenta("#,(") << green("syntax ") << datum.name << magenta(")"); @@ -219,7 +179,7 @@ namespace meevax::inline kernel static EXPANDER(call) { - return CONS(expander.expand(car(form), + return cons(expander.expand(car(form), bound_variables, rename), operand(expander, @@ -232,7 +192,7 @@ namespace meevax::inline kernel { if (form.is()) { - return CONS(expander.expand(car(form), + return cons(expander.expand(car(form), bound_variables, rename), operand(expander, @@ -250,8 +210,8 @@ namespace meevax::inline kernel { let const& formals = rename(cadr(form)); - return CONS(rename(car(form)) /* lambda */, - CONS(formals, + return cons(rename(car(form)) /* lambda */, + cons(formals, body(expander, cddr(form), cons(formals, bound_variables), @@ -283,7 +243,7 @@ namespace meevax::inline kernel if (not variable.is()) // The binding-spec is not an internal syntax definition. { - body = CONS(CONS(corename("set!"), binding_spec), body); + body = cons(cons(corename("set!"), binding_spec), body); } } @@ -299,7 +259,7 @@ namespace meevax::inline kernel } } - return expander.expand(LIST(CONS(CONS(corename("lambda"), + return expander.expand(list(cons(cons(corename("lambda"), formals, body), make_list(length(binding_specs), unit))), @@ -308,7 +268,7 @@ namespace meevax::inline kernel } else if (sequence.template is()) { - return CONS(expander.expand(car(sequence), + return cons(expander.expand(car(sequence), bound_variables, rename), body(expander, @@ -324,7 +284,7 @@ namespace meevax::inline kernel static EXPANDER(conditional) { - return CONS(rename(car(form)), + return cons(rename(car(form)), operand(expander, cdr(form), bound_variables, @@ -333,7 +293,7 @@ namespace meevax::inline kernel static EXPANDER(set) { - return CONS(rename(car(form)), + return cons(rename(car(form)), operand(expander, cdr(form), bound_variables, @@ -342,7 +302,7 @@ namespace meevax::inline kernel static EXPANDER(include) { - return expander.expand(CONS(corename("begin"), + return expander.expand(cons(corename("begin"), meevax::include(cadr(form))), bound_variables, rename); @@ -350,7 +310,7 @@ namespace meevax::inline kernel static EXPANDER(include_case_insensitive) { - return expander.expand(CONS(corename("begin"), + return expander.expand(cons(corename("begin"), meevax::include(cadr(form), false)), bound_variables, rename); @@ -358,7 +318,7 @@ namespace meevax::inline kernel static EXPANDER(conditional_expand) { - return expander.expand(CONS(corename("begin"), + return expander.expand(cons(corename("begin"), meevax::conditional_expand(cdr(form))), bound_variables, rename); @@ -368,10 +328,10 @@ namespace meevax::inline kernel { let const extended_bound_variables = cons(map(car, cadr(form)), bound_variables); - return CONS(car(form), + return cons(car(form), map([&](let const& binding) { - return LIST(car(binding), + return list(car(binding), expander.expand(cadr(binding), extended_bound_variables, rename)); @@ -387,7 +347,7 @@ namespace meevax::inline kernel { if (form.is()) { - return CONS(expander.expand(car(form), + return cons(expander.expand(car(form), bound_variables, rename), sequence(expander, @@ -414,7 +374,7 @@ namespace meevax::inline kernel let const formals = map(formal, cadr(form)); - return expander.expand(LIST(CONS(corename("lambda"), + return expander.expand(list(cons(corename("lambda"), formals, cddr(form) /* body */)), bound_variables, @@ -436,7 +396,7 @@ namespace meevax::inline kernel car(current_environment) = cons(formals, bound_variables); - return expander.expand(LIST(CONS(corename("lambda"), + return expander.expand(list(cons(corename("lambda"), formals, cddr(form) /* body */)), bound_variables, @@ -449,9 +409,9 @@ namespace meevax::inline kernel { if (cadr(form).is()) // (define ( . ) ) { - return LIST(rename(car(form)), + return list(rename(car(form)), caadr(form) /* variable */, - expander.expand(CONS(corename("lambda"), + expander.expand(cons(corename("lambda"), cdadr(form) /* formals */, cddr(form) /* body */), bound_variables, @@ -459,9 +419,9 @@ namespace meevax::inline kernel } else // (define ) { - return CONS(rename(car(form)), + return cons(rename(car(form)), cadr(form), - cddr(form) ? LIST(expander.expand(caddr(form), + cddr(form) ? list(expander.expand(caddr(form), bound_variables, rename)) : unit); @@ -475,7 +435,7 @@ namespace meevax::inline kernel static EXPANDER(define_syntax) { - return LIST(rename(car(form)), + return list(rename(car(form)), cadr(form), expander.expand(caddr(form), bound_variables, @@ -484,7 +444,7 @@ namespace meevax::inline kernel static EXPANDER(call_with_current_continuation) { - return CONS(rename(car(form)), + return cons(rename(car(form)), operand(expander, cdr(form), bound_variables, @@ -493,7 +453,7 @@ namespace meevax::inline kernel static EXPANDER(current) { - return CONS(rename(car(form)), + return cons(rename(car(form)), operand(expander, cdr(form), bound_variables, @@ -502,7 +462,7 @@ namespace meevax::inline kernel static EXPANDER(install) { - return CONS(rename(car(form)), + return cons(rename(car(form)), operand(expander, cdr(form), bound_variables, @@ -523,14 +483,14 @@ namespace meevax::inline kernel static GENERATOR(quote) { - return CONS(make(instruction::load_constant), car(form).is() ? car(form).as().form + return cons(make(instruction::load_constant), car(form).is() ? car(form).as().form : car(form), continuation); } static GENERATOR(quote_syntax) { - return CONS(make(instruction::load_constant), car(form), + return cons(make(instruction::load_constant), car(form), continuation); } @@ -541,8 +501,8 @@ namespace meevax::inline kernel bound_variables, generator.generate(car(form), bound_variables, - tail ? LIST(make(instruction::tail_call)) - : CONS(make(instruction::call), continuation))); + tail ? list(make(instruction::tail_call)) + : cons(make(instruction::call), continuation))); } static GENERATOR(operand) @@ -554,7 +514,7 @@ namespace meevax::inline kernel bound_variables, generator.generate(car(form), bound_variables, - CONS(make(instruction::cons), + cons(make(instruction::cons), continuation))); } else @@ -565,11 +525,11 @@ namespace meevax::inline kernel static GENERATOR(lambda) { - return CONS(make(instruction::load_closure), + return cons(make(instruction::load_closure), body(generator, cdr(form), cons(car(form), bound_variables), // Extend scope. - LIST(make(instruction::return_))), + list(make(instruction::return_))), continuation); } @@ -586,7 +546,7 @@ namespace meevax::inline kernel { return generator.generate(car(form), bound_variables, - CONS(make(instruction::drop), + cons(make(instruction::drop), body(generator, cdr(form), bound_variables, @@ -603,7 +563,7 @@ namespace meevax::inline kernel return generator.generate(car(form), // bound_variables, - LIST(make(instruction::tail_select), + list(make(instruction::tail_select), generator.generate(cadr(form), bound_variables, continuation, @@ -612,21 +572,21 @@ namespace meevax::inline kernel bound_variables, continuation, tail) - : LIST(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. + : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. make(instruction::return_)))); } else { return generator.generate(car(form), // bound_variables, - CONS(make(instruction::select), + cons(make(instruction::select), generator.generate(cadr(form), bound_variables, - LIST(make(instruction::join))), + list(make(instruction::join))), cddr(form) ? generator.generate(caddr(form), bound_variables, - LIST(make(instruction::join))) - : LIST(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. + list(make(instruction::join))) + : list(make(instruction::load_constant), unspecified, // If yields a false value and no is specified, then the result of the expression is unspecified. make(instruction::join)), continuation)); } @@ -638,14 +598,14 @@ namespace meevax::inline kernel { return generator.generate(cadr(form), bound_variables, - CONS(make(instruction::store_relative), identity, + cons(make(instruction::store_relative), identity, continuation)); } else if (identity.is()) { return generator.generate(cadr(form), bound_variables, - CONS(make(instruction::store_variadic), identity, + cons(make(instruction::store_variadic), identity, continuation)); } else @@ -654,7 +614,7 @@ namespace meevax::inline kernel return generator.generate(cadr(form), bound_variables, - CONS(make(instruction::store_absolute), identity, + cons(make(instruction::store_absolute), identity, continuation)); } } @@ -671,15 +631,15 @@ namespace meevax::inline kernel let const formals = map(car, car(form)); - return CONS(make(instruction::dummy), + return cons(make(instruction::dummy), operand(generator, map(cadr, car(form)), cons(formals, bound_variables), lambda(generator, cons(formals, cdr(form)), // ( ) bound_variables, - tail ? LIST(make(instruction::tail_letrec)) - : CONS(make(instruction::letrec), continuation)))); + tail ? list(make(instruction::tail_letrec)) + : cons(make(instruction::letrec), continuation)))); } static GENERATOR(sequence) @@ -706,7 +666,7 @@ namespace meevax::inline kernel bound_variables, unit); return append(head, - CONS(make(instruction::drop), // Pop result of head expression + cons(make(instruction::drop), // Pop result of head expression sequence(generator, cdr(form), // Rest expression or definitions bound_variables, @@ -727,7 +687,7 @@ namespace meevax::inline kernel return generator.generate(cdr(form) ? cadr(form) : unspecified, bound_variables, - CONS(make(instruction::store_absolute), generator.identify(car(form), bound_variables), + cons(make(instruction::store_absolute), generator.identify(car(form), bound_variables), continuation)); } @@ -740,7 +700,7 @@ namespace meevax::inline kernel make(bound_variables, generator.second)); - return CONS(make(instruction::load_constant), unspecified, + return cons(make(instruction::load_constant), unspecified, continuation); } @@ -749,17 +709,17 @@ namespace meevax::inline kernel assert(form.is()); assert(cdr(form).is()); - return CONS(make(instruction::load_continuation), + return cons(make(instruction::load_continuation), continuation, generator.generate(car(form), bound_variables, - LIST(make(instruction::tail_call)), // The first argument passed to call-with-current-continuation must be called via a tail call. + list(make(instruction::tail_call)), // The first argument passed to call-with-current-continuation must be called via a tail call. tail)); } static GENERATOR(current) { - return CONS(make(instruction::current), car(form), + return cons(make(instruction::current), car(form), continuation); } @@ -767,7 +727,7 @@ namespace meevax::inline kernel { return generator.generate(cadr(form), bound_variables, - CONS(make(instruction::install), car(form), + cons(make(instruction::install), car(form), continuation)); } @@ -888,14 +848,12 @@ namespace meevax::inline kernel assert(cadr(identity).is()); assert(cddr(identity).is()); - let const transformed = Environment().apply(cadr(identity), - form, - make(bound_variables, second), - cddr(identity)); - - syntax::contexts[transformed.get()] = form; - - return expand(transformed, bound_variables, rename); + return expand(Environment().apply(cadr(identity), + form, + make(bound_variables, second), + cddr(identity)), + bound_variables, + rename); } else if (cdr(identity).is()) { @@ -924,21 +882,21 @@ namespace meevax::inline kernel if (let const& identity = identify(form, bound_variables); identity.is()) { - return CONS(make(instruction::load_relative), identity, continuation); + return cons(make(instruction::load_relative), identity, continuation); } else if (identity.is()) { - return CONS(make(instruction::load_variadic), identity, continuation); + return cons(make(instruction::load_variadic), identity, continuation); } else { assert(identity.is()); - return CONS(make(instruction::load_absolute), identity, continuation); + return cons(make(instruction::load_absolute), identity, continuation); } } else // is { - return CONS(make(instruction::load_constant), form, continuation); + return cons(make(instruction::load_constant), form, continuation); } } else if (let const& identity = std::as_const(*this).identify(car(form), bound_variables); identity.is() and cdr(identity).is()) diff --git a/include/meevax/type_traits/is_array_subscriptable.hpp b/include/meevax/type_traits/is_array_subscriptable.hpp deleted file mode 100644 index c608fda05..000000000 --- a/include/meevax/type_traits/is_array_subscriptable.hpp +++ /dev/null @@ -1,40 +0,0 @@ -/* - Copyright 2018-2024 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#ifndef INCLUDED_MEEVAX_TYPE_TRAITS_IS_ARRAY_SUBSCRIPTABLE_HPP -#define INCLUDED_MEEVAX_TYPE_TRAITS_IS_ARRAY_SUBSCRIPTABLE_HPP - -#include - -namespace meevax::inline type_traits -{ - template - [[deprecated]] - struct is_array_subscriptable : public std::false_type - {}; - - template - [[deprecated]] - struct is_array_subscriptable()[std::declval()])>> - : public std::true_type - {}; - - template - [[deprecated]] - inline constexpr auto is_array_subscriptable_v = is_array_subscriptable::value; -} // namespace meevax::type_traits - -#endif // INCLUDED_MEEVAX_TYPE_TRAITS_IS_ARRAY_SUBSCRIPTABLE_HPP diff --git a/include/meevax/type_traits/is_dereferenceable.hpp b/include/meevax/type_traits/is_dereferenceable.hpp deleted file mode 100644 index 381b7fa2c..000000000 --- a/include/meevax/type_traits/is_dereferenceable.hpp +++ /dev/null @@ -1,37 +0,0 @@ -/* - Copyright 2018-2024 Tatsuya Yamasaki. - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*/ - -#ifndef INCLUDED_MEEVAX_TYPE_TRAITS_IS_DEREFERENCEABLE_HPP -#define INCLUDED_MEEVAX_TYPE_TRAITS_IS_DEREFERENCEABLE_HPP - -#include - -namespace meevax::inline type_traits -{ - template - [[deprecated]] - struct is_dereferenceable - : public std::false_type - {}; - - template - [[deprecated]] - struct is_dereferenceable())>> - : public std::true_type - {}; -} // namespace meevax::type_traits - -#endif // INCLUDED_MEEVAX_TYPE_TRAITS_IS_DEREFERENCEABLE_HPP diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 90aba7752..a7e9b6c46 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -287,8 +287,8 @@ namespace meevax::inline kernel EXPORT1(angle); EXPORT1(magnitude); - EXPORT1_RENAME(imag_part, "imag-part"); - EXPORT1_RENAME(real_part, "real-part"); + EXPORT1_RENAME(imag, "imag-part"); + EXPORT1_RENAME(real, "real-part"); }); define("(meevax context)", [](library & library) diff --git a/src/kernel/complex.cpp b/src/kernel/complex.cpp index 4a7ff74a7..ad2d95e8e 100644 --- a/src/kernel/complex.cpp +++ b/src/kernel/complex.cpp @@ -140,31 +140,4 @@ namespace meevax::inline kernel return os << z.real() << cyan(explicitly_signed(z.imag()), "i"); } } - - auto real_part(object const& x) -> object const& - { - return x.is() ? car(x) : x; - } - - auto imag_part(object const& x) -> object const& - { - return x.is() ? cdr(x) : e0; - } - - auto magnitude(object const& x) -> object - { - auto hypotenuse = [](let const& x, let const& y) - { - return sqrt(x * x + y * y); - }; - - return hypotenuse(real_part(x), - imag_part(x)); - } - - auto angle(object const& x) -> object - { - return atan2(real_part(x), - imag_part(x)); - } } // namespace meevax::kernel diff --git a/src/kernel/error.cpp b/src/kernel/error.cpp index c3d5aa776..d1b0c5ffe 100644 --- a/src/kernel/error.cpp +++ b/src/kernel/error.cpp @@ -42,23 +42,6 @@ namespace meevax::inline kernel throw *this; } - struct syntactic_context_of : private object - { - explicit syntactic_context_of(let const& c) - : object { c } - {} - - friend auto operator <<(std::ostream & output, syntactic_context_of const& c) -> std::ostream & - { - for (auto context = environment::syntax::contexts.find(c.get()); context != environment::syntax::contexts.end(); context = environment::syntax::contexts.find(context->second.get())) - { - output << " ; " << context->second; - } - - return output; - } - }; - auto disassemble(std::ostream & output, let const& c, std::size_t depth = 0) -> void { assert(c.is()); @@ -71,7 +54,7 @@ namespace meevax::inline kernel case instruction::tail_letrec: case instruction::return_: case instruction::stop: - output << std::string(depth, ' ') << car(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << '\n'; assert(cdr(c).is()); break; @@ -80,7 +63,7 @@ namespace meevax::inline kernel case instruction::drop: case instruction::dummy: case instruction::letrec: - output << std::string(depth, ' ') << car(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << '\n'; disassemble(output, cdr(c), depth); break; @@ -93,26 +76,26 @@ namespace meevax::inline kernel case instruction::store_absolute: case instruction::store_relative: case instruction::store_variadic: - output << std::string(depth, ' ') << car(c) << ' ' << cadr(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << ' ' << cadr(c) << '\n'; disassemble(output, cddr(c), depth); break; case instruction::load_closure: case instruction::load_continuation: - output << std::string(depth, ' ') << car(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << '\n'; disassemble(output, cadr(c), depth + 2); disassemble(output, cddr(c), depth); break; case instruction::select: - output << std::string(depth, ' ') << car(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << '\n'; disassemble(output, cadr(c), depth + 2); disassemble(output, caddr(c), depth + 2); disassemble(output, cdddr(c), depth); break; case instruction::tail_select: - output << std::string(depth, ' ') << car(c) << syntactic_context_of(c) << '\n'; + output << std::string(depth, ' ') << car(c) << '\n'; disassemble(output, cadr(c), depth + 2); disassemble(output, caddr(c), depth + 2); break; @@ -128,7 +111,6 @@ namespace meevax::inline kernel switch (doing) { case in::running: - // disassemble(output, car(x)); // Disabled as it is still experimental and does not produce any useful output. [[fallthrough]]; case in::expanding: diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 6c79b5711..b4c8cf46d 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -847,6 +847,62 @@ inline namespace number return apply_to(f, x, y); } + auto real(object const& x) -> object + { + auto f = [](T const& x) + { + if constexpr (std::is_same_v) + { + return x.real(); + } + else + { + return x; + } + }; + + return apply_to(f, x); + } + + auto imag(object const& x) -> object + { + auto f = [](T const& x) + { + if constexpr (std::is_same_v) + { + return x.imag(); + } + else + { + return e0; + } + }; + + return apply_to(f, x); + } + + auto magnitude(object const& x) -> object + { + auto f = [](T const& x) + { + if constexpr (std::is_same_v) + { + return sqrt(x.real() * x.real() + x.imag() * x.imag()); + } + else + { + return x; + } + }; + + return apply_to(f, x); + } + + auto angle(object const& x) -> object + { + return atan2(real(x), imag(x)); + } + auto numerator(object const& x) -> object { if (x.is())