From 4cd524edae39f149aee08c31a8844670a6c9c193 Mon Sep 17 00:00:00 2001
From: yamacir-kit <httperror@404-notfound.jp>
Date: Sun, 8 Dec 2024 18:16:00 +0900
Subject: [PATCH] Add procedure `flsign-bit`

Signed-off-by: yamacir-kit <httperror@404-notfound.jp>
---
 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<=? 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<exact_integer>(exponent);
       });
 
+      library.define<procedure>("binary64-sign-bit", [](let const& xs)
+      {
+        return make(std::signbit(car(xs).as<double>()));
+      });
+
       library.define<double>("e", std::numbers::e);
 
       library.define<double>("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))