diff --git a/CHANGELOG.md b/CHANGELOG.md index c6051785..96b43222 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ # Changelog -## 0.36.0 - TBD +## 0.37.0 - TBD + +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)) + +- 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! + +## 0.36.0 - February 14, 2024 Features @@ -9,6 +21,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. 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 diff --git a/docs/Release-Checklist.md b/docs/Release-Checklist.md index 3d06e0c1..6f79f054 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 @@ -14,3 +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 +- 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 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..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] == '+')))); @@ -7931,9 +7933,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); @@ -8765,6 +8764,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..9c147353 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); " @@ -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)" 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* "")) 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?? diff --git a/scheme/eval.sld b/scheme/eval.sld index ba33ae11..5eafaa86 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -89,17 +89,26 @@ ((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) (cond - ((compound-procedure? (car exp)) + ((or (primitive-procedure? (car exp)) + (compound-procedure? (car exp)) + (procedure? (car exp))) (cons (car exp) (map diff --git a/scheme/inexact.sld b/scheme/inexact.sld index e2d1a1a3..1107bf9a 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,58 @@ (* (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) { + 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 { + complex_num_type cn; + assign_complex_num((&cn), result); + return_closcall1(data, k, &cn); + } " + "(void *data, object ptr, 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) { + if (obj_is_int(z) && creal(result) == round(creal(result))) { + return obj_int2obj(creal(result)); + } + assign_double(ptr, creal(result)); + } else { + assign_complex_num(ptr, result); + } + return ptr; + ") )) 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 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" ) diff --git a/tests/base.scm b/tests/base.scm index 3fea3896..c67a23b3 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -9,6 +9,8 @@ (import (scheme base) + (scheme eval) + (scheme inexact) (cyclone test)) @@ -30,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 @@ -91,6 +99,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)) @@ -99,6 +110,18 @@ (test 2.0 (denominator (inexact (/ 6 4)))) ) +(test-group + "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 "exact" (test -1 (exact -1)) @@ -106,8 +129,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)) )