From cfa6b02648c591be9f9588aed4b2e3696b127e91 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 13:39:46 +0900 Subject: [PATCH] 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))