From 917e3c5fd3ebc5a9c529df007bb3781e9400c3de Mon Sep 17 00:00:00 2001
From: yamacir-kit <httperror@404-notfound.jp>
Date: Wed, 11 Dec 2024 23:23:28 +0900
Subject: [PATCH] Add new procedure `binary64-fused-multiply-add`

Signed-off-by: yamacir-kit <httperror@404-notfound.jp>
---
 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<procedure>("binary64-fused-multiply-add", [](let const& xs)
+      {
+        return make(std::fma(car(xs).as<double>(), cadr(xs).as<double>(), caddr(xs).as<double>()));
+      });
     });
 
     define<library>("(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))