From c863c21debe4dc300ab1735a51c93f2f235fc686 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 21 Dec 2024 23:29:13 +0900 Subject: [PATCH] Cleanup Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- basis/srfi-144.ss | 40 +++--- include/meevax/kernel/exact_integer.hpp | 2 +- include/meevax/kernel/number.hpp | 22 ++-- src/kernel/boot.cpp | 166 ++++++------------------ src/kernel/complex.cpp | 6 +- src/kernel/exact_integer.cpp | 2 +- src/kernel/number.cpp | 104 +++++++-------- test/srfi-144.ss | 4 +- 10 files changed, 137 insertions(+), 215 deletions(-) diff --git a/README.md b/README.md index 1268249fb..d12cc2bb0 100644 --- a/README.md +++ b/README.md @@ -97,9 +97,9 @@ Then, select one of the following targets and `make` it according to your purpos | Target | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.299.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.300.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.299_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.299_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.300_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.300_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 bbaa11a78..a5d628e4b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.299 +0.5.300 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 7bee5f148..c77bf622d 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -1,10 +1,8 @@ (define-library (srfi 144) (import (only (meevax binary64) FP_FAST_FMA - binary64-abs binary64-denormalized? binary64-epsilon - binary64-expm1 binary64-exponent binary64-fractional-part binary64-fused-multiply-add @@ -13,7 +11,6 @@ binary64-integral-part binary64-least binary64-log-binary - binary64-log1p binary64-max binary64-min binary64-normalized-fraction @@ -26,7 +23,7 @@ acosh asinh atanh - copy-sign + copysign cosh cyl_bessel_j cyl_neumann @@ -34,14 +31,17 @@ erf erfc euler - gamma - load-exponent - log-gamma - next-after + expm1 + fabs + ldexp + lgamma + log1p + nextafter phi pi sinh tanh + tgamma ) (only (scheme base) * @@ -200,11 +200,11 @@ (define fl-cos-1 (cos 1)) - (define fl-gamma-1/2 (gamma (/ 1 2))) + (define fl-gamma-1/2 (tgamma (/ 1 2))) - (define fl-gamma-1/3 2.67893853470774763) ; (define fl-gamma-1/3 (gamma (/ 1 3))) yields 1 ULP error + (define fl-gamma-1/3 2.67893853470774763) ; (define fl-gamma-1/3 (tgamma (/ 1 3))) yields 1 ULP error - (define fl-gamma-2/3 (gamma (/ 2 3))) + (define fl-gamma-2/3 (tgamma (/ 2 3))) (define fl-greatest binary64-greatest) @@ -220,11 +220,11 @@ (define flonum inexact) - (define fladjacent next-after) + (define fladjacent nextafter) - (define flcopysign copy-sign) + (define flcopysign copysign) - (define make-flonum load-exponent) + (define make-flonum ldexp) (define (flinteger-fraction x) (values (binary64-integral-part x) @@ -295,7 +295,7 @@ (define fl/ /) - (define flabs binary64-abs) + (define flabs fabs) (define (flabsdiff x y) (flabs (- x y))) @@ -323,7 +323,7 @@ (define (flexp2 x) (expt 2 x)) - (define flexp-1 binary64-expm1) + (define flexp-1 expm1) (define flsquare square) @@ -340,7 +340,7 @@ (define fllog log) - (define fllog1+ binary64-log1p) + (define fllog1+ log1p) (define (fllog2 x) (log x 2)) @@ -385,11 +385,11 @@ (values (car rq) (cdr rq)))) - (define flgamma gamma) + (define flgamma tgamma) (define (flloggamma x) - (values (log-gamma x) - (if (positive? (gamma x)) 1.0 -1.0))) + (values (lgamma x) + (if (positive? (tgamma x)) 1.0 -1.0))) (define flfirst-bessel cyl_bessel_j) diff --git a/include/meevax/kernel/exact_integer.hpp b/include/meevax/kernel/exact_integer.hpp index 2f989d0ae..e4f417185 100644 --- a/include/meevax/kernel/exact_integer.hpp +++ b/include/meevax/kernel/exact_integer.hpp @@ -83,7 +83,7 @@ namespace meevax::inline kernel } } - auto square_root() const -> std::tuple; + auto sqrt() const -> std::tuple; }; #define DEFINE_COMPARISON_OPERATOR(SYMBOL) \ diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 5a69452f8..4e5aaf229 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -333,7 +333,7 @@ inline namespace number auto lcm(object const&, object const&) -> object; - auto square_root(object const&) -> object; + auto sqrt(object const&) -> object; auto pow(object const&, object const&) -> object; @@ -341,7 +341,7 @@ inline namespace number auto denominator(object const&) -> object; - auto load_exponent(object const&, object const&) -> object; + auto ldexp(object const&, object const&) -> object; auto number_to_string(object const&, int) -> object; @@ -365,7 +365,7 @@ inline namespace number auto atan(object const&) -> object; - auto atan(object const&, object const&) -> object; + auto atan2(object const&, object const&) -> object; auto sinh(object const&) -> object; @@ -383,17 +383,23 @@ inline namespace number auto log(object const&) -> object; - auto gamma(object const&) -> object; + auto fabs(object const&) -> object; + + auto expm1(object const&) -> object; + + auto log1p(object const&) -> object; + + auto tgamma(object const&) -> object; + + auto lgamma(object const&) -> object; auto erf(object const&) -> object; auto erfc(object const&) -> object; - auto log_gamma(object const&) -> object; - - auto copy_sign(object const&, object const&) -> object; + auto copysign(object const&, object const&) -> object; - auto next_after(object const&, object const&) -> object; + auto nextafter(object const&, object const&) -> object; auto cyl_bessel_j(object const&, object const&) -> object; diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 14d15af82..d8a521f80 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -42,6 +42,18 @@ namespace meevax::inline kernel { auto boot() -> void { + #define EXPORT1(IDENTIFIER) \ + library.define(#IDENTIFIER, [](let const& xs) \ + { \ + return IDENTIFIER(car(xs)); \ + }) + + #define EXPORT2(IDENTIFIER) \ + library.define(#IDENTIFIER, [](let const& xs) \ + { \ + return IDENTIFIER(car(xs), cadr(xs)); \ + }) + define("(meevax boolean)", [](library & library) { library.define("boolean?", [](let const& xs) @@ -445,16 +457,6 @@ namespace meevax::inline kernel return is_nan(car(xs)); }); - library.define("exp", [](let const& xs) - { - return exp(car(xs)); - }); - - library.define("sqrt", [](let const& xs) - { - return square_root(car(xs)); - }); - library.define("log", [](let const& xs) { switch (length(xs)) @@ -470,31 +472,6 @@ namespace meevax::inline kernel } }); - library.define("sin", [](let const& xs) - { - return sin(car(xs)); - }); - - library.define("cos", [](let const& xs) - { - return cos(car(xs)); - }); - - library.define("tan", [](let const& xs) - { - return tan(car(xs)); - }); - - library.define("asin", [](let const& xs) - { - return asin(car(xs)); - }); - - library.define("acos", [](let const& xs) - { - return acos(car(xs)); - }); - library.define("atan", [](let const& xs) { switch (length(xs)) @@ -503,87 +480,39 @@ namespace meevax::inline kernel return atan(car(xs)); case 2: - return atan(car(xs), cadr(xs)); + return atan2(car(xs), cadr(xs)); default: throw error(make("procedure atan takes one or two arguments, but got"), xs); } }); - library.define("sinh", [](let const& xs) - { - return sinh(car(xs)); - }); - - library.define("cosh", [](let const& xs) - { - return cosh(car(xs)); - }); - - library.define("tanh", [](let const& xs) - { - return tanh(car(xs)); - }); - - library.define("asinh", [](let const& xs) - { - return asinh(car(xs)); - }); - - library.define("acosh", [](let const& xs) - { - return acosh(car(xs)); - }); - - library.define("atanh", [](let const& xs) - { - return atanh(car(xs)); - }); - - library.define("gamma", [](let const& xs) - { - return gamma(car(xs)); - }); - - library.define("log-gamma", [](let const& xs) - { - return log_gamma(car(xs)); - }); - - library.define("next-after", [](let const& xs) - { - return next_after(car(xs), cadr(xs)); - }); - - library.define("copy-sign", [](let const& xs) - { - return copy_sign(car(xs), cadr(xs)); - }); - - library.define("load-exponent", [](let const& xs) - { - return load_exponent(car(xs), cadr(xs)); - }); - - library.define("cyl_bessel_j", [](let const& xs) - { - return cyl_bessel_j(car(xs), cadr(xs)); - }); - - library.define("cyl_neumann", [](let const& xs) - { - return cyl_neumann(car(xs), cadr(xs)); - }); - - library.define("erf", [](let const& xs) - { - return erf(car(xs)); - }); - - library.define("erfc", [](let const& xs) - { - return erfc(car(xs)); - }); + EXPORT1(acos); + EXPORT1(acosh); + EXPORT1(asin); + EXPORT1(asinh); + EXPORT1(atanh); + EXPORT1(cos); + EXPORT1(cosh); + EXPORT1(erf); + EXPORT1(erfc); + EXPORT1(exp); + EXPORT1(expm1); + EXPORT1(fabs); + EXPORT1(lgamma); + EXPORT1(log1p); + EXPORT1(sin); + EXPORT1(sinh); + EXPORT1(sqrt); + EXPORT1(tan); + EXPORT1(tanh); + EXPORT1(tgamma); + + EXPORT2(copysign); + EXPORT2(cyl_bessel_j); + EXPORT2(cyl_neumann); + EXPORT2(ldexp); + EXPORT2(nextafter); library.define("e", std::numbers::e); @@ -701,21 +630,6 @@ namespace meevax::inline kernel return make(std::fma(car(xs).as(), cadr(xs).as(), caddr(xs).as())); }); - library.define("binary64-abs", [](let const& xs) - { - return make(std::fabs(car(xs).as())); - }); - - library.define("binary64-expm1", [](let const& xs) - { - return make(std::expm1(car(xs).as())); - }); - - library.define("binary64-log1p", [](let const& xs) - { - return make(std::log1p(car(xs).as())); - }); - library.define("binary64-remquo", [](let const& xs) { auto quotient = 0; @@ -1259,7 +1173,7 @@ namespace meevax::inline kernel library.define("exact-integer-square-root", [](let const& xs) { - auto&& [s, r] = car(xs).as().square_root(); + auto&& [s, r] = car(xs).as().sqrt(); return cons(make(std::forward(s)), make(std::forward(r))); diff --git a/src/kernel/complex.cpp b/src/kernel/complex.cpp index 6a815baad..4a7ff74a7 100644 --- a/src/kernel/complex.cpp +++ b/src/kernel/complex.cpp @@ -155,7 +155,7 @@ namespace meevax::inline kernel { auto hypotenuse = [](let const& x, let const& y) { - return square_root(x * x + y * y); + return sqrt(x * x + y * y); }; return hypotenuse(real_part(x), @@ -164,7 +164,7 @@ namespace meevax::inline kernel auto angle(object const& x) -> object { - return atan(real_part(x), - imag_part(x)); + return atan2(real_part(x), + imag_part(x)); } } // namespace meevax::kernel diff --git a/src/kernel/exact_integer.cpp b/src/kernel/exact_integer.cpp index 1ba6f17e9..c9d420386 100644 --- a/src/kernel/exact_integer.cpp +++ b/src/kernel/exact_integer.cpp @@ -89,7 +89,7 @@ namespace meevax::inline kernel return (*value)._mp_size; } - auto exact_integer::square_root() const -> std::tuple + auto exact_integer::sqrt() const -> std::tuple { exact_integer s, r; mpz_rootrem(s.value, r.value, value, 2); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 87c597a89..6c79b5711 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -733,7 +733,7 @@ inline namespace number } else if constexpr (std::is_same_v) { - return square_root(x.real() * x.real() + x.imag() * x.imag()); + return sqrt(x.real() * x.real() + x.imag() * x.imag()); } else { @@ -770,7 +770,7 @@ inline namespace number return abs(quotient(x * y, gcd(x, y))); } - auto square_root(object const& x) -> object + auto sqrt(object const& x) -> object { auto f = [](T const& x) { @@ -783,11 +783,11 @@ inline namespace number } else { - auto square_root = [](auto const& x) + auto sqrt = [](auto const& x) { if constexpr (std::is_same_v) { - auto const [s, r] = x.square_root(); + auto const [s, r] = x.sqrt(); return r == 0 ? make(s) : make(std::sqrt(static_cast(x))); } @@ -797,8 +797,8 @@ inline namespace number } }; - return x < exact_integer(0) ? make(e0, square_root(exact_integer(0) - x)) - : square_root(x); + return x < exact_integer(0) ? make(e0, sqrt(exact_integer(0) - x)) + : sqrt(x); } }; @@ -883,7 +883,7 @@ inline namespace number } } - auto load_exponent(object const& x, object const& y) -> object + auto ldexp(object const& x, object const& y) -> object { auto f = [](auto&& x, auto&& y) { @@ -947,87 +947,89 @@ inline namespace number DEFINE_EXACTNESS_PRESERVED_COMPLEX1(round, std::round) DEFINE_EXACTNESS_PRESERVED_COMPLEX1(truncate, std::trunc) - #define DEFINE_COMPLEX1(NAME, CMATH) \ - auto NAME(object const& x) -> object \ + #define DEFINE_COMPLEX1(CMATH) \ + auto CMATH(object const& x) -> object \ { \ auto f = [](T const& x) \ { \ if constexpr (std::is_same_v) \ { \ - auto const z = CMATH(static_cast>(std::forward(x))); \ + auto const z = std::CMATH(static_cast>(std::forward(x))); \ \ return complex(make(z.real()), \ make(z.imag())); \ } \ else \ { \ - return CMATH(static_cast(std::forward(x))); \ + return std::CMATH(static_cast(std::forward(x))); \ } \ }; \ \ return apply_to(f, x); \ } - DEFINE_COMPLEX1(acos, std::acos) - DEFINE_COMPLEX1(acosh, std::acosh) - DEFINE_COMPLEX1(asin, std::asin) - DEFINE_COMPLEX1(asinh, std::asinh) - DEFINE_COMPLEX1(atan, std::atan) - DEFINE_COMPLEX1(atanh, std::atanh) - DEFINE_COMPLEX1(cos, std::cos) - DEFINE_COMPLEX1(cosh, std::cosh) - DEFINE_COMPLEX1(exp, std::exp) - DEFINE_COMPLEX1(log, std::log) - DEFINE_COMPLEX1(sin, std::sin) - DEFINE_COMPLEX1(sinh, std::sinh) - DEFINE_COMPLEX1(tan, std::tan) - DEFINE_COMPLEX1(tanh, std::tanh) - - #define DEFINE_REAL1(NAME, CMATH) \ - auto NAME(object const& x) -> object \ + DEFINE_COMPLEX1(acos) + DEFINE_COMPLEX1(acosh) + DEFINE_COMPLEX1(asin) + DEFINE_COMPLEX1(asinh) + DEFINE_COMPLEX1(atan) + DEFINE_COMPLEX1(atanh) + DEFINE_COMPLEX1(cos) + DEFINE_COMPLEX1(cosh) + DEFINE_COMPLEX1(exp) + DEFINE_COMPLEX1(log) + DEFINE_COMPLEX1(sin) + DEFINE_COMPLEX1(sinh) + DEFINE_COMPLEX1(tan) + DEFINE_COMPLEX1(tanh) + + #define DEFINE_REAL1(CMATH) \ + auto CMATH(object const& x) -> object \ { \ auto f = [](auto&& x) \ { \ - return CMATH(static_cast(std::forward(x))); \ + return std::CMATH(static_cast(std::forward(x))); \ }; \ \ return apply_to(f, x); \ } - DEFINE_REAL1(erf, std::erf) - DEFINE_REAL1(erfc, std::erfc) - DEFINE_REAL1(gamma, std::tgamma) - DEFINE_REAL1(log_gamma, std::lgamma) + DEFINE_REAL1(erf) + DEFINE_REAL1(erfc) + DEFINE_REAL1(expm1) + DEFINE_REAL1(fabs) + DEFINE_REAL1(lgamma) + DEFINE_REAL1(log1p) + DEFINE_REAL1(tgamma) - #define DEFINE_REAL2(NAME, CMATH) \ - auto NAME(object const& x, object const& y) -> object \ + #define DEFINE_REAL2(CMATH) \ + auto CMATH(object const& x, object const& y) -> object \ { \ auto f = [](auto&& x, auto&& y) \ { \ - return CMATH(static_cast(std::forward(x)), \ - static_cast(std::forward(y))); \ + return std::CMATH(static_cast(std::forward(x)), \ + static_cast(std::forward(y))); \ }; \ \ return apply_to(f, x, y); \ } - DEFINE_REAL2(atan, std::atan2) - DEFINE_REAL2(copy_sign, std::copysign) - DEFINE_REAL2(next_after, std::nextafter) + DEFINE_REAL2(atan2) + DEFINE_REAL2(copysign) + DEFINE_REAL2(nextafter) - #if __cpp_lib_math_special_functions - DEFINE_REAL2(cyl_bessel_j, std::cyl_bessel_j) - DEFINE_REAL2(cyl_neumann, std::cyl_neumann) - #else - auto cyl_bessel_j(object const&, object const&) -> object - { - throw error(make("The mathematical special function std::cyl_bessel_j is not provided in this environment.")); + #define DEFINE_UNPROVIDED_REAL2(CMATH) \ + auto CMATH(object const&, object const&) -> object \ + { \ + throw error(make("The mathematical special function std::" #CMATH " is not provided in this environment.")); \ } - auto cyl_neumann(object const&, object const&) -> object - { - throw error(make("The mathematical special function std::cyl_neumann is not provided in this environment.")); - } + #if __cpp_lib_math_special_functions + DEFINE_REAL2(cyl_bessel_j) + DEFINE_REAL2(cyl_neumann) + #else + DEFINE_UNPROVIDED_REAL2(cyl_bessel_j) + DEFINE_UNPROVIDED_REAL2(cyl_neumann) #endif } // namespace number } // namespace meevax::kernel diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 7523acfcd..a82b060cd 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -375,12 +375,12 @@ (check (flerf -inf.0) => -1.0) (check (flerf 0.0) => 0.0) -(check (flerf 1.0) => 0.8427007929497149) +(check (flerf 1.0) (=> =) 0.8427007929497149) (check (flerf +inf.0) => 1.0) (check (flerfc -inf.0) => 2.0) (check (flerfc 0.0) => 1.0) -(check (flerfc 1.0) => 0.15729920705028513) +(check (flerfc 1.0) (=> =) 0.15729920705028513) (check (flerfc +inf.0) => 0.0) (check-report)