diff --git a/README.md b/README.md index 59008bac7..57f0fe787 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.294.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.295.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `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`. +| `package` | Generate debian package `meevax_0.5.295_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.295_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 f32718d9c..df3b72402 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.294 +0.5.295 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index 60c2d4861..d078afb0c 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -32,6 +32,7 @@ euler gamma load-exponent + log-gamma next-after phi pi @@ -121,8 +122,8 @@ flquotient flremainder flremquo - ; flgamma flloggamma flfirst-bessel flsecond-bessel - ; flerf flerfc + flgamma flloggamma + ; flfirst-bessel flsecond-bessel flerf flerfc ) (begin (define fl-e e) @@ -382,5 +383,11 @@ (values (car rq) (cdr rq)))) + (define flgamma gamma) + + (define (flloggamma x) + (values (log-gamma x) + (if (positive? (gamma x)) 1.0 -1.0))) + ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index d81ae4fe7..a05d1b891 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -385,6 +385,8 @@ inline namespace number auto gamma(object const&) -> object; + auto log_gamma(object const&) -> object; + auto copy_sign(object const&, object const&) -> object; auto next_after(object const&, object const&) -> object; diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index 808c5a0ae..bb17a61a5 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -545,6 +545,11 @@ namespace meevax::inline kernel return gamma(car(xs)); }); + library.define("log-gamma", [](let const& xs) + { + return log_gamma(car(xs)); + }); + library.define("next-after", [](let const& xs) { return next_after(car(xs), cadr(xs)); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index 8d56b547c..d8bc286d3 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -994,7 +994,8 @@ inline namespace number return apply_to(f, x); \ } - DEFINE_REAL1(gamma, std::tgamma) + DEFINE_REAL1(gamma, std::tgamma) + DEFINE_REAL1(log_gamma, std::lgamma) #define DEFINE_REAL2(NAME, CMATH) \ auto NAME(object const& x, object const& y) -> object \ diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 0c3f14d68..75c260e1d 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -343,15 +343,23 @@ (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))) +(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 (flgamma 0.5) => fl-gamma-1/2) +(check (flgamma 2/3) => fl-gamma-2/3) + +(call-with-values (lambda () (flloggamma 0.0)) (lambda (value sign) (check value => +inf.0) (check sign => 1.0))) +(call-with-values (lambda () (flloggamma 0.5)) (lambda (value sign) (check value => (log fl-gamma-1/2)) (check sign => 1.0))) +(call-with-values (lambda () (flloggamma 1.0)) (lambda (value sign) (check value => 0.0) (check sign => 1.0))) +(call-with-values (lambda () (flloggamma +inf.0)) (lambda (value sign) (check value => +inf.0) (check sign => 1.0))) (check-report) -(exit (check-passed? 222)) +(exit (check-passed? 232))