From 71e2bbe43df89be74109b7a5e698c6908c6f8825 Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 15 Dec 2024 22:25:35 +0900 Subject: [PATCH] Add procedure `binary64-remquo` Signed-off-by: yamacir-kit --- README.md | 4 +- VERSION | 2 +- basis/srfi-144.ss | 76 +++++++++++++++++++++--- src/kernel/boot.cpp | 7 +++ test/srfi-144.ss | 142 ++++++++++++++++++++++++-------------------- 5 files changed, 155 insertions(+), 76 deletions(-) diff --git a/README.md b/README.md index f35c4a43e..59008bac7 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.293.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.294.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.293_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.293_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.294_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.294_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 46f9dddd7..f32718d9c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.293 +0.5.294 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 480a6ea93..60c2d4861 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -18,11 +18,16 @@ binary64-min binary64-normalized-fraction binary64-normalized? + binary64-remquo binary64-sign-bit binary64? ) (only (meevax inexact) + acosh + asinh + atanh copy-sign + cosh e euler gamma @@ -30,6 +35,8 @@ next-after phi pi + sinh + tanh ) (only (scheme base) * @@ -42,6 +49,8 @@ > >= and + car + cdr ceiling define denominator @@ -51,11 +60,15 @@ if inexact integer? + lambda + let negative? numerator odd? or positive? + quotient + remainder round square truncate @@ -63,6 +76,9 @@ zero? ) (only (scheme inexact) + acos + asin + atan cos exp finite? @@ -71,6 +87,7 @@ nan? sin sqrt + tan ) ) @@ -97,14 +114,13 @@ flnumerator fldenominator flfloor flceiling flround fltruncate flexp flexp2 flexp-1 flsquare flsqrt flcbrt flhypot flexpt fllog - fllog1+ - ; fllog2 fllog10 make-fllog-base - ; - ; flsin flcos fltan flasin flacos flatan - ; flsinh flcosh fltanh flasinh flacosh flatanh - ; - ; flquotient flremainder flremquo - ; + fllog1+ fllog2 fllog10 make-fllog-base + + flsin flcos fltan flasin flacos flatan flsinh flcosh fltanh flasinh + flacosh flatanh + + flquotient flremainder flremquo + ; flgamma flloggamma flfirst-bessel flsecond-bessel ; flerf flerfc ) @@ -322,5 +338,49 @@ (define fllog log) (define fllog1+ binary64-log1p) + + (define (fllog2 x) + (log x 2)) + + (define (fllog10 x) + (log x 10)) + + (define (make-fllog-base b) + (lambda (x) + (log x b))) + + (define flsin sin) + + (define flcos cos) + + (define fltan tan) + + (define flasin asin) + + (define flacos acos) + + (define flatan atan) + + (define flsinh sinh) + + (define flcosh cosh) + + (define fltanh tanh) + + (define flasinh asinh) + + (define flacosh acosh) + + (define flatanh atanh) + + (define flquotient quotient) + + (define flremainder remainder) + + (define (flremquo x y) + (let ((rq (binary64-remquo x y))) + (values (car rq) + (cdr rq)))) + ) ) diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index b12a018e1..808c5a0ae 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -690,6 +690,13 @@ namespace meevax::inline kernel { return make(std::log1p(car(xs).as())); }); + + library.define("binary64-remquo", [](let const& xs) + { + auto quotient = 0; + auto remainder = std::remquo(car(xs).as(), cadr(xs).as(), "ient); + return cons(make(remainder), make(quotient)); + }); }); define("(meevax list)", [](library & library) diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 338271194..0c3f14d68 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -1,4 +1,12 @@ -(import (scheme base) +(import (only (meevax inexact) + acosh + asinh + atanh + cosh + sinh + tanh + ) + (scheme base) (scheme inexact) (scheme process-context) (srfi 78) @@ -83,7 +91,6 @@ (check fl-gamma-2/3 => 1.3541179394264004169452880281545137855193) (check (flonum? fl-greatest) => #t) - (check (flonum? fl-least) => #t) (check (< 0.0 0.0) => #f) @@ -95,21 +102,14 @@ (check (boolean? fl-fast-fl+*) => #t) (check (exact-integer? fl-integer-exponent-zero) => #t) - (check (exact-integer? fl-integer-exponent-nan) => #t) (check (= (flonum 22/7) fl-pi) => #f) - (check (= (flonum 333/106) fl-pi) => #f) - (check (= (flonum 355/113) fl-pi) => #f) - (check (= (flonum 52163/16604) fl-pi) => #f) - (check (= (flonum 103993/33102) fl-pi) => #f) - (check (= (flonum 104348/33215) fl-pi) => #f) - (check (= (flonum 245850922/78256779) fl-pi) => #t) (check (fladjacent 0.0 1.0) (=> =) fl-least) @@ -117,7 +117,6 @@ (check (< 0.0 (fladjacent 0.0 1.0) fl-epsilon 1.0 (+ 1.0 fl-epsilon) fl-greatest +inf.0) => #t) (check (flcopysign 0.0 +inf.0) => 0.0) - (check (flcopysign 0.0 -inf.0) => -0.0) (check (make-flonum 3.0 4) => 48.0) @@ -129,11 +128,9 @@ (check fractional (=> =) 0.14))) (check (flexponent 48.0) => 5.0) - (check (flexponent -48.0) => 5.0) (check (flinteger-exponent 48.0) => 5) - (check (flinteger-exponent -48.0) => 5) (call-with-values @@ -143,11 +140,9 @@ (check exponent => 6))) (check (flsign-bit 3.14) => 0) - (check (flsign-bit -3.14) => 1) (check (flonum? 1.0) => #t) - (check (flonum? 1.0f0) => #f) (check (procedure? fl=?) => #t) @@ -161,11 +156,9 @@ (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) @@ -189,15 +182,11 @@ (check (fldenormalized? (/ fl-least 2)) => #t) (check (flmax) => -inf.0) - (check (flmax 0.0) => 0.0) - (check (flmax -1.0 0.0 1.0) => 1.0) (check (flmin) => +inf.0) - (check (flmin 0.0) => 0.0) - (check (flmin -1.0 0.0 1.0) => -1.0) (check (procedure? fl+) => #t) @@ -211,25 +200,17 @@ (check (procedure? fl/) => #t) (check (flabs -0.0) => +0.0) - (check (flabs -inf.0) => +inf.0) - (check (flabs +inf.0) => +inf.0) (check (flabsdiff 0.0 1.0) => 1.0) - (check (flabsdiff +inf.0 -inf.0) => +inf.0) - (check (flabsdiff -inf.0 +inf.0) => +inf.0) - (check (flposdiff 3.0 4.0) => 0.0) (check (flsgn +inf.0) => 1.0) - (check (flsgn -inf.0) => -1.0) - (check (flsgn +0.0) => 1.0) - (check (flsgn -0.0) => -1.0) (check (numerator 2.25) => 9.0) @@ -249,97 +230,128 @@ (check (procedure? fltruncate) => #t) (check (flexp -0.0) => 1.0) - (check (flexp 0.0) => 1.0) - (check (flexp 1.0) => fl-e) (check (flexp2 -0.0) => 1.0) - (check (flexp2 0.0) => 1.0) - (check (flexp2 fl-log2-e) => fl-e) (check (fl+ 1.0 (flexp-1 fl-least)) => 1.0) (check (flsquare -0.0) => 0.0) - (check (flsquare 0.0) => 0.0) - (check (flsquare 1.0) => 1.0) - (check (flsquare 2.0) => 4.0) (check (flsqrt -0.0) => -0.0) - (check (flsqrt 0.0) => 0.0) - (check (flsqrt 1.0) => 1.0) - (check (flsqrt 2.0) => fl-sqrt-2) - (check (flsqrt 3.0) => fl-sqrt-3) - (check (flsqrt 5.0) => fl-sqrt-5) - (check (flsqrt 10.0) => fl-sqrt-10) (check (flcbrt 0.0) => 0.0) - (check (flcbrt 1.0) => 1.0) - (check (flcbrt 1.0) => 1.0) - (check (flcbrt 2.0) => fl-cbrt-2) - (check (flcbrt 3.0) => fl-cbrt-3) (check (flhypot 0.0 0.0) => 0.0) - (check (flhypot 0.0 1.0) => 1.0) - (check (flhypot 0.0 -1.0) => 1.0) - (check (flhypot 1.0 1.0) => fl-sqrt-2) - (check (flhypot 1.0 2.0) => fl-sqrt-5) - (check (flhypot 1.0 3.0) => fl-sqrt-10) (check (flexpt 0.0 0.0) => 1.0) - (check (flexpt 1.0 0.0) => 1.0) - (check (flexpt 2.0 1.0) => 2.0) - (check (flexpt 2.0 2.0) => 4.0) - (check (flexpt 2.0 3.0) => 8.0) (check (fllog 0.0) => -inf.0) - (check (fllog 1.0) => 0.0) - (check (fllog fl-phi) => fl-log-phi) - (check (fllog 2.0) => fl-log-2) - (check (fllog 3.0) => fl-log-3) - (check (fllog fl-pi) => fl-log-pi) - (check (fllog 10.0) => fl-log-10) (check (fllog1+ 0.0) => 0.0) - (check (fllog1+ fl-least) (=> =) 0.0) - (check (fllog1+ 1.0) => fl-log-2) - (check (fllog1+ 2.0) (=> =) fl-log-3) - (check (fllog1+ 9.0) => fl-log-10) +(check (fllog2 0.0) => -inf.0) +(check (fllog2 1.0) => 0.0) +(check (fllog2 2.0) => 1.0) +(check (fllog2 fl-e) => fl-log2-e) +(check (fllog2 +inf.0) => +inf.0) + +(check (fllog10 0.0) => -inf.0) +(check (fllog10 1.0) => 0.0) +(check (fllog10 10.0) => 1.0) +(check (fllog10 fl-e) (=> =) fl-log10-e) +(check (fllog10 +inf.0) => +inf.0) + +(check ((make-fllog-base 2.0) 0.0) => -inf.0) +(check ((make-fllog-base 2.0) 1.0) => 0.0) +(check ((make-fllog-base 2.0) 2.0) => 1.0) +(check ((make-fllog-base 2.0) fl-e) => fl-log2-e) +(check ((make-fllog-base 2.0) +inf.0) => +inf.0) + +(check ((make-fllog-base 10.0) 0.0) => -inf.0) +(check ((make-fllog-base 10.0) 1.0) => 0.0) +(check ((make-fllog-base 10.0) 10.0) => 1.0) +(check ((make-fllog-base 10.0) fl-e) (=> =) fl-log10-e) +(check ((make-fllog-base 10.0) +inf.0) => +inf.0) + +(check flsin => sin) + +(check flcos => cos) + +(check fltan => tan) + +(check flasin => asin) + +(check flacos => acos) + +(check flatan => atan) + +(check flsinh => sinh) + +(check flcosh => cosh) + +(check fltanh => tanh) + +(check flasinh => asinh) + +(check flacosh => acosh) + +(check flatanh => atanh) + +(check (flquotient 3.14 0.5) => 6.0) +(check (flquotient -3.14 0.5) => -6.0) +(check (flquotient 3.14 -0.5) => -6.0) +(check (flquotient -3.14 -0.5) => 6.0) + +(check (flremainder 3.14 0.5) (=> =) 0.14) +(check (flremainder -3.14 0.5) (=> =) -0.14) +(check (flremainder 3.14 -0.5) (=> =) 0.14) +(check (flremainder -3.14 -0.5) (=> =) -0.14) + +(call-with-values (lambda () (flremquo 5.0 2.0)) (lambda (r q) (check q => 2) (check r => 1.0))) +(call-with-values (lambda () (flremquo 6.0 4.0)) (lambda (r q) (check q => 2) (check r => -2.0))) +(call-with-values (lambda () (flremquo 6.3 3.0)) (lambda (r q) (check q => 2) (check r (=> =) 0.3))) +(call-with-values (lambda () (flremquo 6.3 -3.0)) (lambda (r q) (check q => -2) (check r (=> =) 0.3))) +(call-with-values (lambda () (flremquo -6.3 3.0)) (lambda (r q) (check q => -2) (check r (=> =) -0.3))) +(call-with-values (lambda () (flremquo -6.3 -3.0)) (lambda (r q) (check q => 2) (check r (=> =) -0.3))) +(call-with-values (lambda () (flremquo 6.3 3.15)) (lambda (r q) (check q => 2) (check r => 0.0))) +(call-with-values (lambda () (flremquo 6.0 2.0)) (lambda (r q) (check q => 3) (check r => 0.0))) + (check-report) -(exit (check-passed? 166)) +(exit (check-passed? 222))