From b02e966bcabb787a84a2caed4ac1656beaca2f01 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 8 Dec 2024 18:51:48 +0900 Subject: [PATCH] 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))