diff --git a/README.md b/README.md index 3a457d4c2..37f3593d1 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,7 @@ Procedures for each standard are provided by the following R7RS-style libraries: cmake -B build -DCMAKE_BUILD_TYPE=Release cd build make package -sudo apt install build/meevax_0.5.237_amd64.deb +sudo apt install build/meevax_0.5.238_amd64.deb ``` or @@ -122,9 +122,9 @@ sudo rm -rf /usr/local/share/meevax | Target Name | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.237.so` and executable `meevax` +| `all` | Build shared-library `libmeevax.0.5.238.so` and executable `meevax` | `test` | Test executable `meevax` -| `package` | Generate debian package `meevax_0.5.237_amd64.deb` +| `package` | Generate debian package `meevax_0.5.238_amd64.deb` | `install` | Copy files into `/usr/local` directly ## Usage diff --git a/VERSION b/VERSION index 3eaf9672b..119d20e7e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.237 +0.5.238 diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index c0ecfcfaf..f75d4d572 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -431,6 +431,16 @@ inline namespace kernel define("(meevax inexact)", [](library & library) { + library.define("binary32?", [](let const& xs) + { + return std::numeric_limits::is_iec559 and car(xs).is(); + }); + + library.define("binary64?", [](let const& xs) + { + return std::numeric_limits::is_iec559 and car(xs).is(); + }); + library.define("finite?", [](let const& xs) { return is_finite(car(xs)); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index ffd3f37f2..ee2474e60 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -464,15 +464,49 @@ inline namespace kernel { "fl-1/sqrt-2", M_SQRT1_2 }, }; - auto static const pattern = std::regex(R"(([+-]?(?:\d+\.?|\d*\.\d+))([DEFLSdefls][+-]?\d+)?)"); + auto static const pattern = std::regex(R"([+-]?(?:\d+\.?|\d*\.\d+)(?:([DEFdef])[+-]?\d+)?)"); if (auto iter = constants.find(literal); iter != constants.end()) { return make(iter->second); } - else if (std::regex_match(literal, pattern)) + else if (auto result = std::smatch(); std::regex_match(literal, result, pattern)) { - return make(lexical_cast(literal)); + /* + R7RS 6.2.5. Syntax of numerical constants + + In systems with inexact numbers of varying precisions it can be + useful to specify the precision of a constant. For this purpose, + implementations may accept numerical constants written with an + exponent marker that indicates the desired precision of the inexact + representation. If so, the letter s, f, d, or l, meaning short, + single, double, or long precision, respectively, can be used in + place of e. The default precision has at least as much precision as + double, but implementations may allow this default to be set by the + user. + */ + assert(result.ready()); + assert(result.size() == 2); + + if (result[1].matched) + { + assert(result[1].length() == 1); + + switch (*result[1].first) + { + case 'D': case 'd': + case 'E': case 'e': + default: + return make(std::stod(literal)); + + case 'F': case 'f': + return make(std::stof(literal.substr().replace(result.position(1), 1, "e"))); + } + } + else + { + return make(lexical_cast(literal)); + } } else { diff --git a/test/number.ss b/test/number.ss new file mode 100644 index 000000000..347ed06a3 --- /dev/null +++ b/test/number.ss @@ -0,0 +1,103 @@ +(import (scheme base) + (scheme inexact) + (scheme process-context) + (only (meevax inexact) binary32? binary64?) + (srfi 78)) + +(check (real? 1.0e0) => #t) +(check (binary32? 1.0e0) => #f) +(check (binary64? 1.0e0) => #t) + +(check (real? 1.0f0) => #t) +(check (binary32? 1.0f0) => #t) +(check (binary64? 1.0f0) => #f) + +(check (real? 1.0d0) => #t) +(check (binary32? 1.0d0) => #f) +(check (binary64? 1.0d0) => #t) + +(check (rational? 1/3) => #t) +(check (rational? 0.5) => #t) + +(check (+ 1 2 3) (=> =) 6) +(check (number? (+ 1 2 3)) => #t) +(check (complex? (+ 1 2 3)) => #t) +(check (real? (+ 1 2 3)) => #t) +(check (rational? (+ 1 2 3)) => #t) +(check (integer? (+ 1 2 3)) => #t) +(check (exact? (+ 1 2 3)) => #t) +(check (inexact? (+ 1 2 3)) => #f) + +(check (+ 1 1/2) (=> =) 3/2) +(check (number? (+ 1 1/2)) => #t) +(check (complex? (+ 1 1/2)) => #t) +(check (real? (+ 1 1/2)) => #t) +(check (rational? (+ 1 1/2)) => #t) +(check (integer? (+ 1 1/2)) => #f) +(check (exact? (+ 1 1/2)) => #t) +(check (inexact? (+ 1 1/2)) => #f) + +(check (* 2 1/2) (=> =) 1) +(check (number? (* 2 1/2)) => #t) +(check (complex? (* 2 1/2)) => #t) +(check (real? (* 2 1/2)) => #t) +(check (rational? (* 2 1/2)) => #t) +(check (integer? (* 2 1/2)) => #t) +(check (exact? (* 2 1/2)) => #t) +(check (inexact? (* 2 1/2)) => #f) + +(check (+ 1/3 1/3 1/3) (=> =) 1) +(check (number? (+ 1/3 1/3 1/3)) => #t) +(check (complex? (+ 1/3 1/3 1/3)) => #t) +(check (real? (+ 1/3 1/3 1/3)) => #t) +(check (rational? (+ 1/3 1/3 1/3)) => #t) +(check (integer? (+ 1/3 1/3 1/3)) => #t) +(check (exact? (+ 1/3 1/3 1/3)) => #t) +(check (inexact? (+ 1/3 1/3 1/3)) => #f) + +(check (+ 1 1.0) (=> =) 2.0) +(check (+ 1.0 1 ) (=> =) 2.0) + +(check (+ 1 1/2) (=> =) 3/2) +(check (+ 1.0 1/2) (=> =) 1.5) + +(check (+ 1/2 1 ) (=> =) 3/2) +(check (+ 1/2 1.0) (=> =) 1.5) + +(check (* 2 1/2) (=> =) 1 ) +(check (* 2.0 1/2) (=> =) 1.0) + +(check (modulo 13 4) => 1) +(check (modulo -13 4) => 3) +(check (modulo 13 -4) => -3) +(check (modulo -13 -4) => -1) + +(check (remainder 13 4) => 1) +(check (remainder -13 4) => -1) +(check (remainder 13 -4) => 1) +(check (remainder -13 -4) => -1) +(check (remainder -13 -4.0) => -1.0) ; inexact + +(check (log 0.0) => -inf.0) + +(check (sin 0) (=> =) 0) +(check (sin (/ fl-pi 6)) (=> =) 0.5) +; (check (sin (/ fl-pi 4)) (=> =) 0.707107) +; (check (sin (/ fl-pi 3)) (=> =) 0.866025) +(check (sin (/ fl-pi 2)) (=> =) 1) +; (check (sin fl-pi) (=> =) 0) + +(check (atan 0.0 1.0) => 0.000000) +; (check (atan 1.0 1.0) => 0.785398) +; (check (atan 1.0 0.0) => 1.570796) +; (check (atan 1.0 -1.0) => 2.356194) +; (check (atan 0.0 -1.0) => 3.141593) +; (check (atan -1.0 -1.0) => -2.356194) +; (check (atan -1.0 0.0) => -1.570796) +; (check (atan -1.0 1.0) => -0.785398) + +(check (exact 0.333333) => 3002396749180579/9007199254740992) + +(check-report) + +(exit (check-passed? 66)) diff --git a/test/numerical-operations.ss b/test/numerical-operations.ss deleted file mode 100644 index 4e5ae4dd9..000000000 --- a/test/numerical-operations.ss +++ /dev/null @@ -1,114 +0,0 @@ -(import (scheme base) - (scheme inexact) - (scheme process-context) - (srfi 78)) - -; ---- 6.2.6. Numerical operations --------------------------------------------- - -(check (rational? 1/3) => #t) -(check (rational? 0.5) => #t) - -(let ((x (+ 1 2 3))) - - (check x => 6) - - (check (number? x) => #t) - (check (complex? x) => #t) - (check (real? x) => #t) - (check (rational? x) => #t) - (check (integer? x) => #t) - - (check (exact? x) => #t) - (check (inexact? x) => #f) - ) - -(let ((x (+ 1 1/2))) - - (check x (=> =) 3/2) - - (check (number? x) => #t) - (check (complex? x) => #t) - (check (real? x) => #t) - (check (rational? x) => #t) - (check (integer? x) => #f) - - (check (exact? x) => #t) - (check (inexact? x) => #f) - ) - -(let ((x (* 2 1/2))) - - (check x (=> =) 1) - - (check (number? x) => #t) - (check (complex? x) => #t) - (check (real? x) => #t) - (check (rational? x) => #t) - (check (integer? x) => #t) - - (check (exact? x) => #t) - (check (inexact? x) => #f) - ) - -(let ((x (+ 1/3 1/3 1/3))) - - (check x (=> =) 1) - - (check (number? x) => #t) - (check (complex? x) => #t) - (check (real? x) => #t) - (check (rational? x) => #t) - (check (integer? x) => #t) - - (check (exact? x) => #t) - (check (inexact? x) => #f) - ) - -(check (+ 1 1.0) (=> =) 2.0) -(check (+ 1.0 1 ) (=> =) 2.0) - -(check (+ 1 1/2) (=> =) 3/2) -(check (+ 1.0 1/2) (=> =) 1.5) - -(check (+ 1/2 1 ) (=> =) 3/2) -(check (+ 1/2 1.0) (=> =) 1.5) - -(check (* 2 1/2) (=> =) 1 ) -(check (* 2.0 1/2) (=> =) 1.0) - -(check (modulo 13 4) => 1) -(check (modulo -13 4) => 3) -(check (modulo 13 -4) => -3) -(check (modulo -13 -4) => -1) - -(check (remainder 13 4) => 1) -(check (remainder -13 4) => -1) -(check (remainder 13 -4) => 1) -(check (remainder -13 -4) => -1) -(check (remainder -13 -4.0) => -1.0) ; inexact - -(check (log 0.0) => -inf.0) - -(check (sin 0) (=> =) 0) -(check (sin (/ fl-pi 6)) (=> =) 0.5) -; (check (sin (/ fl-pi 4)) (=> =) 0.707107) -; (check (sin (/ fl-pi 3)) (=> =) 0.866025) -(check (sin (/ fl-pi 2)) (=> =) 1) -; (check (sin fl-pi) (=> =) 0) - -(check (atan 0.0 1.0) => 0.000000) -; (check (atan 1.0 1.0) => 0.785398) -; (check (atan 1.0 0.0) => 1.570796) -; (check (atan 1.0 -1.0) => 2.356194) -; (check (atan 0.0 -1.0) => 3.141593) -; (check (atan -1.0 -1.0) => -2.356194) -; (check (atan -1.0 0.0) => -1.570796) -; (check (atan -1.0 1.0) => -0.785398) - -(check (exact 0.333333) => 3002396749180579/9007199254740992) - -; ---- SRFI-78 ----------------------------------------------------------------- - -(check-report) - -(exit (check-passed? 57)) diff --git a/test/r7rs.ss b/test/r7rs.ss index c8f4d1cef..73511944c 100644 --- a/test/r7rs.ss +++ b/test/r7rs.ss @@ -749,7 +749,7 @@ (check (eqv? (lambda (x) x) (lambda (y) y)) => #f) ; unspecified -(check (eqv? 1.0e0 1.0f0) => #t) ; unspecified +(check (eqv? 1.0e0 1.0f0) => #f) ; unspecified (check (eqv? +nan.0 +nan.0) => #t) ; unspecified