Add new procedures binary64-(integral|fractional)-part

Signed-off-by: yamacir-kit <[email protected]>

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`.
 

VERSION

@@ -1 +1 @@
-0.5.282
+0.5.283

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<=? 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)))
          )
   )

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

src/kernel/boot.cpp

@@ -570,6 +570,19 @@ namespace meevax::inline kernel
         return load_exponent(car(xs), cadr(xs));
       });
 
+      library.define<procedure>("binary64-integral-part", [](let const& xs)
+      {
+        auto integral_part = 0.0;
+        std::modf(car(xs).as<double>(), &integral_part);
+        return make(integral_part);
+      });
+
+      library.define<procedure>("binary64-fractional-part", [](let const& xs)
+      {
+        auto integral_part = 0.0;
+        return make(std::modf(car(xs).as<double>(), &integral_part));
+      });
+
       library.define<double>("e", std::numbers::e);
 
       library.define<double>("pi", std::numbers::pi);

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<double>(std::forward<decltype(x)>(x)),
+                        static_cast<int   >(std::forward<decltype(y)>(y)));
+    };
+
+    return apply_to<real_numbers>(f, x, y);
+  }
+
+  auto number_to_string(object const& x, int radix) -> object
+  {
+    auto f = [radix]<typename T>(T const& x)
+    {
+      if constexpr (std::is_floating_point_v<T>)
+      {
+        return string("TODO");
+      }
+      else if constexpr (std::is_same_v<T, exact_integer>)
+      {
+        return string(std::unique_ptr<char, gmp_free>(mpz_get_str(nullptr, radix, x.value)).get());
+      }
+      else
+      {
+        return string("TODO");
+      }
+    };
+
+    return apply_to<complex_number>(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<double>(std::forward<decltype(x)>(x)),
-                        static_cast<int   >(std::forward<decltype(y)>(y)));
-    };
-
-    return apply_to<real_numbers>(f, x, y);
-  }
-
-  auto number_to_string(object const& x, int radix) -> object
-  {
-    auto f = [radix]<typename T>(T const& x)
-    {
-      if constexpr (std::is_floating_point_v<T>)
-      {
-        return string("TODO");
-      }
-      else if constexpr (std::is_same_v<T, exact_integer>)
-      {
-        return string(std::unique_ptr<char, gmp_free>(mpz_get_str(nullptr, radix, x.value)).get());
-      }
-      else
-      {
-        return string("TODO");
-      }
-    };
-
-    return apply_to<complex_number>(f, x);
-  }
 } // namespace number
 } // namespace meevax::kernel

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))