From 7f7b53a08074a3b23f242916ac8ed75f6a86cf31 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 7 Dec 2024 21:54:24 +0900 Subject: [PATCH 01/16] Add new library `(srfi 144)` Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- basis/srfi-144.ss | 161 +++++++++++++++++++++++++++++++ configure/basis.cpp | 1 + include/meevax/kernel/number.hpp | 4 + src/kernel/boot.cpp | 35 +++++++ src/kernel/number.cpp | 52 +++++----- test/number.ss | 3 +- test/srfi-144.ss | 86 +++++++++++++++++ 9 files changed, 319 insertions(+), 29 deletions(-) create mode 100644 basis/srfi-144.ss create mode 100644 test/srfi-144.ss diff --git a/README.md b/README.md index 276360d10..559f0fdad 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.276.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.277.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.276_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.276_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.277_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.277_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 e132b397f..c19651393 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.276 +0.5.277 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss new file mode 100644 index 000000000..94384de3c --- /dev/null +++ b/basis/srfi-144.ss @@ -0,0 +1,161 @@ +(define-library (srfi 144) + (import (only (meevax inexact) + FP_FAST_FMA + FP_ILOGB0 + FP_ILOGBNAN + binary64-epsilon + binary64-max + binary64-min + e + euler + gamma + next-after + phi + pi + ) + (only (scheme base) + * + / + define + expt + inexact + ) + (only (scheme inexact) + cos + log + sin + sqrt + ) + ) + + (export fl-e fl-1/e fl-e-2 fl-e-pi/4 fl-log2-e fl-log10-e fl-log-2 fl-1/log-2 + fl-log-3 fl-log-pi fl-log-10 fl-1/log-10 fl-pi fl-1/pi fl-2pi fl-pi/2 + fl-pi/4 fl-pi-squared fl-degree fl-2/pi fl-2/sqrt-pi fl-sqrt-2 + fl-sqrt-3 fl-sqrt-5 fl-sqrt-10 fl-1/sqrt-2 fl-cbrt-2 fl-cbrt-3 + fl-4thrt-2 fl-phi fl-log-phi fl-1/log-phi fl-euler fl-e-euler + fl-sin-1 fl-cos-1 fl-gamma-1/2 fl-gamma-1/3 fl-gamma-2/3 + + fl-greatest fl-least fl-epsilon fl-fast-fl+* fl-integer-exponent-zero + fl-integer-exponent-nan + + ; flonum fladjacent flcopysign make-flonum + ; + ; flinteger-fraction flexponent flinteger-exponent + ; flnormalized-fraction-exponent flsign-bit + ; + ; flonum? fl=? fl? fl<=? fl>=? + ; flunordered? flinteger? flzero? flpositive? flnegative? + ; flodd? fleven? flfinite? flinfinite? flnan? + ; flnormalized? fldenormalized? + ; + ; flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff + ; flposdiff flsgn flnumerator fldenominator + ; flfloor flceiling flround fltruncate + ; + ; flexp flexp2 flexp-1 flsquare flsqrt flcbrt flhypot flexpt fllog + ; fllog1+ fllog2 fllog10 make-fllog-base + ; + ; flsin flcos fltan flasin flacos flatan + ; flsinh flcosh fltanh flasinh flacosh flatanh + ; + ; flquotient flremainder flremquo + ; + ; flgamma flloggamma flfirst-bessel flsecond-bessel + ; flerf flerfc + ) + + (begin (define fl-e e) + + (define fl-1/e (/ 1 e)) + + (define fl-e-2 7.38905609893065) ; (define fl-e-2 (expt e 2)) yields 1 ULP error + + (define fl-e-pi/4 (expt e (/ pi 4))) + + (define fl-log2-e (log e 2)) + + (define fl-log10-e 0.4342944819032518) ; (define fl-log10-e (log e 10)) yields 1 ULP error + + (define fl-log-2 (log 2)) + + (define fl-1/log-2 (/ 1 (log 2))) + + (define fl-log-3 (log 3)) + + (define fl-log-pi (log pi)) + + (define fl-log-10 (log 10)) + + (define fl-1/log-10 0.4342944819032518) ; (define fl-1/log-10 (/ 1 (log 10))) yields 1 ULP error + + (define fl-pi pi) + + (define fl-1/pi (/ 1 pi)) + + (define fl-2pi (* 2 pi)) + + (define fl-pi/2 (/ pi 2)) + + (define fl-pi/4 (/ pi 4)) + + (define fl-pi-squared (expt pi 2)) + + (define fl-degree (/ pi 180)) + + (define fl-2/pi (/ 2 pi)) + + (define fl-2/sqrt-pi (/ 2 (sqrt pi))) + + (define fl-sqrt-2 (sqrt 2)) + + (define fl-sqrt-3 (sqrt 3)) + + (define fl-sqrt-5 (sqrt 5)) + + (define fl-sqrt-10 (sqrt 10)) + + (define fl-1/sqrt-2 (/ 1 (sqrt 2))) + + (define fl-cbrt-2 (expt 2 (/ 1 3))) + + (define fl-cbrt-3 (expt 3 (/ 1 3))) + + (define fl-4thrt-2 (expt 2 (/ 1 4))) + + (define fl-phi phi) + + (define fl-log-phi (log phi)) + + (define fl-1/log-phi 2.07808692123502753) ; (define fl-1/log-phi (/ 1 fl-log-phi)) yields 1 ULP error + + (define fl-euler euler) + + (define fl-e-euler (expt e euler)) + + (define fl-sin-1 (sin 1)) + + (define fl-cos-1 (cos 1)) + + (define fl-gamma-1/2 (gamma (/ 1 2))) + + (define fl-gamma-1/3 2.67893853470774763) ; (define fl-gamma-1/3 (gamma (/ 1 3))) yields 1 ULP error + + (define fl-gamma-2/3 (gamma (/ 2 3))) + + (define fl-greatest binary64-max) + + (define fl-least binary64-min) + + (define fl-epsilon binary64-epsilon) + + (define fl-fast-fl+* FP_FAST_FMA) + + (define fl-integer-exponent-zero FP_ILOGB0) + + (define fl-integer-exponent-nan FP_ILOGBNAN) + + (define flonum inexact) + + (define fladjacent next-after) + ) + ) diff --git a/configure/basis.cpp b/configure/basis.cpp index 2dc0cd7b1..7b8ad54c0 100644 --- a/configure/basis.cpp +++ b/configure/basis.cpp @@ -42,6 +42,7 @@ namespace meevax R"##(${srfi-78.ss})##", R"##(${srfi-98.ss})##", R"##(${srfi-111.ss})##", + R"##(${srfi-144.ss})##", R"##(${srfi-149.ss})##", }; } diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index e317fd754..2695ef286 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -400,6 +400,10 @@ inline namespace number auto log(object const&) -> object; + auto gamma(object const&) -> object; + + auto next_after(object const&, object const&) -> object; + auto number_to_string(object const&, int) -> object; } // namespace number } // namespace kernel diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index c37621ef5..bdbb1c242 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -16,6 +16,7 @@ #include #include +#include #include #include @@ -548,6 +549,40 @@ namespace meevax::inline kernel { return atanh(car(xs)); }); + + library.define("gamma", [](let const& xs) + { + return gamma(car(xs)); + }); + + library.define("next-after", [](let const& xs) + { + return next_after(car(xs), cadr(xs)); + }); + + library.define("e", std::numbers::e); + + library.define("pi", std::numbers::pi); + + library.define("euler", std::numbers::egamma); + + library.define("phi", std::numbers::phi); + + library.define("binary64-max", std::numeric_limits::max()); + + library.define("binary64-min", std::numeric_limits::min()); + + library.define("binary64-epsilon", std::numeric_limits::epsilon()); + + library.define("FP_ILOGB0", FP_ILOGB0); + + library.define("FP_ILOGBNAN", FP_ILOGBNAN); + + #ifdef FP_FAST_FMA + library.define("FP_FAST_FMA", true); + #else + library.define("FP_FAST_FMA", false); + #endif }); define("(meevax list)", [](library & library) diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 02def90d9..1774042cc 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -259,6 +259,8 @@ namespace meevax::inline kernel using complex_numbers = combination; + using real_number = std::tuple; + using real_numbers = combination; template @@ -393,23 +395,6 @@ namespace meevax::inline kernel { "-inf.0", -std::numeric_limits::infinity() }, { "+nan.0", +std::numeric_limits::quiet_NaN() }, { "-nan.0", -std::numeric_limits::quiet_NaN() }, - - // SRFI-144 - { "fl-e", M_E }, - { "fl-log2-e", M_LOG2E }, - { "fl-log10-e", M_LOG10E }, - { "fl-log-2", M_LN2 }, - { "fl-1/log-2", M_LN2 }, - { "fl-log-10", M_LN10 }, - { "fl-1/log-10", M_LN10 }, - { "fl-pi", M_PI }, - { "fl-1/pi", M_1_PI }, - { "fl-pi/2", M_PI_2 }, - { "fl-pi/4", M_PI_4 }, - { "fl-2/pi", M_2_PI }, - { "fl-2/sqrt-pi", M_2_SQRTPI }, - { "fl-sqrt-2", M_SQRT2 }, - { "fl-1/sqrt-2", M_SQRT1_2 }, }; auto static const pattern = std::regex(R"([+-]?(?:\d+\.?|\d*\.\d+)(?:([DEFdef])[+-]?\d+)?)"); @@ -976,17 +961,34 @@ inline namespace number #undef DEFINE - auto atan(object const& x, object const& y) -> object - { - auto f = [](auto&& x, auto&& y) - { - return std::atan2(inexact_cast(std::forward(x)), - inexact_cast(std::forward(y))); - }; + #define DEFINE_REAL_UNARY(NAME, CMATH) \ + auto NAME(object const& x) -> object \ + { \ + auto f = [](auto&& x) \ + { \ + return CMATH(inexact_cast(std::forward(x))); \ + }; \ + \ + return apply_to(f, x); \ + } - return apply_to(f, x, y); + DEFINE_REAL_UNARY(gamma, std::tgamma) + + #define DEFINE_REAL_BINARY(NAME, CMATH) \ + auto NAME(object const& x, object const& y) -> object \ + { \ + auto f = [](auto&& x, auto&& y) \ + { \ + return CMATH(inexact_cast(std::forward(x)), \ + inexact_cast(std::forward(y))); \ + }; \ + \ + return apply_to(f, x, y); \ } + DEFINE_REAL_BINARY(atan, std::atan2) + DEFINE_REAL_BINARY(next_after, std::nextafter) + auto number_to_string(object const& x, int radix) -> object { auto f = [radix](T const& x) diff --git a/test/number.ss b/test/number.ss index 347ed06a3..1631447c6 100644 --- a/test/number.ss +++ b/test/number.ss @@ -2,7 +2,8 @@ (scheme inexact) (scheme process-context) (only (meevax inexact) binary32? binary64?) - (srfi 78)) + (srfi 78) + (srfi 144)) (check (real? 1.0e0) => #t) (check (binary32? 1.0e0) => #f) diff --git a/test/srfi-144.ss b/test/srfi-144.ss new file mode 100644 index 000000000..6459a162d --- /dev/null +++ b/test/srfi-144.ss @@ -0,0 +1,86 @@ +(import (scheme base) + (scheme process-context) + (srfi 78) + (srfi 144)) + +(check fl-e => 2.718281828459045) + +(check fl-1/e => 0.3678794411714423215955238) + +(check fl-e-2 => 7.38905609893065) + +(check fl-e-pi/4 => 2.1932800507380154566) + +(check fl-log2-e => 1.4426950408889634073599246810018921374266) + +(check fl-log10-e => 0.4342944819032518276511289) + +(check fl-log-2 => 0.6931471805599453094172321) + +(check fl-1/log-2 => 1.4426950408889634073599246810018921374266) + +(check fl-log-3 => 1.0986122886681096913952452) + +(check fl-log-pi => 1.144729885849400174143427) + +(check fl-log-10 => 2.3025850929940456840179915) + +(check fl-1/log-10 => 0.4342944819032518276511289189166050822944) + +(check fl-pi => 3.1415926535897932384626433832795028841972) + +(check fl-1/pi => 0.3183098861837906715377675267450287240689) + +(check fl-2pi => 6.283185307179586476925287) + +(check fl-pi/2 => 1.570796326794896619231322) + +(check fl-pi/4 => 0.7853981633974483096156608) + +(check fl-pi-squared => 9.869604401089358618834491) + +(check fl-degree => 0.0174532925199432957692369076848861271344) + +(check fl-2/pi => 0.6366197723675814) + +(check fl-2/sqrt-pi => 1.1283791670955126) + +(check fl-sqrt-2 => 1.4142135623730950488016887242096980785697) + +(check fl-sqrt-3 => 1.7320508075688772935274463415058723669428) + +(check fl-sqrt-5 => 2.2360679774997896964091736687311762354406) + +(check fl-sqrt-10 => 3.1622776601683793319988935444327185337196) + +(check fl-1/sqrt-2 => 0.7071067811865475) + +(check fl-cbrt-2 => 1.2599210498948731647672106072782283505703) + +(check fl-cbrt-3 => 1.4422495703074083823216383107801095883919) + +(check fl-4thrt-2 => 1.1892071150027210667174999705604759152930) + +(check fl-phi => 1.6180339887498948482045868343656381177203) + +(check fl-log-phi => 0.4812118250596034474977589134243684231352) + +(check fl-1/log-phi => 2.0780869212350275376013226061177957677422) + +(check fl-euler => 0.5772156649015328606065120900824024310422) + +(check fl-e-euler => 1.7810724179901979852365041031071795491696) + +(check fl-sin-1 => 0.8414709848078965066525023216302989996226) + +(check fl-cos-1 => 0.5403023058681397174009366074420766037323) + +(check fl-gamma-1/2 => 1.7724538509055160272981674833411451827975) + +(check fl-gamma-1/3 => 2.6789385347077476336556929409746776441287) + +(check fl-gamma-2/3 => 1.3541179394264004169452880281545137855193) + +(check-report) + +(exit (check-passed? 39)) From e99ca9d86aa7d3494e11a7cf28a3e30b85ee4d02 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 7 Dec 2024 21:57:21 +0900 Subject: [PATCH 02/16] Add new procedure `copy-sign` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 3 +++ include/meevax/kernel/number.hpp | 2 ++ src/kernel/boot.cpp | 5 +++++ src/kernel/number.cpp | 1 + 6 files changed, 14 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 559f0fdad..16ceb0bc2 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.277.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.278.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.277_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.277_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.278_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.278_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 c19651393..174b337b4 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.277 +0.5.278 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 94384de3c..1ccf56b84 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -6,6 +6,7 @@ binary64-epsilon binary64-max binary64-min + copy-sign e euler gamma @@ -157,5 +158,7 @@ (define flonum inexact) (define fladjacent next-after) + + (define flcopysign copy-sign) ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 2695ef286..a0ef6b902 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -404,6 +404,8 @@ inline namespace number auto next_after(object const&, object const&) -> object; + auto copy_sign(object const&, object const&) -> object; + auto number_to_string(object const&, int) -> object; } // namespace number } // namespace kernel diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index bdbb1c242..314ae36e5 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -560,6 +560,11 @@ namespace meevax::inline kernel return next_after(car(xs), cadr(xs)); }); + library.define("copy-sign", [](let const& xs) + { + return copy_sign(car(xs), cadr(xs)); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 1774042cc..f5a147465 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -987,6 +987,7 @@ inline namespace number } DEFINE_REAL_BINARY(atan, std::atan2) + DEFINE_REAL_BINARY(copy_sign, std::copysign) DEFINE_REAL_BINARY(next_after, std::nextafter) auto number_to_string(object const& x, int radix) -> object From 3cf78050df902fbe9a9860288defbcf8f055f8ff Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sat, 7 Dec 2024 23:17:01 +0900 Subject: [PATCH 03/16] Add new function template `cmath_cast` Signed-off-by: yamacir-kit --- README.md | 4 +-- VERSION | 2 +- include/meevax/kernel/complex.hpp | 2 ++ include/meevax/kernel/number.hpp | 28 ++++++++++++++++++++ include/meevax/kernel/ratio.hpp | 2 ++ src/kernel/complex.cpp | 43 +++++++++++++++++++++++++++++-- src/kernel/ratio.cpp | 5 ++++ 7 files changed, 81 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 16ceb0bc2..343eaa29d 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.278.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.279.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.278_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.278_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.279_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.279_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 174b337b4..085173e30 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.278 +0.5.279 diff --git a/include/meevax/kernel/complex.hpp b/include/meevax/kernel/complex.hpp index 881ed95f8..108681df1 100644 --- a/include/meevax/kernel/complex.hpp +++ b/include/meevax/kernel/complex.hpp @@ -35,6 +35,8 @@ namespace meevax::inline kernel auto real() const noexcept -> object const&; + explicit operator std::complex() const; + explicit operator std::complex() const; }; diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index a0ef6b902..a42f0644f 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -248,6 +248,34 @@ inline namespace kernel auto make_number(std::string const&, int = 10) -> object; + template + auto cmath_cast(T&& x) -> decltype(auto) + { + static_assert(std::is_arithmetic_v); + + if constexpr (std::is_same_v, complex>) + { + return std::complex(std::forward(x)); + } + else if constexpr (std::is_floating_point_v>) + { + if constexpr (std::is_floating_point_v) + { + return std::forward(x); + } + else + { + return std::clamp(std::forward(x), + static_cast>(std::numeric_limits::min()), + static_cast>(std::numeric_limits::max())); + } + } + else + { + return static_cast(std::forward(x)); + } + } + template auto inexact_cast(T&& x) -> decltype(auto) { diff --git a/include/meevax/kernel/ratio.hpp b/include/meevax/kernel/ratio.hpp index fb1fe1b3b..a430b2292 100644 --- a/include/meevax/kernel/ratio.hpp +++ b/include/meevax/kernel/ratio.hpp @@ -46,6 +46,8 @@ namespace meevax::inline kernel auto numerator() const -> exact_integer; + explicit operator int() const; + explicit operator double() const; }; diff --git a/src/kernel/complex.cpp b/src/kernel/complex.cpp index 3f2f2f337..3267c12dd 100644 --- a/src/kernel/complex.cpp +++ b/src/kernel/complex.cpp @@ -68,13 +68,52 @@ namespace meevax::inline kernel return first; } + complex::operator std::complex() const + { + assert(is_real(real())); + assert(is_real(imag())); + + auto to_int = [](let const& x) + { + if (x.is()) + { + return static_cast(x.as()); + } + else if (x.is()) + { + return static_cast(x.as()); + } + else + { + assert(x.is()); + return static_cast(x.as()); + } + }; + + return std::complex(to_int(exact(real())), + to_int(exact(imag()))); + } + complex::operator std::complex() const { assert(is_real(real())); assert(is_real(imag())); - return std::complex(inexact(real()).as(), - inexact(imag()).as()); + auto to_double = [](let const& x) + { + if (x.is()) + { + return x.as(); + } + else + { + assert(x.is()); + return static_cast(x.as()); + } + }; + + return std::complex(to_double(inexact(real())), + to_double(inexact(imag()))); } auto operator <<(std::ostream & os, complex const& z) -> std::ostream & diff --git a/src/kernel/ratio.cpp b/src/kernel/ratio.cpp index c74132111..8c99a5054 100644 --- a/src/kernel/ratio.cpp +++ b/src/kernel/ratio.cpp @@ -87,6 +87,11 @@ namespace meevax::inline kernel return exact_integer(mpq_numref(value)); } + ratio::operator int() const + { + return cmath_cast(mpq_get_d(value)); + } + ratio::operator double() const { return mpq_get_d(value); From 01821646a25b341439caf8c762c7a058fe9047cc Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 00:39:30 +0900 Subject: [PATCH 04/16] Add new procedure `load-exponent` Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- basis/srfi-144.ss | 7 ++- include/meevax/kernel/number.hpp | 2 + include/meevax/memory/nan_boxing_pointer.hpp | 5 ++- src/kernel/boot.cpp | 9 +++- src/kernel/number.cpp | 11 +++++ test/srfi-144.ss | 45 +++++++++++++++++++- 8 files changed, 74 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 343eaa29d..1e0a4425c 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.279.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.280.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.279_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.279_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.280_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.280_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 085173e30..6ba0fd5d1 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.279 +0.5.280 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 1ccf56b84..1a11b6123 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -10,6 +10,7 @@ e euler gamma + load-exponent next-after phi pi @@ -39,8 +40,8 @@ fl-greatest fl-least fl-epsilon fl-fast-fl+* fl-integer-exponent-zero fl-integer-exponent-nan - ; flonum fladjacent flcopysign make-flonum - ; + flonum fladjacent flcopysign make-flonum + ; flinteger-fraction flexponent flinteger-exponent ; flnormalized-fraction-exponent flsign-bit ; @@ -160,5 +161,7 @@ (define fladjacent next-after) (define flcopysign copy-sign) + + (define make-flonum load-exponent) ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index a42f0644f..3238d1007 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -434,6 +434,8 @@ inline namespace number auto copy_sign(object const&, object const&) -> object; + auto load_exponent(object const&, object const&) -> object; + auto number_to_string(object const&, int) -> object; } // namespace number } // namespace kernel diff --git a/include/meevax/memory/nan_boxing_pointer.hpp b/include/meevax/memory/nan_boxing_pointer.hpp index 5fbac3cab..df38ad2ff 100644 --- a/include/meevax/memory/nan_boxing_pointer.hpp +++ b/include/meevax/memory/nan_boxing_pointer.hpp @@ -18,9 +18,10 @@ #define INCLUDED_MEEVAX_MEMORY_NAN_BOXING_POINTER_HPP #include -#include #include +#include #include +#include #include #include @@ -232,7 +233,7 @@ namespace meevax::inline memory } else { - return os << std::fixed << std::setprecision(17) << cyan(value); + return os << std::fixed << std::setprecision(std::numeric_limits::max_digits10) << cyan(value); } } } diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 314ae36e5..6b243390d 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -565,6 +565,11 @@ namespace meevax::inline kernel return copy_sign(car(xs), cadr(xs)); }); + library.define("load-exponent", [](let const& xs) + { + return load_exponent(car(xs), cadr(xs)); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); @@ -579,9 +584,9 @@ namespace meevax::inline kernel library.define("binary64-epsilon", std::numeric_limits::epsilon()); - library.define("FP_ILOGB0", FP_ILOGB0); + library.define("FP_ILOGB0", FP_ILOGB0); - library.define("FP_ILOGBNAN", FP_ILOGBNAN); + library.define("FP_ILOGBNAN", FP_ILOGBNAN); #ifdef FP_FAST_FMA library.define("FP_FAST_FMA", true); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index f5a147465..4c407672d 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -990,6 +990,17 @@ inline namespace number DEFINE_REAL_BINARY(copy_sign, std::copysign) DEFINE_REAL_BINARY(next_after, std::nextafter) + auto load_exponent(object const& x, object const& y) -> object + { + auto f = [](auto&& x, auto&& y) + { + return std::ldexp(cmath_cast(std::forward(x)), + cmath_cast(std::forward(y))); + }; + + return apply_to(f, x, y); + } + auto number_to_string(object const& x, int radix) -> object { auto f = [radix](T const& x) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 6459a162d..0f0995e29 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -1,4 +1,5 @@ -(import (scheme base) +(import (only (meevax inexact) binary64?) + (scheme base) (scheme process-context) (srfi 78) (srfi 144)) @@ -81,6 +82,46 @@ (check fl-gamma-2/3 => 1.3541179394264004169452880281545137855193) +(check (binary64? fl-greatest) => #t) + +(check (binary64? fl-least) => #t) + +(check (< 0.0 0.0) => #f) + +(check (< 0.0 fl-least) => #t) + +(check (binary64? fl-epsilon) => #t) + +(check (boolean? fl-fast-fl+*) => #t) + +(check (exact-integer? fl-integer-exponent-zero) => #t) + +(check (exact-integer? fl-integer-exponent-nan) => #t) + +(check (= (flonum 22/7) fl-pi) => #f) + +(check (= (flonum 333/106) fl-pi) => #f) + +(check (= (flonum 355/113) fl-pi) => #f) + +(check (= (flonum 52163/16604) fl-pi) => #f) + +(check (= (flonum 103993/33102) fl-pi) => #f) + +(check (= (flonum 104348/33215) fl-pi) => #f) + +(check (= (flonum 245850922/78256779) fl-pi) => #t) + +(check (fladjacent 0.0 1.0) (=> =) fl-least) + +(check (< 0.0 (fladjacent 0.0 1.0) fl-epsilon 1.0 (+ 1.0 fl-epsilon) fl-greatest +inf.0) => #t) + +(check (flcopysign 0.0 +inf.0) => 0.0) + +(check (flcopysign 0.0 -inf.0) => -0.0) + +(check (make-flonum 3.0 4) => 48.0) + (check-report) -(exit (check-passed? 39)) +(exit (check-passed? 59)) From dbbd07941e41ad61e90e616036fdf46d7c6506a7 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 08:31:08 +0900 Subject: [PATCH 05/16] Remove function template `cmath_cast` and `inexact_cast` Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- include/meevax/kernel/number.hpp | 45 -------- include/meevax/kernel/ratio.hpp | 2 + src/kernel/number.cpp | 192 ++++++++++++++++--------------- src/kernel/ratio.cpp | 7 +- 6 files changed, 113 insertions(+), 139 deletions(-) diff --git a/README.md b/README.md index 1e0a4425c..821b3d45d 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.280.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.281.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.280_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.280_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.281_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.281_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 6ba0fd5d1..57765b94b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.280 +0.5.281 diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 3238d1007..06c42c24b 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -248,51 +248,6 @@ inline namespace kernel auto make_number(std::string const&, int = 10) -> object; - template - auto cmath_cast(T&& x) -> decltype(auto) - { - static_assert(std::is_arithmetic_v); - - if constexpr (std::is_same_v, complex>) - { - return std::complex(std::forward(x)); - } - else if constexpr (std::is_floating_point_v>) - { - if constexpr (std::is_floating_point_v) - { - return std::forward(x); - } - else - { - return std::clamp(std::forward(x), - static_cast>(std::numeric_limits::min()), - static_cast>(std::numeric_limits::max())); - } - } - else - { - return static_cast(std::forward(x)); - } - } - - template - auto inexact_cast(T&& x) -> decltype(auto) - { - if constexpr (std::is_same_v, complex>) - { - return std::complex(std::forward(x)); - } - else if constexpr (std::is_floating_point_v>) - { - return std::forward(x); - } - else - { - return static_cast(std::forward(x)); - } - } - template auto inexact_equals(T const& x, U const& y) { diff --git a/include/meevax/kernel/ratio.hpp b/include/meevax/kernel/ratio.hpp index a430b2292..b904b3e2d 100644 --- a/include/meevax/kernel/ratio.hpp +++ b/include/meevax/kernel/ratio.hpp @@ -48,6 +48,8 @@ namespace meevax::inline kernel explicit operator int() const; + explicit operator float() const; + explicit operator double() const; }; diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 4c407672d..00675b76d 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -50,23 +50,23 @@ namespace meevax::inline kernel auto operator > (exact_integer const& a, ratio const& b) -> bool { return 0 > mpq_cmp_z(b.value, a.value); } auto operator >=(exact_integer const& a, ratio const& b) -> bool { return 0 >= mpq_cmp_z(b.value, a.value); } - auto operator + (exact_integer const& a, float b) -> float { return inexact_cast(a) + b; } - auto operator - (exact_integer const& a, float b) -> float { return inexact_cast(a) - b; } - auto operator * (exact_integer const& a, float b) -> float { return inexact_cast(a) * b; } - auto operator / (exact_integer const& a, float b) -> float { return inexact_cast(a) / b; } - auto operator % (exact_integer const& a, float b) -> float { return std::remainder(inexact_cast(a), b); } - auto operator ==(exact_integer const& a, float b) -> bool { return inexact_equals(inexact_cast(a), b); } + auto operator + (exact_integer const& a, float b) -> float { return static_cast(a) + b; } + auto operator - (exact_integer const& a, float b) -> float { return static_cast(a) - b; } + auto operator * (exact_integer const& a, float b) -> float { return static_cast(a) * b; } + auto operator / (exact_integer const& a, float b) -> float { return static_cast(a) / b; } + auto operator % (exact_integer const& a, float b) -> float { return std::remainder(static_cast(a), b); } + auto operator ==(exact_integer const& a, float b) -> bool { return inexact_equals(static_cast(a), b); } auto operator !=(exact_integer const& a, float b) -> bool { return not (a == b); } - auto operator < (exact_integer const& a, float b) -> bool { return inexact_cast(a) < b; } - auto operator <=(exact_integer const& a, float b) -> bool { return inexact_cast(a) <= b; } - auto operator > (exact_integer const& a, float b) -> bool { return inexact_cast(a) > b; } - auto operator >=(exact_integer const& a, float b) -> bool { return inexact_cast(a) >= b; } - - auto operator + (exact_integer const& a, double b) -> double { return inexact_cast(a) + b; } - auto operator - (exact_integer const& a, double b) -> double { return inexact_cast(a) - b; } - auto operator * (exact_integer const& a, double b) -> double { return inexact_cast(a) * b; } - auto operator / (exact_integer const& a, double b) -> double { return inexact_cast(a) / b; } - auto operator % (exact_integer const& a, double b) -> double { return std::remainder(inexact_cast(a), b); } + auto operator < (exact_integer const& a, float b) -> bool { return static_cast(a) < b; } + auto operator <=(exact_integer const& a, float b) -> bool { return static_cast(a) <= b; } + auto operator > (exact_integer const& a, float b) -> bool { return static_cast(a) > b; } + auto operator >=(exact_integer const& a, float b) -> bool { return static_cast(a) >= b; } + + auto operator + (exact_integer const& a, double b) -> double { return static_cast(a) + b; } + auto operator - (exact_integer const& a, double b) -> double { return static_cast(a) - b; } + auto operator * (exact_integer const& a, double b) -> double { return static_cast(a) * b; } + auto operator / (exact_integer const& a, double b) -> double { return static_cast(a) / b; } + auto operator % (exact_integer const& a, double b) -> double { return std::remainder(static_cast(a), b); } auto operator ==(exact_integer const& a, double b) -> bool { return mpz_cmp_d(a.value, b) == 0; } auto operator !=(exact_integer const& a, double b) -> bool { return mpz_cmp_d(a.value, b) != 0; } auto operator < (exact_integer const& a, double b) -> bool { return mpz_cmp_d(a.value, b) < 0; } @@ -105,29 +105,29 @@ namespace meevax::inline kernel auto operator > (ratio const& a, ratio const& b) -> bool { return mpq_cmp(a.value, b.value) > 0; } auto operator >=(ratio const& a, ratio const& b) -> bool { return mpq_cmp(a.value, b.value) >= 0; } - auto operator + (ratio const& a, float b) -> float { return inexact_cast(a) + b; } - auto operator - (ratio const& a, float b) -> float { return inexact_cast(a) - b; } - auto operator * (ratio const& a, float b) -> float { return inexact_cast(a) * b; } - auto operator / (ratio const& a, float b) -> float { return inexact_cast(a) / b; } - auto operator % (ratio const& a, float b) -> float { return std::remainder(inexact_cast(a), b); } - auto operator ==(ratio const& a, float b) -> bool { return inexact_equals(inexact_cast(a), b); } + auto operator + (ratio const& a, float b) -> float { return static_cast(a) + b; } + auto operator - (ratio const& a, float b) -> float { return static_cast(a) - b; } + auto operator * (ratio const& a, float b) -> float { return static_cast(a) * b; } + auto operator / (ratio const& a, float b) -> float { return static_cast(a) / b; } + auto operator % (ratio const& a, float b) -> float { return std::remainder(static_cast(a), b); } + auto operator ==(ratio const& a, float b) -> bool { return inexact_equals(static_cast(a), b); } auto operator !=(ratio const& a, float b) -> bool { return not (a == b); } - auto operator < (ratio const& a, float b) -> bool { return inexact_cast(a) < b; } - auto operator <=(ratio const& a, float b) -> bool { return inexact_cast(a) <= b; } - auto operator > (ratio const& a, float b) -> bool { return inexact_cast(a) > b; } - auto operator >=(ratio const& a, float b) -> bool { return inexact_cast(a) >= b; } - - auto operator + (ratio const& a, double b) -> double { return inexact_cast(a) + b; } - auto operator - (ratio const& a, double b) -> double { return inexact_cast(a) - b; } - auto operator * (ratio const& a, double b) -> double { return inexact_cast(a) * b; } - auto operator / (ratio const& a, double b) -> double { return inexact_cast(a) / b; } - auto operator % (ratio const& a, double b) -> double { return std::remainder(inexact_cast(a), b); } - auto operator ==(ratio const& a, double b) -> bool { return inexact_equals(inexact_cast(a), b); } + auto operator < (ratio const& a, float b) -> bool { return static_cast(a) < b; } + auto operator <=(ratio const& a, float b) -> bool { return static_cast(a) <= b; } + auto operator > (ratio const& a, float b) -> bool { return static_cast(a) > b; } + auto operator >=(ratio const& a, float b) -> bool { return static_cast(a) >= b; } + + auto operator + (ratio const& a, double b) -> double { return static_cast(a) + b; } + auto operator - (ratio const& a, double b) -> double { return static_cast(a) - b; } + auto operator * (ratio const& a, double b) -> double { return static_cast(a) * b; } + auto operator / (ratio const& a, double b) -> double { return static_cast(a) / b; } + auto operator % (ratio const& a, double b) -> double { return std::remainder(static_cast(a), b); } + auto operator ==(ratio const& a, double b) -> bool { return inexact_equals(static_cast(a), b); } auto operator !=(ratio const& a, double b) -> bool { return not (a == b); } - auto operator < (ratio const& a, double b) -> bool { return inexact_cast(a) < b; } - auto operator <=(ratio const& a, double b) -> bool { return inexact_cast(a) <= b; } - auto operator > (ratio const& a, double b) -> bool { return inexact_cast(a) > b; } - auto operator >=(ratio const& a, double b) -> bool { return inexact_cast(a) >= b; } + auto operator < (ratio const& a, double b) -> bool { return static_cast(a) < b; } + auto operator <=(ratio const& a, double b) -> bool { return static_cast(a) <= b; } + auto operator > (ratio const& a, double b) -> bool { return static_cast(a) > b; } + auto operator >=(ratio const& a, double b) -> bool { return static_cast(a) >= b; } auto operator + (ratio const& a, complex const& b) -> complex { return complex(make(a), e0) + b; } auto operator - (ratio const& a, complex const& b) -> complex { return complex(make(a), e0) - b; } @@ -136,29 +136,29 @@ namespace meevax::inline kernel auto operator ==(ratio const& a, complex const& b) -> bool { return complex(make(a), e0) == b; } auto operator !=(ratio const& a, complex const& b) -> bool { return complex(make(a), e0) != b; } - auto operator + (float a, exact_integer const& b) -> float { return a + inexact_cast(b); } - auto operator - (float a, exact_integer const& b) -> float { return a - inexact_cast(b); } - auto operator * (float a, exact_integer const& b) -> float { return a * inexact_cast(b); } - auto operator / (float a, exact_integer const& b) -> float { return a / inexact_cast(b); } - auto operator % (float a, exact_integer const& b) -> float { return std::remainder(a, inexact_cast(b)); } - auto operator ==(float a, exact_integer const& b) -> bool { return inexact_equals(a, inexact_cast(b)); } + auto operator + (float a, exact_integer const& b) -> float { return a + static_cast(b); } + auto operator - (float a, exact_integer const& b) -> float { return a - static_cast(b); } + auto operator * (float a, exact_integer const& b) -> float { return a * static_cast(b); } + auto operator / (float a, exact_integer const& b) -> float { return a / static_cast(b); } + auto operator % (float a, exact_integer const& b) -> float { return std::remainder(a, static_cast(b)); } + auto operator ==(float a, exact_integer const& b) -> bool { return inexact_equals(a, static_cast(b)); } auto operator !=(float a, exact_integer const& b) -> bool { return not (a == b); } - auto operator < (float a, exact_integer const& b) -> bool { return a < inexact_cast(b); } - auto operator <=(float a, exact_integer const& b) -> bool { return a <= inexact_cast(b); } - auto operator > (float a, exact_integer const& b) -> bool { return a > inexact_cast(b); } - auto operator >=(float a, exact_integer const& b) -> bool { return a >= inexact_cast(b); } - - auto operator + (float a, ratio const& b) -> float { return a + inexact_cast(b); } - auto operator - (float a, ratio const& b) -> float { return a - inexact_cast(b); } - auto operator * (float a, ratio const& b) -> float { return a * inexact_cast(b); } - auto operator / (float a, ratio const& b) -> float { return a / inexact_cast(b); } - auto operator % (float a, ratio const& b) -> float { return std::remainder(a, inexact_cast(b)); } - auto operator ==(float a, ratio const& b) -> bool { return inexact_equals(a, inexact_cast(b)); } + auto operator < (float a, exact_integer const& b) -> bool { return a < static_cast(b); } + auto operator <=(float a, exact_integer const& b) -> bool { return a <= static_cast(b); } + auto operator > (float a, exact_integer const& b) -> bool { return a > static_cast(b); } + auto operator >=(float a, exact_integer const& b) -> bool { return a >= static_cast(b); } + + auto operator + (float a, ratio const& b) -> float { return a + static_cast(b); } + auto operator - (float a, ratio const& b) -> float { return a - static_cast(b); } + auto operator * (float a, ratio const& b) -> float { return a * static_cast(b); } + auto operator / (float a, ratio const& b) -> float { return a / static_cast(b); } + auto operator % (float a, ratio const& b) -> float { return std::remainder(a, static_cast(b)); } + auto operator ==(float a, ratio const& b) -> bool { return inexact_equals(a, static_cast(b)); } auto operator !=(float a, ratio const& b) -> bool { return not (a == b); } - auto operator < (float a, ratio const& b) -> bool { return a < inexact_cast(b); } - auto operator <=(float a, ratio const& b) -> bool { return a <= inexact_cast(b); } - auto operator > (float a, ratio const& b) -> bool { return a > inexact_cast(b); } - auto operator >=(float a, ratio const& b) -> bool { return a >= inexact_cast(b); } + auto operator < (float a, ratio const& b) -> bool { return a < static_cast(b); } + auto operator <=(float a, ratio const& b) -> bool { return a <= static_cast(b); } + auto operator > (float a, ratio const& b) -> bool { return a > static_cast(b); } + auto operator >=(float a, ratio const& b) -> bool { return a >= static_cast(b); } auto operator + (float a, complex const& b) -> complex { return complex(make(a), e0) + b; } auto operator - (float a, complex const& b) -> complex { return complex(make(a), e0) - b; } @@ -167,11 +167,11 @@ namespace meevax::inline kernel auto operator ==(float a, complex const& b) -> bool { return complex(make(a), e0) == b; } auto operator !=(float a, complex const& b) -> bool { return complex(make(a), e0) != b; } - auto operator + (double a, exact_integer const& b) -> double { return a + inexact_cast(b); } - auto operator - (double a, exact_integer const& b) -> double { return a - inexact_cast(b); } - auto operator * (double a, exact_integer const& b) -> double { return a * inexact_cast(b); } - auto operator / (double a, exact_integer const& b) -> double { return a / inexact_cast(b); } - auto operator % (double a, exact_integer const& b) -> double { return std::remainder(a, inexact_cast(b)); } + auto operator + (double a, exact_integer const& b) -> double { return a + static_cast(b); } + auto operator - (double a, exact_integer const& b) -> double { return a - static_cast(b); } + auto operator * (double a, exact_integer const& b) -> double { return a * static_cast(b); } + auto operator / (double a, exact_integer const& b) -> double { return a / static_cast(b); } + auto operator % (double a, exact_integer const& b) -> double { return std::remainder(a, static_cast(b)); } auto operator ==(double a, exact_integer const& b) -> bool { return mpz_cmp_d(b.value, a) == 0; } auto operator !=(double a, exact_integer const& b) -> bool { return mpz_cmp_d(b.value, a) != 0; } auto operator < (double a, exact_integer const& b) -> bool { return mpz_cmp_d(b.value, a) > 0; } @@ -179,17 +179,17 @@ namespace meevax::inline kernel auto operator > (double a, exact_integer const& b) -> bool { return mpz_cmp_d(b.value, a) < 0; } auto operator >=(double a, exact_integer const& b) -> bool { return mpz_cmp_d(b.value, a) <= 0; } - auto operator + (double a, ratio const& b) -> double { return a + inexact_cast(b); } - auto operator - (double a, ratio const& b) -> double { return a - inexact_cast(b); } - auto operator * (double a, ratio const& b) -> double { return a * inexact_cast(b); } - auto operator / (double a, ratio const& b) -> double { return a / inexact_cast(b); } - auto operator % (double a, ratio const& b) -> double { return std::remainder(a, inexact_cast(b)); } - auto operator ==(double a, ratio const& b) -> bool { return inexact_equals(a, inexact_cast(b)); } + auto operator + (double a, ratio const& b) -> double { return a + static_cast(b); } + auto operator - (double a, ratio const& b) -> double { return a - static_cast(b); } + auto operator * (double a, ratio const& b) -> double { return a * static_cast(b); } + auto operator / (double a, ratio const& b) -> double { return a / static_cast(b); } + auto operator % (double a, ratio const& b) -> double { return std::remainder(a, static_cast(b)); } + auto operator ==(double a, ratio const& b) -> bool { return inexact_equals(a, static_cast(b)); } auto operator !=(double a, ratio const& b) -> bool { return not (a == b); } - auto operator < (double a, ratio const& b) -> bool { return a < inexact_cast(b); } - auto operator <=(double a, ratio const& b) -> bool { return a <= inexact_cast(b); } - auto operator > (double a, ratio const& b) -> bool { return a > inexact_cast(b); } - auto operator >=(double a, ratio const& b) -> bool { return a >= inexact_cast(b); } + auto operator < (double a, ratio const& b) -> bool { return a < static_cast(b); } + auto operator <=(double a, ratio const& b) -> bool { return a <= static_cast(b); } + auto operator > (double a, ratio const& b) -> bool { return a > static_cast(b); } + auto operator >=(double a, ratio const& b) -> bool { return a >= static_cast(b); } auto operator + (double a, complex const& b) -> complex { return complex(make(a), e0) + b; } auto operator - (double a, complex const& b) -> complex { return complex(make(a), e0) - b; } @@ -542,7 +542,7 @@ inline namespace number } else { - return inexact_cast(std::forward(x)); + return static_cast(std::forward(x)); } }; @@ -800,7 +800,7 @@ inline namespace number { if constexpr (std::is_same_v) { - auto const z = std::sqrt(inexact_cast(x)); + auto const z = std::sqrt(static_cast>(x)); return complex(make(z.real()), make(z.imag())); @@ -813,11 +813,11 @@ inline namespace number { auto const [s, r] = x.square_root(); - return r == 0 ? make(s) : make(std::sqrt(inexact_cast(x))); + return r == 0 ? make(s) : make(std::sqrt(static_cast(x))); } else { - return make(std::sqrt(inexact_cast(std::forward(x)))); + return make(std::sqrt(static_cast(std::forward(x)))); } }; @@ -836,8 +836,20 @@ inline namespace number if constexpr (std::is_same_v or std::is_same_v) { - auto const z = std::pow(inexact_cast(std::forward(x)), - inexact_cast(std::forward(y))); + auto inexact = [](auto&& x) + { + if constexpr (std::is_same_v, complex>) + { + return static_cast>(std::forward(x)); + } + else + { + return static_cast(std::forward(x)); + } + }; + + auto const z = std::pow(inexact(std::forward(x)), + inexact(std::forward(y))); return complex(make(z.real()), make(z.imag())); @@ -851,8 +863,8 @@ inline namespace number } else { - return std::pow(inexact_cast(std::forward(x)), - inexact_cast(std::forward(y))); + return std::pow(static_cast(std::forward(x)), + static_cast(std::forward(y))); } }; @@ -902,11 +914,11 @@ inline namespace number { \ if constexpr (std::is_floating_point_v) \ { \ - return std::ROUND(inexact_cast(std::forward(x))); \ + return std::ROUND(std::forward(x)); \ } \ else if constexpr (std::is_same_v) \ { \ - return exact_integer(std::ROUND(inexact_cast(std::forward(x)))); \ + return exact_integer(std::ROUND(static_cast(std::forward(x)))); \ } \ else if constexpr (std::is_same_v) \ { \ @@ -937,14 +949,14 @@ inline namespace number { \ if constexpr (std::is_same_v) \ { \ - auto const z = std::CMATH(inexact_cast(std::forward(x))); \ + auto const z = std::CMATH(static_cast>(std::forward(x))); \ \ return complex(make(z.real()), \ make(z.imag())); \ } \ else \ { \ - return std::CMATH(inexact_cast(std::forward(x))); \ + return std::CMATH(static_cast(std::forward(x))); \ } \ }; \ \ @@ -966,7 +978,7 @@ inline namespace number { \ auto f = [](auto&& x) \ { \ - return CMATH(inexact_cast(std::forward(x))); \ + return CMATH(static_cast(std::forward(x))); \ }; \ \ return apply_to(f, x); \ @@ -979,8 +991,8 @@ inline namespace number { \ auto f = [](auto&& x, auto&& y) \ { \ - return CMATH(inexact_cast(std::forward(x)), \ - inexact_cast(std::forward(y))); \ + return CMATH(static_cast(std::forward(x)), \ + static_cast(std::forward(y))); \ }; \ \ return apply_to(f, x, y); \ @@ -994,8 +1006,8 @@ inline namespace number { auto f = [](auto&& x, auto&& y) { - return std::ldexp(cmath_cast(std::forward(x)), - cmath_cast(std::forward(y))); + return std::ldexp(static_cast(std::forward(x)), + static_cast(std::forward(y))); }; return apply_to(f, x, y); diff --git a/src/kernel/ratio.cpp b/src/kernel/ratio.cpp index 8c99a5054..0a3774007 100644 --- a/src/kernel/ratio.cpp +++ b/src/kernel/ratio.cpp @@ -89,7 +89,12 @@ namespace meevax::inline kernel ratio::operator int() const { - return cmath_cast(mpq_get_d(value)); + return mpq_get_d(value); + } + + ratio::operator float() const + { + return mpq_get_d(value); } ratio::operator double() const From 2eb1bff668f82b0a003e7617a430122ed1a5d17d Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 12:42:01 +0900 Subject: [PATCH 06/16] Cleanup some macro definitions Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- include/meevax/kernel/number.hpp | 6 +-- src/kernel/boot.cpp | 6 +-- src/kernel/complex.cpp | 2 +- src/kernel/number.cpp | 88 ++++++++++++++++---------------- 6 files changed, 55 insertions(+), 53 deletions(-) diff --git a/README.md b/README.md index 821b3d45d..31c2f4606 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.281.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.282.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.281_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.281_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.282_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.282_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 57765b94b..7ba845667 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.281 +0.5.282 diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 06c42c24b..a59bad800 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -337,7 +337,7 @@ inline namespace number auto lcm(object const&, object const&) -> object; - auto sqrt(object const&) -> object; + auto square_root(object const&) -> object; auto pow(object const&, object const&) -> object; @@ -347,9 +347,9 @@ inline namespace number auto floor(object const&) -> object; - auto ceil(object const&) -> object; + auto ceiling(object const&) -> object; - auto trunc(object const&) -> object; + auto truncate(object const&) -> object; auto round(object const&) -> object; diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 6b243390d..d4f404d92 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -462,7 +462,7 @@ namespace meevax::inline kernel library.define("sqrt", [](let const& xs) { - return sqrt(car(xs)); + return square_root(car(xs)); }); library.define("log", [](let const& xs) @@ -1101,12 +1101,12 @@ namespace meevax::inline kernel library.define("ceiling", [](let const& xs) { - return ceil(car(xs)); + return ceiling(car(xs)); }); library.define("truncate", [](let const& xs) { - return trunc(car(xs)); + return truncate(car(xs)); }); library.define("round", [](let const& xs) diff --git a/src/kernel/complex.cpp b/src/kernel/complex.cpp index 3267c12dd..6a815baad 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 sqrt(x * x + y * y); + return square_root(x * x + y * y); }; return hypotenuse(real_part(x), diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 00675b76d..3ee7958ca 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -757,7 +757,7 @@ inline namespace number } else if constexpr (std::is_same_v) { - return sqrt(x.real() * x.real() + x.imag() * x.imag()); + return square_root(x.real() * x.real() + x.imag() * x.imag()); } else { @@ -771,7 +771,7 @@ inline namespace number auto quotient(object const& x, object const& y) -> object { - return trunc(x / y); + return truncate(x / y); } auto remainder(object const& x, object const& y) -> object @@ -794,7 +794,7 @@ inline namespace number return abs(quotient(x * y, gcd(x, y))); } - auto sqrt(object const& x) -> object + auto square_root(object const& x) -> object { auto f = [](T const& x) { @@ -807,7 +807,7 @@ inline namespace number } else { - auto sqrt = [](auto&& x) + auto square_root = [](auto const& x) { if constexpr (std::is_same_v) { @@ -817,12 +817,12 @@ inline namespace number } else { - return make(std::sqrt(static_cast(std::forward(x)))); + return make(std::sqrt(static_cast(x))); } }; - return x < exact_integer(0) ? make(e0, sqrt(exact_integer(0) - x)) - : sqrt(x); + return x < exact_integer(0) ? make(e0, square_root(exact_integer(0) - x)) + : square_root(x); } }; @@ -907,73 +907,75 @@ inline namespace number } } - #define DEFINE(ROUND) \ - auto ROUND(object const& x) -> object \ + #define DEFINE_EXACTNESS_PRESERVED_COMPLEX1(NAME, CMATH) \ + auto NAME(object const& x) -> object \ { \ auto f = [](T const& x) \ { \ if constexpr (std::is_floating_point_v) \ { \ - return std::ROUND(std::forward(x)); \ + return CMATH(x); \ } \ else if constexpr (std::is_same_v) \ { \ - return exact_integer(std::ROUND(static_cast(std::forward(x)))); \ + return exact_integer(CMATH(static_cast(x))); \ } \ else if constexpr (std::is_same_v) \ { \ - return std::forward(x); \ + return x; \ } \ else \ { \ - return complex(ROUND(x.real()), \ - ROUND(x.imag())); \ + return complex(NAME(x.real()), \ + NAME(x.imag())); \ } \ }; \ \ return apply_to(f, x); \ - } \ - static_assert(true) - - DEFINE(floor); - DEFINE(ceil); - DEFINE(trunc); - DEFINE(round); + } - #undef DEFINE + DEFINE_EXACTNESS_PRESERVED_COMPLEX1(ceiling, std::ceil) + DEFINE_EXACTNESS_PRESERVED_COMPLEX1(floor, std::floor) + DEFINE_EXACTNESS_PRESERVED_COMPLEX1(round, std::round) + DEFINE_EXACTNESS_PRESERVED_COMPLEX1(truncate, std::trunc) - #define DEFINE(CMATH) \ - auto CMATH(object const& x) -> object \ + #define DEFINE_COMPLEX1(NAME, CMATH) \ + auto NAME(object const& x) -> object \ { \ auto f = [](T const& x) \ { \ if constexpr (std::is_same_v) \ { \ - auto const z = std::CMATH(static_cast>(std::forward(x))); \ + auto const z = CMATH(static_cast>(std::forward(x))); \ \ return complex(make(z.real()), \ make(z.imag())); \ } \ else \ { \ - return std::CMATH(static_cast(std::forward(x))); \ + return CMATH(static_cast(std::forward(x))); \ } \ }; \ \ return apply_to(f, x); \ - } \ - static_assert(true) - - DEFINE(sin); DEFINE(asin); DEFINE(sinh); DEFINE(asinh); - DEFINE(cos); DEFINE(acos); DEFINE(cosh); DEFINE(acosh); - DEFINE(tan); DEFINE(atan); DEFINE(tanh); DEFINE(atanh); - - DEFINE(exp); - DEFINE(log); - - #undef DEFINE + } - #define DEFINE_REAL_UNARY(NAME, CMATH) \ + 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 \ { \ auto f = [](auto&& x) \ @@ -984,9 +986,9 @@ inline namespace number return apply_to(f, x); \ } - DEFINE_REAL_UNARY(gamma, std::tgamma) + DEFINE_REAL1(gamma, std::tgamma) - #define DEFINE_REAL_BINARY(NAME, CMATH) \ + #define DEFINE_REAL2(NAME, CMATH) \ auto NAME(object const& x, object const& y) -> object \ { \ auto f = [](auto&& x, auto&& y) \ @@ -998,9 +1000,9 @@ inline namespace number return apply_to(f, x, y); \ } - DEFINE_REAL_BINARY(atan, std::atan2) - DEFINE_REAL_BINARY(copy_sign, std::copysign) - DEFINE_REAL_BINARY(next_after, std::nextafter) + DEFINE_REAL2(atan, std::atan2) + DEFINE_REAL2(copy_sign, std::copysign) + DEFINE_REAL2(next_after, std::nextafter) auto load_exponent(object const& x, object const& y) -> object { From cfa6b02648c591be9f9588aed4b2e3696b127e91 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 13:39:46 +0900 Subject: [PATCH 07/16] Add new procedures `binary64-(integral|fractional)-part` Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- basis/srfi-144.ss | 10 ++++- include/meevax/kernel/number.hpp | 10 ++--- src/kernel/boot.cpp | 13 +++++++ src/kernel/number.cpp | 64 ++++++++++++++++---------------- test/srfi-144.ss | 8 +++- 7 files changed, 69 insertions(+), 42 deletions(-) diff --git a/README.md b/README.md index 31c2f4606..a86a6feab 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.282.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.283.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.282_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.282_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.283_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.283_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 7ba845667..d086d766d 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.282 +0.5.283 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 1a11b6123..13875d113 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -4,6 +4,8 @@ FP_ILOGB0 FP_ILOGBNAN binary64-epsilon + binary64-fractional-part + binary64-integral-part binary64-max binary64-min copy-sign @@ -21,6 +23,7 @@ define expt inexact + values ) (only (scheme inexact) cos @@ -42,7 +45,8 @@ flonum fladjacent flcopysign make-flonum - ; flinteger-fraction flexponent flinteger-exponent + flinteger-fraction + ; flexponent flinteger-exponent ; flnormalized-fraction-exponent flsign-bit ; ; flonum? fl=? fl? fl<=? fl>=? @@ -163,5 +167,9 @@ (define flcopysign copy-sign) (define make-flonum load-exponent) + + (define (flinteger-fraction x) + (values (binary64-integral-part x) + (binary64-fractional-part x))) ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index a59bad800..6e0eb3cc8 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -345,6 +345,10 @@ inline namespace number auto denominator(object const&) -> object; + auto load_exponent(object const&, object const&) -> object; + + auto number_to_string(object const&, int) -> object; + auto floor(object const&) -> object; auto ceiling(object const&) -> object; @@ -385,13 +389,9 @@ inline namespace number auto gamma(object const&) -> object; - auto next_after(object const&, object const&) -> object; - auto copy_sign(object const&, object const&) -> object; - auto load_exponent(object const&, object const&) -> object; - - auto number_to_string(object const&, int) -> object; + auto next_after(object const&, object const&) -> object; } // namespace number } // namespace kernel } // namespace meevax diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index d4f404d92..a8667c6f7 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -570,6 +570,19 @@ namespace meevax::inline kernel return load_exponent(car(xs), cadr(xs)); }); + library.define("binary64-integral-part", [](let const& xs) + { + auto integral_part = 0.0; + std::modf(car(xs).as(), &integral_part); + return make(integral_part); + }); + + library.define("binary64-fractional-part", [](let const& xs) + { + auto integral_part = 0.0; + return make(std::modf(car(xs).as(), &integral_part)); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 3ee7958ca..3c8b4d85d 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -907,6 +907,38 @@ inline namespace number } } + auto load_exponent(object const& x, object const& y) -> object + { + auto f = [](auto&& x, auto&& y) + { + return std::ldexp(static_cast(std::forward(x)), + static_cast(std::forward(y))); + }; + + return apply_to(f, x, y); + } + + auto number_to_string(object const& x, int radix) -> object + { + auto f = [radix](T const& x) + { + if constexpr (std::is_floating_point_v) + { + return string("TODO"); + } + else if constexpr (std::is_same_v) + { + return string(std::unique_ptr(mpz_get_str(nullptr, radix, x.value)).get()); + } + else + { + return string("TODO"); + } + }; + + return apply_to(f, x); + } + #define DEFINE_EXACTNESS_PRESERVED_COMPLEX1(NAME, CMATH) \ auto NAME(object const& x) -> object \ { \ @@ -1003,37 +1035,5 @@ inline namespace number DEFINE_REAL2(atan, std::atan2) DEFINE_REAL2(copy_sign, std::copysign) DEFINE_REAL2(next_after, std::nextafter) - - auto load_exponent(object const& x, object const& y) -> object - { - auto f = [](auto&& x, auto&& y) - { - return std::ldexp(static_cast(std::forward(x)), - static_cast(std::forward(y))); - }; - - return apply_to(f, x, y); - } - - auto number_to_string(object const& x, int radix) -> object - { - auto f = [radix](T const& x) - { - if constexpr (std::is_floating_point_v) - { - return string("TODO"); - } - else if constexpr (std::is_same_v) - { - return string(std::unique_ptr(mpz_get_str(nullptr, radix, x.value)).get()); - } - else - { - return string("TODO"); - } - }; - - return apply_to(f, x); - } } // namespace number } // namespace meevax::kernel diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 0f0995e29..f4600cf26 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -122,6 +122,12 @@ (check (make-flonum 3.0 4) => 48.0) +(call-with-values + (lambda () (flinteger-fraction 3.14)) + (lambda (integral fractional) + (check integral (=> =) 3.0) + (check fractional (=> =) 0.14))) + (check-report) -(exit (check-passed? 59)) +(exit (check-passed? 61)) From 745e64751b2ee5ca2caab6d2d9e13e062cac460a Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 13:51:03 +0900 Subject: [PATCH 08/16] Add new procedures `binary64-exponent` and `binary64-integer-exponent` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 9 +++++++-- src/kernel/boot.cpp | 10 ++++++++++ test/srfi-144.ss | 10 +++++++++- 5 files changed, 29 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index a86a6feab..2684bbbe5 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.283.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.284.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.283_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.283_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.284_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.284_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 d086d766d..97bd45ba8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.283 +0.5.284 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 13875d113..3605b85f7 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -4,7 +4,9 @@ FP_ILOGB0 FP_ILOGBNAN binary64-epsilon + binary64-exponent binary64-fractional-part + binary64-integer-exponent binary64-integral-part binary64-max binary64-min @@ -45,8 +47,7 @@ flonum fladjacent flcopysign make-flonum - flinteger-fraction - ; flexponent flinteger-exponent + flinteger-fraction flexponent flinteger-exponent ; flnormalized-fraction-exponent flsign-bit ; ; flonum? fl=? fl? fl<=? fl>=? @@ -171,5 +172,9 @@ (define (flinteger-fraction x) (values (binary64-integral-part x) (binary64-fractional-part x))) + + (define flexponent binary64-exponent) + + (define flinteger-exponent binary64-integer-exponent) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index a8667c6f7..b81e4f1f9 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -583,6 +583,16 @@ namespace meevax::inline kernel return make(std::modf(car(xs).as(), &integral_part)); }); + library.define("binary64-exponent", [](let const& xs) + { + return make(std::logb(car(xs).as())); + }); + + library.define("binary64-integer-exponent", [](let const& xs) + { + return make(std::ilogb(car(xs).as())); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); diff --git a/test/srfi-144.ss b/test/srfi-144.ss index f4600cf26..cfca79f76 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -128,6 +128,14 @@ (check integral (=> =) 3.0) (check fractional (=> =) 0.14))) +(check (flexponent 48.0) => 5.0) + +(check (flexponent -48.0) => 5.0) + +(check (flinteger-exponent 48.0) => 5) + +(check (flinteger-exponent -48.0) => 5) + (check-report) -(exit (check-passed? 61)) +(exit (check-passed? 65)) From 38847b7931547a58ae34474e3e6dc4d182ffb6af Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 17:18:56 +0900 Subject: [PATCH 09/16] Add procedures `binary64-normalized-fraction` and `binary64-exponent` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 15 +++++++++++---- src/kernel/boot.cpp | 17 +++++++++++++++-- 4 files changed, 29 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 2684bbbe5..b707ee102 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.284.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.285.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.284_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.284_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.285_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.285_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 97bd45ba8..10c6f5664 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.284 +0.5.285 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 3605b85f7..b8b9cfb2f 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -6,10 +6,12 @@ binary64-epsilon binary64-exponent binary64-fractional-part - binary64-integer-exponent + binary64-integer-log-binary binary64-integral-part + binary64-log-binary binary64-max binary64-min + binary64-normalized-fraction copy-sign e euler @@ -48,7 +50,8 @@ flonum fladjacent flcopysign make-flonum flinteger-fraction flexponent flinteger-exponent - ; flnormalized-fraction-exponent flsign-bit + flnormalized-fraction-exponent + ;flsign-bit ; ; flonum? fl=? fl? fl<=? fl>=? ; flunordered? flinteger? flzero? flpositive? flnegative? @@ -173,8 +176,12 @@ (values (binary64-integral-part x) (binary64-fractional-part x))) - (define flexponent binary64-exponent) + (define flexponent binary64-log-binary) - (define flinteger-exponent binary64-integer-exponent) + (define flinteger-exponent binary64-integer-log-binary) + + (define (flnormalized-fraction-exponent x) + (values (binary64-normalized-fraction x) + (binary64-exponent x))) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index b81e4f1f9..9f2ae2d30 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -583,16 +583,29 @@ namespace meevax::inline kernel return make(std::modf(car(xs).as(), &integral_part)); }); - library.define("binary64-exponent", [](let const& xs) + library.define("binary64-log-binary", [](let const& xs) { return make(std::logb(car(xs).as())); }); - library.define("binary64-integer-exponent", [](let const& xs) + library.define("binary64-integer-log-binary", [](let const& xs) { return make(std::ilogb(car(xs).as())); }); + library.define("binary64-normalized-fraction", [](let const& xs) + { + auto exponent = 0; + return make(std::frexp(car(xs).as(), &exponent)); + }); + + library.define("binary64-exponent", [](let const& xs) + { + auto exponent = 0; + std::frexp(car(xs).as(), &exponent); + return make(exponent); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); From 4cd524edae39f149aee08c31a8844670a6c9c193 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 18:16:00 +0900 Subject: [PATCH 10/16] Add procedure `flsign-bit` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 11 ++++++++--- src/kernel/boot.cpp | 5 +++++ test/srfi-144.ss | 12 +++++++++++- 5 files changed, 27 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index b707ee102..121654e53 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.285.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.286.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.285_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.285_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.286_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.286_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 10c6f5664..68787ab6f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.285 +0.5.286 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index b8b9cfb2f..d2274947f 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -12,6 +12,7 @@ binary64-max binary64-min binary64-normalized-fraction + binary64-sign-bit copy-sign e euler @@ -26,6 +27,7 @@ / define expt + if inexact values ) @@ -50,9 +52,8 @@ flonum fladjacent flcopysign make-flonum flinteger-fraction flexponent flinteger-exponent - flnormalized-fraction-exponent - ;flsign-bit - ; + flnormalized-fraction-exponent flsign-bit + ; flonum? fl=? fl? fl<=? fl>=? ; flunordered? flinteger? flzero? flpositive? flnegative? ; flodd? fleven? flfinite? flinfinite? flnan? @@ -183,5 +184,9 @@ (define (flnormalized-fraction-exponent x) (values (binary64-normalized-fraction x) (binary64-exponent x))) + + (define (flsign-bit x) + (if (binary64-sign-bit x) 1 0)) + ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 9f2ae2d30..769948547 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -606,6 +606,11 @@ namespace meevax::inline kernel return make(exponent); }); + library.define("binary64-sign-bit", [](let const& xs) + { + return make(std::signbit(car(xs).as())); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); diff --git a/test/srfi-144.ss b/test/srfi-144.ss index cfca79f76..4b552bf47 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -136,6 +136,16 @@ (check (flinteger-exponent -48.0) => 5) +(call-with-values + (lambda () (flnormalized-fraction-exponent 48.0)) + (lambda (fraction exponent) + (check fraction => 0.75) + (check exponent => 6))) + +(check (flsign-bit 3.14) => 0) + +(check (flsign-bit -3.14) => 1) + (check-report) -(exit (check-passed? 65)) +(exit (check-passed? 69)) From b02e966bcabb787a84a2caed4ac1656beaca2f01 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 18:51:48 +0900 Subject: [PATCH 11/16] Add procedures `binary64-normalized?` and `binary64-denormalized?` Signed-off-by: yamacir-kit --- README.md | 4 +-- VERSION | 2 +- basis/srfi-144.ss | 73 +++++++++++++++++++++++++++++++++++++++------ src/kernel/boot.cpp | 14 ++++++--- test/srfi-144.ss | 44 ++++++++++++++++++++++++++- 5 files changed, 120 insertions(+), 17 deletions(-) diff --git a/README.md b/README.md index 121654e53..76b7eb8e3 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.286.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.287.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.286_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.286_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.287_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.287_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 68787ab6f..bd4dd1e37 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.286 +0.5.287 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index d2274947f..93208d1e4 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -1,8 +1,7 @@ (define-library (srfi 144) (import (only (meevax inexact) FP_FAST_FMA - FP_ILOGB0 - FP_ILOGBNAN + binary64-denormalized? binary64-epsilon binary64-exponent binary64-fractional-part @@ -12,7 +11,9 @@ binary64-max binary64-min binary64-normalized-fraction + binary64-normalized? binary64-sign-bit + binary64? copy-sign e euler @@ -25,15 +26,31 @@ (only (scheme base) * / + < + <= + = + > + >= + and define + even? expt if inexact + integer? + negative? + odd? + or + positive? values + zero? ) (only (scheme inexact) cos + finite? + infinite? log + nan? sin sqrt ) @@ -54,11 +71,10 @@ flinteger-fraction flexponent flinteger-exponent flnormalized-fraction-exponent flsign-bit - ; flonum? fl=? fl? fl<=? fl>=? - ; flunordered? flinteger? flzero? flpositive? flnegative? - ; flodd? fleven? flfinite? flinfinite? flnan? - ; flnormalized? fldenormalized? - ; + flonum? fl=? fl? fl<=? fl>=? flunordered? flinteger? flzero? + flpositive? flnegative? flodd? fleven? flfinite? flinfinite? flnan? + flnormalized? fldenormalized? + ; flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff ; flposdiff flsgn flnumerator fldenominator ; flfloor flceiling flround fltruncate @@ -161,9 +177,9 @@ (define fl-fast-fl+* FP_FAST_FMA) - (define fl-integer-exponent-zero FP_ILOGB0) + (define fl-integer-exponent-zero (binary64-integer-log-binary 0.0)) - (define fl-integer-exponent-nan FP_ILOGBNAN) + (define fl-integer-exponent-nan (binary64-integer-log-binary +nan.0)) (define flonum inexact) @@ -188,5 +204,44 @@ (define (flsign-bit x) (if (binary64-sign-bit x) 1 0)) + (define flonum? binary64?) + + (define fl=? =) + + (define fl? >) + + (define fl<=? <=) + + (define fl>=? >=) + + (define (flunordered? x y) + (or (nan? x) + (nan? y))) + + (define (flinteger? x) + (and (binary64? x) + (integer? x))) + + (define flzero? zero?) + + (define flpositive? positive?) + + (define flnegative? negative?) + + (define flodd? odd?) + + (define fleven? even?) + + (define flfinite? finite?) + + (define flinfinite? infinite?) + + (define flnan? nan?) + + (define flnormalized? binary64-normalized?) + + (define fldenormalized? binary64-denormalized?) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 769948547..ed6aaf6e0 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -611,6 +611,16 @@ namespace meevax::inline kernel return make(std::signbit(car(xs).as())); }); + library.define("binary64-normalized?", [](let const& xs) + { + return std::fpclassify(car(xs).as()) == FP_NORMAL; + }); + + library.define("binary64-denormalized?", [](let const& xs) + { + return std::fpclassify(car(xs).as()) == FP_SUBNORMAL; + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); @@ -625,10 +635,6 @@ namespace meevax::inline kernel library.define("binary64-epsilon", std::numeric_limits::epsilon()); - library.define("FP_ILOGB0", FP_ILOGB0); - - library.define("FP_ILOGBNAN", FP_ILOGBNAN); - #ifdef FP_FAST_FMA library.define("FP_FAST_FMA", true); #else diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 4b552bf47..ef08d60ef 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -146,6 +146,48 @@ (check (flsign-bit -3.14) => 1) +(check (flonum? 1.0) => #t) + +(check (flonum? 1.0f0) => #f) + +(check (procedure? fl=?) => #t) + +(check (procedure? fl #t) + +(check (procedure? fl>?) => #t) + +(check (procedure? fl<=?) => #t) + +(check (procedure? fl>=?) => #t) + +(check (flunordered? 1.0 2.0) => #f) + +(check (flunordered? 1.0 +nan.0) => #t) + +(check (flinteger? 3.14) => #f) + +(check (flinteger? 1.0) => #t) + +(check (procedure? flzero?) => #t) + +(check (procedure? flpositive?) => #t) + +(check (procedure? flnegative?) => #t) + +(check (procedure? flodd?) => #t) + +(check (procedure? fleven?) => #t) + +(check (procedure? flfinite?) => #t) + +(check (procedure? flinfinite?) => #t) + +(check (procedure? flnan?) => #t) + +(check (flnormalized? 1.0) => #t) + +(check (fldenormalized? (/ fl-least 2)) => #t) + (check-report) -(exit (check-passed? 69)) +(exit (check-passed? 90)) From c854f59ff590aec82399ed4da57c2dba81841f03 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Mon, 9 Dec 2024 22:23:18 +0900 Subject: [PATCH 12/16] Move `binary64-` prefixed procedures into library `(meevax binary64)` Signed-off-by: yamacir-kit --- README.md | 4 +-- VERSION | 2 +- basis/srfi-144.ss | 4 ++- src/kernel/boot.cpp | 66 ++++++++++++++++++++++++--------------------- test/number.ss | 3 ++- test/srfi-144.ss | 9 +++---- 6 files changed, 48 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index 76b7eb8e3..dde5dd590 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.287.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.288.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.287_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.287_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.288_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.288_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 bd4dd1e37..f8dc1ad47 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.287 +0.5.288 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 93208d1e4..11a2eb6ad 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -1,5 +1,5 @@ (define-library (srfi 144) - (import (only (meevax inexact) + (import (only (meevax binary64) FP_FAST_FMA binary64-denormalized? binary64-epsilon @@ -14,6 +14,8 @@ binary64-normalized? binary64-sign-bit binary64? + ) + (only (meevax inexact) copy-sign e euler diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index ed6aaf6e0..c34ed991a 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -430,16 +430,6 @@ namespace meevax::inline kernel define("(meevax inexact)", [](library & library) { - library.define("binary32?", [](let const& xs) - { - return std::numeric_limits::is_iec559 and car(xs).is(); - }); - - library.define("binary64?", [](let const& xs) - { - return std::numeric_limits::is_iec559 and car(xs).is(); - }); - library.define("finite?", [](let const& xs) { return is_finite(car(xs)); @@ -570,6 +560,42 @@ namespace meevax::inline kernel return load_exponent(car(xs), cadr(xs)); }); + library.define("e", std::numbers::e); + + library.define("pi", std::numbers::pi); + + library.define("euler", std::numbers::egamma); + + library.define("phi", std::numbers::phi); + }); + + define("(meevax binary32)", [](library & library) + { + library.define("binary32?", [](let const& xs) + { + return std::numeric_limits::is_iec559 and car(xs).is(); + }); + }); + + define("(meevax binary64)", [](library & library) + { + library.define("binary64?", [](let const& xs) + { + return std::numeric_limits::is_iec559 and car(xs).is(); + }); + + library.define("binary64-min", std::numeric_limits::min()); + + library.define("binary64-max", std::numeric_limits::max()); + + library.define("binary64-epsilon", std::numeric_limits::epsilon()); + + #ifdef FP_FAST_FMA + library.define("FP_FAST_FMA", true); + #else + library.define("FP_FAST_FMA", false); + #endif + library.define("binary64-integral-part", [](let const& xs) { auto integral_part = 0.0; @@ -620,26 +646,6 @@ namespace meevax::inline kernel { return std::fpclassify(car(xs).as()) == FP_SUBNORMAL; }); - - library.define("e", std::numbers::e); - - library.define("pi", std::numbers::pi); - - library.define("euler", std::numbers::egamma); - - library.define("phi", std::numbers::phi); - - library.define("binary64-max", std::numeric_limits::max()); - - library.define("binary64-min", std::numeric_limits::min()); - - library.define("binary64-epsilon", std::numeric_limits::epsilon()); - - #ifdef FP_FAST_FMA - library.define("FP_FAST_FMA", true); - #else - library.define("FP_FAST_FMA", false); - #endif }); define("(meevax list)", [](library & library) diff --git a/test/number.ss b/test/number.ss index 1631447c6..6b6ac8a5b 100644 --- a/test/number.ss +++ b/test/number.ss @@ -1,7 +1,8 @@ (import (scheme base) (scheme inexact) (scheme process-context) - (only (meevax inexact) binary32? binary64?) + (only (meevax binary32) binary32?) + (only (meevax binary64) binary64?) (srfi 78) (srfi 144)) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index ef08d60ef..72636d812 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -1,5 +1,4 @@ -(import (only (meevax inexact) binary64?) - (scheme base) +(import (scheme base) (scheme process-context) (srfi 78) (srfi 144)) @@ -82,15 +81,15 @@ (check fl-gamma-2/3 => 1.3541179394264004169452880281545137855193) -(check (binary64? fl-greatest) => #t) +(check (flonum? fl-greatest) => #t) -(check (binary64? fl-least) => #t) +(check (flonum? fl-least) => #t) (check (< 0.0 0.0) => #f) (check (< 0.0 fl-least) => #t) -(check (binary64? fl-epsilon) => #t) +(check (flonum? fl-epsilon) => #t) (check (boolean? fl-fast-fl+*) => #t) From 020803921c5c85ce247a9b5d435ba088d6639ae2 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 11 Dec 2024 23:15:01 +0900 Subject: [PATCH 13/16] Add procedures `binary64-max` and `binary64-min` Signed-off-by: yamacir-kit --- README.md | 4 +-- VERSION | 2 +- basis/srfi-144.ss | 13 ++++++--- include/meevax/kernel/number.hpp | 4 --- src/kernel/boot.cpp | 46 +++++++++++++++++++++++++++++--- src/kernel/number.cpp | 24 ----------------- test/srfi-144.ss | 14 +++++++++- 7 files changed, 68 insertions(+), 39 deletions(-) diff --git a/README.md b/README.md index dde5dd590..c86ad34d1 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.288.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.289.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.288_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.288_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.289_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.289_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 f8dc1ad47..f4db1a910 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.288 +0.5.289 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 11a2eb6ad..0955b4157 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -5,8 +5,10 @@ binary64-epsilon binary64-exponent binary64-fractional-part + binary64-greatest binary64-integer-log-binary binary64-integral-part + binary64-least binary64-log-binary binary64-max binary64-min @@ -77,7 +79,8 @@ flpositive? flnegative? flodd? fleven? flfinite? flinfinite? flnan? flnormalized? fldenormalized? - ; flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff + flmax flmin + ; fl+ fl* fl+* fl- fl/ flabs flabsdiff ; flposdiff flsgn flnumerator fldenominator ; flfloor flceiling flround fltruncate ; @@ -171,9 +174,9 @@ (define fl-gamma-2/3 (gamma (/ 2 3))) - (define fl-greatest binary64-max) + (define fl-greatest binary64-greatest) - (define fl-least binary64-min) + (define fl-least binary64-least) (define fl-epsilon binary64-epsilon) @@ -245,5 +248,9 @@ (define flnormalized? binary64-normalized?) (define fldenormalized? binary64-denormalized?) + + (define flmax binary64-max) + + (define flmin binary64-min) ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index 6e0eb3cc8..d81ae4fe7 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -321,10 +321,6 @@ inline namespace number auto is_even(object const&) -> bool; - auto max(object const&) -> object; - - auto min(object const&) -> object; - auto abs(object const&) -> object; auto quotient(object const&, object const&) -> object; diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index c34ed991a..bd3f59aba 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -584,9 +584,9 @@ namespace meevax::inline kernel return std::numeric_limits::is_iec559 and car(xs).is(); }); - library.define("binary64-min", std::numeric_limits::min()); + library.define("binary64-least", std::numeric_limits::min()); - library.define("binary64-max", std::numeric_limits::max()); + library.define("binary64-greatest", std::numeric_limits::max()); library.define("binary64-epsilon", std::numeric_limits::epsilon()); @@ -646,6 +646,30 @@ namespace meevax::inline kernel { return std::fpclassify(car(xs).as()) == FP_SUBNORMAL; }); + + library.define("binary64-max", [](let const& xs) + { + auto max = -std::numeric_limits::infinity(); + + for (let const& x : xs) + { + max = std::fmax(max, x.as()); + } + + return make(max); + }); + + library.define("binary64-min", [](let const& xs) + { + auto min = std::numeric_limits::infinity(); + + for (let const& x : xs) + { + min = std::fmin(min, x.as()); + } + + return make(min); + }); }); define("(meevax list)", [](library & library) @@ -1045,12 +1069,26 @@ namespace meevax::inline kernel library.define("max", [](let const& xs) { - return max(xs); + if (auto iter = std::max_element(xs.begin(), xs.end(), less_than); iter != xs.end()) + { + return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter; + } + else + { + return unspecified; + } }); library.define("min", [](let const& xs) { - return min(xs); + if (auto iter = std::min_element(xs.begin(), xs.end(), less_than); iter != xs.end()) + { + return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter; + } + else + { + return unspecified; + } }); library.define("+", [](let const& xs) diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 3c8b4d85d..8d56b547c 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -717,30 +717,6 @@ inline namespace number return is_zero(remainder(x, e2)); } - auto max(object const& xs) -> object - { - if (auto iter = std::max_element(xs.begin(), xs.end(), less_than); iter != xs.end()) - { - return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter; - } - else - { - return unspecified; - } - } - - auto min(object const& xs) -> object - { - if (auto iter = std::min_element(xs.begin(), xs.end(), less_than); iter != xs.end()) - { - return std::any_of(xs.begin(), xs.end(), is_inexact) ? inexact(*iter) : *iter; - } - else - { - return unspecified; - } - } - auto abs(object const& x) -> object { auto f = [](T const& x) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 72636d812..961188739 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -187,6 +187,18 @@ (check (fldenormalized? (/ fl-least 2)) => #t) +(check (flmax) => -inf.0) + +(check (flmax 0.0) => 0.0) + +(check (flmax -1.0 0.0 1.0) => 1.0) + +(check (flmin) => +inf.0) + +(check (flmin 0.0) => 0.0) + +(check (flmin -1.0 0.0 1.0) => -1.0) + (check-report) -(exit (check-passed? 90)) +(exit (check-passed? 96)) From 917e3c5fd3ebc5a9c529df007bb3781e9400c3de Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 11 Dec 2024 23:23:28 +0900 Subject: [PATCH 14/16] Add new procedure `binary64-fused-multiply-add` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 17 +++++++++++++++-- src/kernel/boot.cpp | 5 +++++ test/srfi-144.ss | 12 +++++++++++- 5 files changed, 34 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index c86ad34d1..617d6884c 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.289.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.290.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.289_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.289_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.290_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.290_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 f4db1a910..590f07cdb 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.289 +0.5.290 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 0955b4157..5dd72659b 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -5,6 +5,7 @@ binary64-epsilon binary64-exponent binary64-fractional-part + binary64-fused-multiply-add binary64-greatest binary64-integer-log-binary binary64-integral-part @@ -29,6 +30,8 @@ ) (only (scheme base) * + + + - / < <= @@ -79,8 +82,8 @@ flpositive? flnegative? flodd? fleven? flfinite? flinfinite? flnan? flnormalized? fldenormalized? - flmax flmin - ; fl+ fl* fl+* fl- fl/ flabs flabsdiff + flmax flmin fl+ fl* fl+* fl- fl/ + ; flabs flabsdiff ; flposdiff flsgn flnumerator fldenominator ; flfloor flceiling flround fltruncate ; @@ -252,5 +255,15 @@ (define flmax binary64-max) (define flmin binary64-min) + + (define fl+ +) + + (define fl* *) + + (define fl+* binary64-fused-multiply-add) + + (define fl- -) + + (define fl/ /) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index bd3f59aba..19ef695ea 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -670,6 +670,11 @@ namespace meevax::inline kernel return make(min); }); + + library.define("binary64-fused-multiply-add", [](let const& xs) + { + return make(std::fma(car(xs).as(), cadr(xs).as(), caddr(xs).as())); + }); }); define("(meevax list)", [](library & library) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 961188739..27c23625d 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -199,6 +199,16 @@ (check (flmin -1.0 0.0 1.0) => -1.0) +(check (procedure? fl+) => #t) + +(check (procedure? fl*) => #t) + +(check (fl+* 2.0 3.0 4.0) => 10.0) + +(check (procedure? fl-) => #t) + +(check (procedure? fl/) => #t) + (check-report) -(exit (check-passed? 96)) +(exit (check-passed? 101)) From 6e82c4dd151bf85d9f9b65b127efde8fb12c36e1 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Wed, 11 Dec 2024 23:35:01 +0900 Subject: [PATCH 15/16] Add procedure `binary64-abs` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 9 +++++++-- src/kernel/boot.cpp | 5 +++++ test/srfi-144.ss | 14 +++++++++++++- 5 files changed, 28 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 617d6884c..c9360ddef 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.290.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.291.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.290_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.290_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.291_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.291_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 590f07cdb..b6cc14f9f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.290 +0.5.291 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 5dd72659b..3619e19ba 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -1,6 +1,7 @@ (define-library (srfi 144) (import (only (meevax binary64) FP_FAST_FMA + binary64-abs binary64-denormalized? binary64-epsilon binary64-exponent @@ -82,8 +83,7 @@ flpositive? flnegative? flodd? fleven? flfinite? flinfinite? flnan? flnormalized? fldenormalized? - flmax flmin fl+ fl* fl+* fl- fl/ - ; flabs flabsdiff + flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff ; flposdiff flsgn flnumerator fldenominator ; flfloor flceiling flround fltruncate ; @@ -265,5 +265,10 @@ (define fl- -) (define fl/ /) + + (define flabs binary64-abs) + + (define (flabsdiff x y) + (flabs (- x y))) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 19ef695ea..603d8f571 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -675,6 +675,11 @@ 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())); + }); }); define("(meevax list)", [](library & library) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 27c23625d..a119026b3 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -209,6 +209,18 @@ (check (procedure? fl/) => #t) +(check (flabs -0.0) => +0.0) + +(check (flabs -inf.0) => +inf.0) + +(check (flabs +inf.0) => +inf.0) + +(check (flabsdiff 0.0 1.0) => 1.0) + +(check (flabsdiff +inf.0 -inf.0) => +inf.0) + +(check (flabsdiff -inf.0 +inf.0) => +inf.0) + (check-report) -(exit (check-passed? 101)) +(exit (check-passed? 107)) From 9aad201d9332998d7d2a62ce231a9ce934b0aafa Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Thu, 12 Dec 2024 00:12:22 +0900 Subject: [PATCH 16/16] Add procedure `binary64-expm1` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 43 ++++++++++++++++++++++++++++++++++++++----- src/kernel/boot.cpp | 5 +++++ test/srfi-144.ss | 42 +++++++++++++++++++++++++++++++++++++++++- 5 files changed, 87 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index c9360ddef..febdf0941 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.291.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.292.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.291_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.291_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.292_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.292_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 b6cc14f9f..d9d175dac 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.291 +0.5.292 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 3619e19ba..283145981 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -4,6 +4,7 @@ binary64-abs binary64-denormalized? binary64-epsilon + binary64-expm1 binary64-exponent binary64-fractional-part binary64-fused-multiply-add @@ -40,21 +41,28 @@ > >= and + ceiling define + denominator even? expt + floor if inexact integer? negative? + numerator odd? or positive? + round + truncate values zero? ) (only (scheme inexact) cos + exp finite? infinite? log @@ -83,11 +91,11 @@ flpositive? flnegative? flodd? fleven? flfinite? flinfinite? flnan? flnormalized? fldenormalized? - flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff - ; flposdiff flsgn flnumerator fldenominator - ; flfloor flceiling flround fltruncate - ; - ; flexp flexp2 flexp-1 flsquare flsqrt flcbrt flhypot flexpt fllog + flmax flmin fl+ fl* fl+* fl- fl/ flabs flabsdiff flposdiff flsgn + flnumerator fldenominator flfloor flceiling flround fltruncate + + flexp flexp2 flexp-1 + ; flsquare flsqrt flcbrt flhypot flexpt fllog ; fllog1+ fllog2 fllog10 make-fllog-base ; ; flsin flcos fltan flasin flacos flatan @@ -270,5 +278,30 @@ (define (flabsdiff x y) (flabs (- x y))) + + (define (flposdiff x y) + (flmax (fl- x y) 0.0)) + + (define (flsgn x) + (flcopysign 1.0 x)) + + (define flnumerator numerator) + + (define fldenominator denominator) + + (define flfloor floor) + + (define flceiling ceiling) + + (define flround round) + + (define fltruncate truncate) + + (define flexp exp) + + (define (flexp2 x) + (expt 2 x)) + + (define flexp-1 binary64-expm1) ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 603d8f571..22f0c4940 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -680,6 +680,11 @@ namespace meevax::inline kernel { return make(std::fabs(car(xs).as())); }); + + library.define("binary64-expm1", [](let const& xs) + { + return make(std::expm1(car(xs).as())); + }); }); define("(meevax list)", [](library & library) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index a119026b3..71d3014c8 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -221,6 +221,46 @@ (check (flabsdiff -inf.0 +inf.0) => +inf.0) +(check (flposdiff 3.0 4.0) => 0.0) + +(check (flsgn +inf.0) => 1.0) + +(check (flsgn -inf.0) => -1.0) + +(check (flsgn +0.0) => 1.0) + +(check (flsgn -0.0) => -1.0) + +(check (numerator 2.25) => 9.0) + +(check (numerator -2.25) => -9.0) + +(check (denominator 2.25) => 4.0) + +(check (denominator -2.25) => 4.0) + +(check (procedure? flfloor) => #t) + +(check (procedure? flceiling) => #t) + +(check (procedure? flround) => #t) + +(check (procedure? fltruncate) => #t) + +(check (flexp -0.0) => 1.0) + +(check (flexp 0.0) => 1.0) + +(check (flexp 1.0) => fl-e) + +(check (flexp2 -0.0) => 1.0) + +(check (flexp2 0.0) => 1.0) + +(check (flexp2 fl-log2-e) => fl-e) + +(check (fl+ 1.0 (flexp-1 fl-least)) => 1.0) + (check-report) -(exit (check-passed? 107)) +(exit (check-passed? 127))