From 7d8f70fb07a4636ad448511867b8174c48a34503 Mon Sep 17 00:00:00 2001 From: Yorick Hardy Date: Thu, 1 Feb 2024 22:23:16 +0200 Subject: [PATCH 01/30] add more tests for rounding r7rs requires (round x) to round to even when x is halfway between two integers, while C requires round(x) to round away from zero. --- tests/base.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/base.scm b/tests/base.scm index 3fea3896..fdd366fe 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -91,6 +91,9 @@ (test 4.0 (ceiling 3.5)) (test 3.0 (truncate 3.5)) (test 4.0 (round 3.5)) + (test 2.0 (round 2.5)) + (test -4.0 (round -3.5)) + (test -2.0 (round -2.5)) (test 4.0 (round 7/2)) ;; Rationals not supported, so result is inexact (test 7 (round 7)) From 4bbceeb4d6ff53a5c0c503854d887a4e7a344880 Mon Sep 17 00:00:00 2001 From: Yorick Hardy Date: Thu, 1 Feb 2024 22:25:47 +0200 Subject: [PATCH 02/30] round half-integers to even instead of away from zero This changes the behaviour to match r7rs (round x) instead of C round(x). An answer to https://stackoverflow.com/questions/32746523/ieee-754-compliant-round-half-to-even suggests using remainder(). The following will work if FE_TONEAREST is defined, but C11 requires FE_TONEAREST to be defined if and only if the implemenetation supports it in fegetround() and fesetround() [Draft N1570]. On the other hand, remainder() must be defined. C23 will have roundeven(), but this is not yet available on all platforms. The behaviour of remainder is described in Draft N1570, page 254, footnote 239. Alternative implementation: double round_to_nearest_even(double x) { #pragma STDC FENV_ACCESS ON int mode; double nearest; mode = fegetround(); fesetround(FE_TONEAREST); nearest = nearbyint(x); fesetround(mode); #pragma STDC FENV_ACCESS OFF return nearest; } --- include/cyclone/runtime.h | 1 + runtime.c | 5 +++++ scheme/base.sld | 4 ++-- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 82608b30..432be667 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -504,6 +504,7 @@ int Cyc_have_mstreams(); } \ return_closcall1(data, cont, &d) +double round_to_nearest_even(double); void Cyc_exact(void *data, object cont, object z); object Cyc_exact_no_cps(void *data, object ptr, object z); diff --git a/runtime.c b/runtime.c index 3448cecb..59143b47 100644 --- a/runtime.c +++ b/runtime.c @@ -8765,6 +8765,11 @@ int num2ratio(double x, double *numerator, double *denominator) return 0; } +double round_to_nearest_even(double x) +{ + return x-remainder(x,1.0); +} + /** * Receive a Scheme number and pass requested portion of a rational number to * the continuation `cont`. Pass numerator if `numerator` is true, else the diff --git a/scheme/base.sld b/scheme/base.sld index 669b8cde..ae585953 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -1372,9 +1372,9 @@ " return_double_op_no_cps(data, ptr, trunc, z);") (define-c round "(void *data, int argc, closure _, object k, object z)" - " return_double_op(data, k, round, z); " + " return_double_op(data, k, round_to_nearest_even, z); " "(void *data, object ptr, object z)" - " return_double_op_no_cps(data, ptr, round, z);") + " return_double_op_no_cps(data, ptr, round_to_nearest_even, z);") (define-c exact "(void *data, int argc, closure _, object k, object z)" " Cyc_exact(data, k, z); " From 17cce161396668052708a0aa9a9ced19c337f3cd Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 18:03:03 -0800 Subject: [PATCH 03/30] Comment out so we don't keep breaking bootstrap These tests fail on mac and we can't use them in the bootstrap repo --- tests/base.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/base.scm b/tests/base.scm index fdd366fe..ee704b87 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -109,8 +109,8 @@ (test -1 (exact -1.1)) (test -1 (exact -1.1)) (test 1.0+1.0i (exact 1.1+1.2i)) - (test #t (bignum? (exact 111111111111111111111111111.0))) - (test #t (bignum? (exact -111111111111111111111111111.0))) + ;(test #t (bignum? (exact 111111111111111111111111111.0))) + ;(test #t (bignum? (exact -111111111111111111111111111.0))) ;(test +inf.0 (exact +inf.0)) ) From 42608c77cb4f4223b7cb6fba63f946b98e40277f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 21:07:15 -0500 Subject: [PATCH 04/30] Update Release-Checklist.md --- docs/Release-Checklist.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/Release-Checklist.md b/docs/Release-Checklist.md index 3d06e0c1..df9d0f0a 100644 --- a/docs/Release-Checklist.md +++ b/docs/Release-Checklist.md @@ -7,6 +7,7 @@ Steps for making a release of Cyclone: - `Dockerfile` - `DEBIAN/control` in cyclone-bootstrap - `.github/workflows/Release.yml` job in cyclone-bootstrap + - `libs/common.sld` in cyclone winds repo - Update documentation, if applicable - Tag releases and push to Github - Upload release notes to `gh-pages` branch From 393615e039cb88be7c328df5e0e0711f4bae7e3a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 18:28:56 -0800 Subject: [PATCH 05/30] Add latest fix --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c6051785..dae1af3f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ Features Bug Fixes +- Yorick Hardy provided a fix to `round` so that Cyclone will round to even when x is halfway between two integers, as required by R7RS. - Updated various numeric functions to properly handle numeric type conversions, including `quotient`, `remainder`, `numerator`, `denominator`, `truncate`, `truncate-quotient`, and `/`. - Fix `exact` to properly handle complex numbers, including raising an error when passed `nan` or `inf` double values. - Ensure the runtime properly differentiates between `+inf.0` and `-inf.0`. Thanks to jpellegrini for the bug report. From b5486887e8284a9a14dec420706a3445eed01e49 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 18:29:04 -0800 Subject: [PATCH 06/30] Increment revision number --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index 118d521f..30f67d68 100644 --- a/Dockerfile +++ b/Dockerfile @@ -4,7 +4,7 @@ MAINTAINER justin.ethier@gmail.com ARG DEBIAN_FRONTEND=noninteractive -ENV CYCLONE_VERSION v0.35.0 +ENV CYCLONE_VERSION v0.36.0 RUN apt update -y RUN apt install -y build-essential git rsync texinfo libtommath-dev libck-dev make gcc From 54b69b86c8a952797d845fa890791d07546e4c21 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 18:31:23 -0800 Subject: [PATCH 07/30] Prep release --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dae1af3f..abd3f6d6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,6 @@ # Changelog -## 0.36.0 - TBD +## 0.36.0 - February 14, 2024 Features From 03107cadf1abd7bcfe98de02b734af4986dc663f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 13 Feb 2024 21:36:54 -0500 Subject: [PATCH 08/30] Update Release-Checklist.md --- docs/Release-Checklist.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/Release-Checklist.md b/docs/Release-Checklist.md index df9d0f0a..d705ef00 100644 --- a/docs/Release-Checklist.md +++ b/docs/Release-Checklist.md @@ -15,3 +15,4 @@ Steps for making a release of Cyclone: - Update release on Homebrew (automated) - Update release on Dockerhub (push to bitbucket) - Upload new binary from cyclone-bootstrap release build to the cyclone-scheme "packages" repo +- TODO: what about WASM application? From a6aa16de52c21ffbc3fc8ccb8c852eacca054043 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 19 Feb 2024 22:44:02 -0500 Subject: [PATCH 09/30] Added WASM release instructions --- docs/Release-Checklist.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/docs/Release-Checklist.md b/docs/Release-Checklist.md index d705ef00..6f79f054 100644 --- a/docs/Release-Checklist.md +++ b/docs/Release-Checklist.md @@ -15,4 +15,8 @@ Steps for making a release of Cyclone: - Update release on Homebrew (automated) - Update release on Dockerhub (push to bitbucket) - Upload new binary from cyclone-bootstrap release build to the cyclone-scheme "packages" repo -- TODO: what about WASM application? +- Update WASM hosted Cyclone + - Trigger CI action on the WASM repo to recompile the WASM binary: https://github.com/cyclone-scheme/wasm-terminal + - Download the generated `.zip` artifact + - Extract `terminal.js` and `terminal.wasm` and copy to the `_site` directory in the repo to update the build + - Optionally update year in the `terminal.html` file From bb3df95d13d367a56f3193a9ab22f96317551df0 Mon Sep 17 00:00:00 2001 From: Yorick Hardy Date: Tue, 5 Mar 2024 22:18:44 +0200 Subject: [PATCH 10/30] Define *ai-v4mapped* to zero on platforms where AI_V4MAPPED is undefined. This change defines *ai-v4mapped* to zero when AI_V4MAPPED is undefined and similarly for *ai-all* (similar to other patches). This allows (srfi 106) to be available on NetBSD and other platforms without AI_V4MAPPED and is the recommended behaviour by the author of SRFI-106: https://srfi-email.schemers.org/srfi-106/msg/2762553/ --- srfi/106.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/srfi/106.sld b/srfi/106.sld index 5122b1b0..dae03155 100644 --- a/srfi/106.sld +++ b/srfi/106.sld @@ -388,7 +388,7 @@ #ifdef AI_V4MAPPED return_closcall1(data, k, obj_int2obj(AI_V4MAPPED)); #else - Cyc_rt_raise_msg(data, \"AI_V4MAPPED is not available on this platform\"); + return_closcall1(data, k, obj_int2obj(0)); #endif ") (define *ai-all* (ai-all)) @@ -398,7 +398,7 @@ #ifdef AI_ALL return_closcall1(data, k, obj_int2obj(AI_ALL)); #else - Cyc_rt_raise_msg(data, \"AI_ALL is not available on this platform\"); + return_closcall1(data, k, obj_int2obj(0)); #endif ") (make-const ai-addrconfig "AI_ADDRCONFIG" ) From eb53b0fb1666d92ae7ee48ca79607c0ddb29c77b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 5 Mar 2024 17:53:43 -0800 Subject: [PATCH 11/30] Document PR fix --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index abd3f6d6..25ebb4c8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 0.37.0 - TBD + +Bug Fixes + +- Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined. + ## 0.36.0 - February 14, 2024 Features From 37b39693edac94964070814255794a0d802c9829 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 5 Mar 2024 17:54:06 -0800 Subject: [PATCH 12/30] Bump to 0.37.0 --- scheme/cyclone/common.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/cyclone/common.sld b/scheme/cyclone/common.sld index 19d24484..19f6961a 100644 --- a/scheme/cyclone/common.sld +++ b/scheme/cyclone/common.sld @@ -18,7 +18,7 @@ memloc ) (begin -(define *version-number* "0.36.0") +(define *version-number* "0.37.0") (define *version-name* "") (define *version* (string-append *version-number* " " *version-name* "")) From fa6213b9072682e3ac161639b31ad1b4c5551b31 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Mar 2024 19:19:12 -0700 Subject: [PATCH 13/30] Issue #530 - First cut at improving sqrt Improving sqrt to properly handle negative parameter values --- scheme/inexact.sld | 31 ++++++++++++++++++++++++++++++- tests/base.scm | 10 ++++++++++ 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/scheme/inexact.sld b/scheme/inexact.sld index e2d1a1a3..ab8c3376 100644 --- a/scheme/inexact.sld +++ b/scheme/inexact.sld @@ -69,7 +69,6 @@ (/ (c-log z1) (c-log z2*))))) (define-inexact-op c-log "log" "clog") (define-inexact-op exp "exp" "cexp") - (define-inexact-op sqrt "sqrt" "csqrt") (define-inexact-op sin "sin" "csin") (define-inexact-op cos "cos" "ccos") (define-inexact-op tan "tan" "ctan") @@ -93,4 +92,34 @@ (* (if (eqv? y -0.0) -1 1) (if (eqv? x -0.0) 3.141592653589793 x)) (atan1 (/ y x)))))))) + + (define-c + sqrt + "(void *data, int argc, closure _, object k, object z)" + " double complex result; + Cyc_check_num(data, z); + if (obj_is_int(z)) { + result = csqrt(obj_obj2int(z)); + } else if (type_of(z) == integer_tag) { + result = csqrt(((integer_type *)z)->value); + } else if (type_of(z) == bignum_tag) { + result = csqrt(mp_get_double(&bignum_value(z))); + } else if (type_of(z) == complex_num_tag) { + result = csqrt(complex_num_value(z)); + } else { + result = csqrt(((double_type *)z)->value); + } + + if (cimag(result) == 0.0) { + make_double(d, creal(result)); + return_closcall1(data, k, &d); + } else { + complex_num_type cn; + assign_complex_num((&cn), result); + return_closcall1(data, k, &cn); + } " +; "(void *data, object ptr, object z)" +; " return_inexact_double_or_cplx_op_no_cps(data, ptr, sqrt, csqrt, z);" +) + )) diff --git a/tests/base.scm b/tests/base.scm index ee704b87..980b0ece 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -9,6 +9,7 @@ (import (scheme base) + (scheme inexact) (cyclone test)) @@ -102,6 +103,15 @@ (test 2.0 (denominator (inexact (/ 6 4)))) ) +(test-group + "sqrt" + (test #t (sqrt -1)) + (test #t (sqrt -1.0)) + ; TODO: (test 2 (sqrt 4)) + (test 2.0 (sqrt 4.0)) + (test 2i (sqrt -4.0)) +) + (test-group "exact" (test -1 (exact -1)) From a2568d85895b29b79b0c83e419580fbabd4f3399 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Mar 2024 19:29:44 -0700 Subject: [PATCH 14/30] Allow inline sqrt --- scheme/inexact.sld | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/scheme/inexact.sld b/scheme/inexact.sld index ab8c3376..a8d00c86 100644 --- a/scheme/inexact.sld +++ b/scheme/inexact.sld @@ -120,6 +120,28 @@ } " ; "(void *data, object ptr, object z)" ; " return_inexact_double_or_cplx_op_no_cps(data, ptr, sqrt, csqrt, z);" -) + "(void *data, object ptr, object z)" + " double complex unboxed; + Cyc_check_num(data, z); + if (obj_is_int(z)) { + unboxed = csqrt(obj_obj2int(z)); + } else if (type_of(z) == integer_tag) { + unboxed = csqrt(((integer_type *)z)->value); + } else if (type_of(z) == bignum_tag) { + unboxed = csqrt(mp_get_double(&bignum_value(z))); + } else if (type_of(z) == complex_num_tag) { + unboxed = csqrt(complex_num_value(z)); + assign_complex_num(ptr, unboxed); + return ptr; + } else { + unboxed = csqrt(((double_type *)z)->value); + } + + if (cimag(unboxed) == 0.0) { + assign_double(ptr, creal(unboxed)); + } else { + assign_double(ptr, unboxed); + } + return ptr; ") )) From 32af1bcd0552b2bad48ecc82d90171d8c3b22d6e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Mar 2024 19:29:54 -0700 Subject: [PATCH 15/30] Removing top-level sqrt This isn't good enough, there are going to be bootstrap compilation problems undoing this... --- scheme/base.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index ae585953..9c147353 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -1437,10 +1437,10 @@ (error "exact non-negative integer required" k)) (let* ((s (if (bignum? k) (bignum-sqrt k) - (exact (truncate (sqrt k))))) + (exact (truncate (_sqrt k))))) (r (- k (* s s)))) (values s r))) - (define-c sqrt + (define-c _sqrt "(void *data, int argc, closure _, object k, object z)" " return_inexact_double_op(data, k, sqrt, z);" "(void *data, object ptr, object z)" From 887e1e5aa98a199878be39c328db71e665cbe358 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Mar 2024 19:06:54 -0700 Subject: [PATCH 16/30] Return fixnum if sqrt(fixnum) is an exact int --- scheme/inexact.sld | 3 +++ 1 file changed, 3 insertions(+) diff --git a/scheme/inexact.sld b/scheme/inexact.sld index a8d00c86..d773ea9f 100644 --- a/scheme/inexact.sld +++ b/scheme/inexact.sld @@ -111,6 +111,9 @@ } if (cimag(result) == 0.0) { + if (obj_is_int(z) && creal(result) == round(creal(result))) { + return_closcall1(data, k, obj_int2obj(creal(result))); + } make_double(d, creal(result)); return_closcall1(data, k, &d); } else { From 512e962a9b34a78b964a2c5bc7943ab82e19c17a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Mar 2024 19:22:09 -0700 Subject: [PATCH 17/30] Add more sqrt tests --- tests/base.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/base.scm b/tests/base.scm index 980b0ece..c17615cb 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -105,9 +105,9 @@ (test-group "sqrt" - (test #t (sqrt -1)) - (test #t (sqrt -1.0)) - ; TODO: (test 2 (sqrt 4)) + (test 1i (sqrt -1)) + (test 1i (sqrt -1.0)) + (test 2 (sqrt 4)) (test 2.0 (sqrt 4.0)) (test 2i (sqrt -4.0)) ) From 1f76d474f7d01a0aec827c2ac4921566c1804472 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Mar 2024 19:25:23 -0700 Subject: [PATCH 18/30] Document fixes to sqrt --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 25ebb4c8..653f1316 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ Bug Fixes - Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined. +- Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. Thanks to Christopher Hebert for the bug report. ## 0.36.0 - February 14, 2024 From 6068b30dedfe66b336ebb273738f3e3743d4d487 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 Mar 2024 19:31:58 -0700 Subject: [PATCH 19/30] Issue #530 - Handle parsing of +i / -i --- scheme/read.sld | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/scheme/read.sld b/scheme/read.sld index 0b67f6e4..5432fb03 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -294,7 +294,10 @@ (substring t 0 end) (substring t end (- len 1)))) (real (string->number real-str)) - (imag (string->number imag-str)) + (imag (cond + ((equal? "+" imag-str) 1) ;; Special case, +i w/no number + ((equal? "-" imag-str) -1) ;; Special case, -i + (else (string->number imag-str)))) ) (Cyc-make-rect real imag))) (else From 29b4c77922acd249065b7a2adf9d9cfb965b4674 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 Mar 2024 19:32:15 -0700 Subject: [PATCH 20/30] Cleanup --- runtime.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/runtime.c b/runtime.c index 59143b47..b3023299 100644 --- a/runtime.c +++ b/runtime.c @@ -7931,9 +7931,6 @@ static void _read_return_number(void *data, port_type * p, int base, int exact) */ static void _read_return_complex_number(void *data, port_type * p, int len) { -// TODO: return complex num, see _read_return_number for possible template -// probably want to have that function extract/identify the real/imaginary components. -// can just scan the buffer and read out start/end index of each number. int i; make_empty_vector(vec); make_string(str, p->tok_buf); From 92de62ce1446e7599a70aa97a82b9b2fb2b13a95 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 Mar 2024 19:33:00 -0700 Subject: [PATCH 21/30] Issue #530 - Document changes --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 653f1316..c81ca1ee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ Bug Fixes - Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined. - Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. Thanks to Christopher Hebert for the bug report. +- Updated parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug report. ## 0.36.0 - February 14, 2024 From 0ea2457db660abf2e0ccc586bd4b4315e0952a4e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Mar 2024 18:57:09 -0700 Subject: [PATCH 22/30] Issue #530 - Adding more tests --- tests/base.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/base.scm b/tests/base.scm index c17615cb..32829b8b 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -107,9 +107,12 @@ "sqrt" (test 1i (sqrt -1)) (test 1i (sqrt -1.0)) + (test +i (sqrt -1.0)) (test 2 (sqrt 4)) (test 2.0 (sqrt 4.0)) (test 2i (sqrt -4.0)) + (test #t (complex? (sqrt -1))) + (test #t (complex? (sqrt -i))) ) (test-group From 07e747a08f108c3e350a3b44bc6af11eec562c5a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Mar 2024 18:58:29 -0700 Subject: [PATCH 23/30] Revise doc for issue #530 --- CHANGELOG.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c81ca1ee..f0d1ec29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,8 +5,7 @@ Bug Fixes - Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined. -- Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. Thanks to Christopher Hebert for the bug report. -- Updated parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug report. +- Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. And updated the parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug reports! ## 0.36.0 - February 14, 2024 From 82b0f9f3e2ab512201d7c8da7f9e0696ccbf77e7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Mar 2024 19:42:42 -0700 Subject: [PATCH 24/30] Cleanup --- scheme/inexact.sld | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/scheme/inexact.sld b/scheme/inexact.sld index d773ea9f..1107bf9a 100644 --- a/scheme/inexact.sld +++ b/scheme/inexact.sld @@ -121,30 +121,29 @@ assign_complex_num((&cn), result); return_closcall1(data, k, &cn); } " -; "(void *data, object ptr, object z)" -; " return_inexact_double_or_cplx_op_no_cps(data, ptr, sqrt, csqrt, z);" "(void *data, object ptr, object z)" - " double complex unboxed; + " double complex result; Cyc_check_num(data, z); if (obj_is_int(z)) { - unboxed = csqrt(obj_obj2int(z)); + result = csqrt(obj_obj2int(z)); } else if (type_of(z) == integer_tag) { - unboxed = csqrt(((integer_type *)z)->value); + result = csqrt(((integer_type *)z)->value); } else if (type_of(z) == bignum_tag) { - unboxed = csqrt(mp_get_double(&bignum_value(z))); + result = csqrt(mp_get_double(&bignum_value(z))); } else if (type_of(z) == complex_num_tag) { - unboxed = csqrt(complex_num_value(z)); - assign_complex_num(ptr, unboxed); - return ptr; + result = csqrt(complex_num_value(z)); } else { - unboxed = csqrt(((double_type *)z)->value); + result = csqrt(((double_type *)z)->value); } - if (cimag(unboxed) == 0.0) { - assign_double(ptr, creal(unboxed)); + if (cimag(result) == 0.0) { + if (obj_is_int(z) && creal(result) == round(creal(result))) { + return obj_int2obj(creal(result)); + } + assign_double(ptr, creal(result)); } else { - assign_double(ptr, unboxed); + assign_complex_num(ptr, result); } - return ptr; ") - + return ptr; + ") )) From 0a062177f7613ffb5b2364efb64f40f6af1cb3e7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Apr 2024 18:54:15 -0700 Subject: [PATCH 25/30] Issue #534 - Bug fix for beta exp bug Perform full scanning of function application list to ensure self-recursive calls are found. This prevents infinite loops in the beta expansion code when compiling simple recursive calls. --- CHANGELOG.md | 4 ++++ scheme/cyclone/cps-optimizations.sld | 19 +++++++++++++------ 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f0d1ec29..8dc3dd80 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,10 @@ Bug Fixes +- Fixed a beta expansion optimization bug where code such as the following would cause the compiler to hang. Thanks to Yorick Hardy for the bug report: + + (define (compile-forever x) x (compile-forever x)) + - Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined. - Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. And updated the parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug reports! diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index c79b6f20..36dc476b 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1665,7 +1665,7 @@ ;; Full beta expansion phase, make a pass over all of the program's AST (define (opt:beta-expand exp) -;(write `(DEBUG opt:beta-expand ,exp)) (newline) + ;(trace:info `(opt:beta-expand ,exp)) (flush-output-port) (cond ((ast:lambda? exp) (ast:%make-lambda @@ -1694,6 +1694,7 @@ (else exp))) (define (analyze-cps exp) + ;(trace:info `(analyze-cps ,exp)) (analyze:find-named-lets exp) (analyze:find-direct-recursive-calls exp) (analyze:find-recursive-calls exp) @@ -2230,11 +2231,17 @@ (scan (if->then exp) def-sym) (scan (if->else exp) def-sym)) ((app? exp) - (when (equal? (car exp) def-sym) - (trace:info `("recursive call" ,exp)) - (with-var! def-sym (lambda (var) - (adbv:set-self-rec-call! var #t))) - )) + ;(trace:info `(analyze:find-recursive-calls scan app ,exp)) + (cond + ((equal? (car exp) def-sym) + (trace:info `("recursive call" ,exp)) + (with-var! def-sym (lambda (var) + (adbv:set-self-rec-call! var #t)))) + (else + (for-each + (lambda (e) + (scan e def-sym)) + exp)))) (else #f))) ;; TODO: probably not good enough, what about recursive functions that are not top-level?? From 8e74c0409eeb6d52fd447a2eeb77208f93cec793 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 22 Apr 2024 18:32:06 -0700 Subject: [PATCH 26/30] Add code change back --- runtime.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/runtime.c b/runtime.c index b3023299..d890efa7 100644 --- a/runtime.c +++ b/runtime.c @@ -7538,6 +7538,8 @@ static int _read_is_numeric(const char *tok, int len) { return (len && ((isdigit(tok[0])) || + (((len == 2) && tok[1] == 'i') + && (tok[0] == '-' || tok[0] == '+')) || ((len > 1) && tok[0] == '.' && isdigit(tok[1])) || ((len > 1) && (tok[1] == '.' || isdigit(tok[1])) && (tok[0] == '-' || tok[0] == '+')))); From 1ce4979658716eaae52a179c8943256cd0725f00 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 20 May 2024 19:31:38 -0700 Subject: [PATCH 27/30] Testing fix for issue #537 --- scheme/eval.sld | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index ba33ae11..042a520f 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -99,7 +99,9 @@ (cond ((application? exp) (cond - ((compound-procedure? (car exp)) + ((or (primitive-procedure? (car exp)) + (compound-procedure? (car exp)) + (procedure? (car exp))) (cons (car exp) (map From 06219634e9707f29d32c987375991f7bc7472908 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 May 2024 18:41:41 -0700 Subject: [PATCH 28/30] Issue #537 - Add useful comments --- scheme/eval.sld | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 042a520f..5eafaa86 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -89,12 +89,19 @@ ((analyze exp *global-environment* rename-env '()) *global-environment*) ((analyze exp (car env) rename-env '()) (car env)))) +;; Called from the C runtime to support apply (define (eval-from-c exp . _env) (let ((env (if (null? _env) *global-environment* (car _env)))) (eval (wrapc exp) env))) -;; Expressions received from C code are already evaluated, but sometimes too much so. -;; Try to wrap +;; Helper function for eval-from-c +;; +;; Expressions received from C code are already evaluated, +;; however any quoted expressions will have the quotes +;; stripped off. This is a problem for expressions that +;; aren't self evaluating - like (1 2) - so we re-quote +;; the expressions here so a subsequent eval will work. +;; (define (wrapc exp) (cond ((application? exp) From bb6b3eafedc12b9c9ed936b4b02458e856ce5ec6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 May 2024 18:54:17 -0700 Subject: [PATCH 29/30] Issue #537 - Document bug fix --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8dc3dd80..96b43222 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ Bug Fixes +- Fixed a bug in `apply` where an error may be raised when processing quoted sub-expressions. For example the following would throw an error: `(apply cons '(5 (1 2)))`. Thanks to @srgx for the bug report! - Fixed a beta expansion optimization bug where code such as the following would cause the compiler to hang. Thanks to Yorick Hardy for the bug report: (define (compile-forever x) x (compile-forever x)) From 65fa16cce7781100f105692b6502cc36de511228 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 May 2024 18:58:49 -0700 Subject: [PATCH 30/30] Issue #537 - Add tests --- tests/base.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/base.scm b/tests/base.scm index 32829b8b..c67a23b3 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -9,6 +9,7 @@ (import (scheme base) + (scheme eval) (scheme inexact) (cyclone test)) @@ -31,6 +32,12 @@ (test '() (make-list -2)) ) +(test-group + "apply" + (test '(5 1 2) (eval '(apply cons '(5 (1 2))))) + (test '(5 1 2) (apply cons '(5 (1 2)))) +) + (cond-expand (memory streams (test-group