- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Let deftransforms do the right thing for char-upcase/downcase
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 95e6ffdd by Raymond Toy at 2024-05-16T14:04:14-07:00 Let deftransforms do the right thing for char-upcase/downcase Instead of maintaining duplicate code in the functions char-upcase/downcase and in the deftransforms for these functions, change the implementation of the functions to call themselves. This looks like infinite recursion, but the deftransforms are nicely applied so that we only have one copy of the code now. - - - - - f3dac007 by Raymond Toy at 2024-05-16T14:05:53-07:00 Slightly simplify implementation of char-upcase/downcase transforms First, change the arg type from `base-char` to `character` (which are the same in cmucl). Second, for `char-upcase`, we only upcase a Unicode character if it is a lower-case letter (category "Ll"). Likewise for `char-downcase`, we only downcase if the character is an upper-case letter (category "Lu"). Everything else is ignored. - - - - - 2 changed files: - src/code/char.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -463,18 +463,7 @@ (defun char-upcase (char) "Returns CHAR converted to upper-case if that is possible." (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (lower-case-p char) - (code-char (- (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((< 96 m 123) (code-char (- m 32))) - ((> m +unicode-lower-limit+) - (if (member (unicode-category m) '(92 32 75 109)) - char - (code-char (unicode-upper m)))) - (t char)))) + (char-upcase char)) (defun char-titlecase (char) "Returns CHAR converted to title-case if that is possible." @@ -492,18 +481,7 @@ (defun char-downcase (char) "Returns CHAR converted to lower-case if that is possible." (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (upper-case-p char) - (code-char (+ (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) - (if (member (unicode-category m) '(92 75 109)) - char - (code-char (unicode-lower m)))) - ((< 64 m 91) (code-char (+ m 32))) - (t char)))) + (char-downcase char)) (defun digit-char (weight &optional (radix 10)) "All arguments must be integers. Returns a character object that ===================================== src/compiler/srctran.lisp ===================================== @@ -3335,9 +3335,8 @@ (= (lisp::equal-char-code a) (lisp::equal-char-code b))))) -(deftransform char-upcase ((x) (base-char)) +(deftransform char-upcase ((x) (character)) "open code" - ;; NOTE: This MUST match what the function char-upcase does. #-(and unicode (not unicode-bootstrap)) '(if (lower-case-p x) (code-char (- (char-code x) 32)) @@ -3345,25 +3344,22 @@ #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) (cond ((< 96 m 123) (code-char (- m 32))) - ((> m lisp::+unicode-lower-limit+) - (if (member (unicode-category m) '(92 32 75 109)) - x - (code-char (lisp::unicode-upper m)))) + ((and (> m lisp::+unicode-lower-limit+) + (= (unicode-category m) lisp::+unicode-category-lower+)) + (code-char (lisp::unicode-upper m))) (t x)))) -(deftransform char-downcase ((x) (base-char)) +(deftransform char-downcase ((x) (character)) "open code" - ;; NOTE: This MUST match what the function char-downcase does. #-(and unicode (not unicode-bootstrap)) '(if (upper-case-p x) (code-char (+ (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m lisp::+unicode-lower-limit+) - (if (member (unicode-category m) '(92 75 109)) - x - (code-char (lisp::unicode-lower m)))) + (cond ((and (> m lisp::+unicode-lower-limit+) + (= (unicode-category m) lisp::+unicode-category-upper+)) + (code-char (lisp::unicode-lower m))) ((< 64 m 91) (code-char (+ m 32))) (t x)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/37967a5048d11c50a9f6fe… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/37967a5048d11c50a9f6fe… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] Clean up the code and handle code-char 223 better.
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 37967a50 by Raymond Toy at 2024-05-16T07:07:17-07:00 Clean up the code and handle code-char 223 better. Clean up some code that had assumed that `+unicode-lower-limit+` was less than 191. Those special cases aren't needed anymore. For code 223 (Latin_Small_Letter_Sharp_S), add special case so that it is not a lower-case letter and therefore not both-case-p. - - - - - 1 changed file: - src/code/char.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -215,8 +215,7 @@ (let ((m (char-code (the base-char char)))) (or (< 31 m 127) #+(and unicode (not unicode-bootstrap)) - (and (/= m 181) - (> m +unicode-lower-limit+) + (and (> m +unicode-lower-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -251,6 +250,10 @@ (or (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) + ;; We don't want 223 to be a lower-case letter because + ;; CHAR-UPCASE returns the same character instead of the + ;; upper-case version. + (/= m 223) (= (unicode-category m) +unicode-category-lower+))))) (defun title-case-p (char) @@ -273,11 +276,7 @@ (or (< 64 m 91) (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) - ;; Unicode says Micro_sign is a lower case letter, but - ;; for CL, we don't want it to be a lower case letter. - ;; This is for compatibility with other Lisp - ;; implementations. - (/= m 181) + (/= m 223) (<= +unicode-category-upper+ (unicode-category m) +unicode-category-lower+))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/37967a5048d11c50a9f6fe2… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/37967a5048d11c50a9f6fe2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Change unicode limit to 255
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 7db93de9 by Raymond Toy at 2024-05-14T06:52:07-07:00 Change unicode limit to 255 Set the limit to 255 so that all 8-bit characters have a fast path that doesn't need to access the Unicode database. - - - - - 5fca5677 by Raymond Toy at 2024-05-15T17:44:06-07:00 Set unicode limit to 191 Update char-upcase and corresponding deftransform appropriately. - - - - - 2 changed files: - src/code/char.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -62,7 +62,7 @@ ;; This MUST be greater than or equal to 127! (defconstant +unicode-lower-limit+ - 127 + 191 "A character code strictly larger than this is handled using Unicode rules.") @@ -471,7 +471,6 @@ #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) (cond ((< 96 m 123) (code-char (- m 32))) - ((= m 181) char) ((> m +unicode-lower-limit+) (if (member (unicode-category m) '(92 32 75 109)) char ===================================== src/compiler/srctran.lisp ===================================== @@ -3345,7 +3345,6 @@ #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) (cond ((< 96 m 123) (code-char (- m 32))) - ((= m 181) x) ((> m lisp::+unicode-lower-limit+) (if (member (unicode-category m) '(92 32 75 109)) x View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6633e24c7b2beeb21e743b… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6633e24c7b2beeb21e743b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Implement the category cases in the CL functions, not Unicode
by Raymond Toy (＠rtoy) 14 May '24

14 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 1652ad4b by Raymond Toy at 2024-05-13T20:19:02-07:00 Implement the category cases in the CL functions, not Unicode Previously, we had unicode-upper/lower functions had the code to exclude the characters from the categories we didn't want. However, this should really be done in char-upcase/downcase because that's what we want from CL, not Unicode. - - - - - 6633e24c by Raymond Toy at 2024-05-13T20:21:17-07:00 Update the deftransforms for char-upcase/downcase to match The deftransforms for char-upcase/downcase better match the code for the functions char-upcase/downcase, otherwise, we get totally confusing results. I just copied the code from the functions into the deftransforms. We really need a better way to do this to guarantee this automatically! - - - - - 3 changed files: - src/code/char.lisp - src/code/unidata.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -215,7 +215,8 @@ (let ((m (char-code (the base-char char)))) (or (< 31 m 127) #+(and unicode (not unicode-bootstrap)) - (and (> m +unicode-lower-limit+) + (and (/= m 181) + (> m +unicode-lower-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -272,6 +273,11 @@ (or (< 64 m 91) (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) + ;; Unicode says Micro_sign is a lower case letter, but + ;; for CL, we don't want it to be a lower case letter. + ;; This is for compatibility with other Lisp + ;; implementations. + (/= m 181) (<= +unicode-category-upper+ (unicode-category m) +unicode-category-lower+))))) @@ -464,8 +470,12 @@ char) #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) (code-char (unicode-upper m))) - ((< 96 m 123) (code-char (- m 32))) + (cond ((< 96 m 123) (code-char (- m 32))) + ((= m 181) char) + ((> m +unicode-lower-limit+) + (if (member (unicode-category m) '(92 32 75 109)) + char + (code-char (unicode-upper m)))) (t char)))) (defun char-titlecase (char) @@ -490,7 +500,10 @@ char) #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) (code-char (unicode-lower m))) + (cond ((> m +unicode-lower-limit+) + (if (member (unicode-category m) '(92 75 109)) + char + (code-char (unicode-lower m)))) ((< 64 m 91) (code-char (+ m 32))) (t char)))) ===================================== src/code/unidata.lisp ===================================== @@ -883,9 +883,7 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (qref32 scase code) #xFF))) - (if (or (zerop n) - ;; Ignore category Lt, Mn, Nl, So - (member (unicode-category code) '(92 32 75 109))) + (if (zerop n) code (let* ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) @@ -896,9 +894,7 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (ash (qref32 scase code) -8) #xFF))) - (if (or (zerop n) - ;; Ignore category Lt, Nl, So - (member (unicode-category code) '(92 75 109))) + (if (zerop n) code (let ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) ===================================== src/compiler/srctran.lisp ===================================== @@ -3337,27 +3337,36 @@ (deftransform char-upcase ((x) (base-char)) "open code" + ;; NOTE: This MUST match what the function char-upcase does. #-(and unicode (not unicode-bootstrap)) '(if (lower-case-p x) (code-char (- (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m 127) (code-char (lisp::unicode-upper m))) - ((< 96 m 123) (code-char (- m 32))) + (cond ((< 96 m 123) (code-char (- m 32))) + ((= m 181) x) + ((> m lisp::+unicode-lower-limit+) + (if (member (unicode-category m) '(92 32 75 109)) + x + (code-char (lisp::unicode-upper m)))) (t x)))) (deftransform char-downcase ((x) (base-char)) "open code" + ;; NOTE: This MUST match what the function char-downcase does. #-(and unicode (not unicode-bootstrap)) '(if (upper-case-p x) (code-char (+ (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m 127) (code-char (lisp::unicode-lower m))) - ((< 64 m 91) (code-char (+ m 32))) - (t x)))) + (cond ((> m lisp::+unicode-lower-limit+) + (if (member (unicode-category m) '(92 75 109)) + x + (code-char (lisp::unicode-lower m)))) + ((< 64 m 91) (code-char (+ m 32))) + (t x)))) ;;;; Equality predicate transforms: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7f4f1e7590ba3a2326a91d… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7f4f1e7590ba3a2326a91d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Ignore some categories when finding the upper or lower case character
by Raymond Toy (＠rtoy) 13 May '24

13 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 3a0f81e8 by Raymond Toy at 2024-05-13T14:23:47-07:00 Ignore some categories when finding the upper or lower case character For `unicode-upper`, we ignore characters with the category Lt, Mn, Nl, and So and just return the character unchanged. Likewise, for `unicode-lower`, we ignore Lt, Nl, and So. - - - - - 7f4f1e75 by Raymond Toy at 2024-05-13T14:25:22-07:00 Checkout the correct branch for the ansi-test code. - - - - - 2 changed files: - bin/run-ansi-tests.sh - src/code/unidata.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout issue-288-new-failures +git checkout issue-316-support-roundtrip-char-casing make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/code/unidata.lisp ===================================== @@ -883,7 +883,9 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (qref32 scase code) #xFF))) - (if (zerop n) + (if (or (zerop n) + ;; Ignore category Lt, Mn, Nl, So + (member (unicode-category code) '(92 32 75 109))) code (let* ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) @@ -894,7 +896,9 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (ash (qref32 scase code) -8) #xFF))) - (if (zerop n) + (if (or (zerop n) + ;; Ignore category Lt, Nl, So + (member (unicode-category code) '(92 75 109))) code (let ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d3452f1b14c8f6ab488fc… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d3452f1b14c8f6ab488fc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-316-support-roundtrip-char-casing
by Raymond Toy (＠rtoy) 13 May '24

13 May '24

Raymond Toy pushed new branch issue-316-support-roundtrip-char-casing at cmucl / cmucl -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-316-support-roundtr… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-312-motif-server] Declare type_writer to have a void* arg instead of caddr_t.
by Raymond Toy (＠rtoy) 10 May '24

10 May '24

Raymond Toy pushed to branch issue-312-motif-server at cmucl / cmucl Commits: 2c4e223e by Raymond Toy at 2024-05-10T15:00:29-07:00 Declare type_writer to have a void* arg instead of caddr_t. Update datatrans.h so that message_write_float is declared to have a second arg of type void*. Then update implementation of message_write_float to have a matching function signature and cast the void* arg to float* so we can get the float value. - - - - - 3 changed files: - src/motif/server/datatrans.c - src/motif/server/datatrans.h - src/motif/server/tables.h Changes: ===================================== src/motif/server/datatrans.c ===================================== @@ -265,10 +265,12 @@ void message_write_color(message_t m,XColor *color,int tag) message_put_word(m,color->blue); } -void message_write_float(message_t m,float *f,int tag) +void message_write_float(message_t m,void *f,int tag) { + float *fl = (float *) f; + message_put_dblword(m,combine_type_and_data(tag,0)); - message_put_dblword(m,*f); + message_put_dblword(m,*fl); } ===================================== src/motif/server/datatrans.h ===================================== @@ -38,7 +38,7 @@ extern void message_write_int_list(); extern void message_write_event(); extern void message_write_color(); /* GCC complains without the full prototype */ -extern void message_write_float(message_t,float*,int); +extern void message_write_float(message_t,void*,int); ===================================== src/motif/server/tables.h ===================================== @@ -10,8 +10,8 @@ #ifndef TABLES_H #define TABLES_H -typedef void (*type_writer)(message_t out,caddr_t src,int type_tag); -typedef void (*type_reader)(message_t in,caddr_t dest,int type_tag,int data); +typedef void (*type_writer)(message_t out,void *src,int type_tag); +typedef void (*type_reader)(message_t in,void *dest,int type_tag,int data); typedef struct { String type; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c4e223e3a53f79e3c147a4… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c4e223e3a53f79e3c147a4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update release notes for #314
by Raymond Toy (＠rtoy) 10 May '24

10 May '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 6a6e6445 by Raymond Toy at 2024-05-10T12:13:33-07:00 Update release notes for #314 Forgot to update the release notes when working on #314. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -76,6 +76,7 @@ public domain. * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * ~~#298~~ Add `with-float-rounding-mode` macro * ~~#299~~ Enable xoroshiro assembly routine + * ~~#314~~ tanh incorrect for large args * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6a6e64458e59b4a011d3085… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6a6e64458e59b4a011d3085… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #314: tanh incorrect for large args
by Raymond Toy (＠rtoy) 10 May '24

10 May '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 63ee590e by Raymond Toy at 2024-05-10T18:53:05+00:00 Fix #314: tanh incorrect for large args - - - - - f661bac3 by Raymond Toy at 2024-05-10T18:53:09+00:00 Merge branch 'issue-314-complex-tanh-incorrect-for-large-arg' into 'master' Fix #314: tanh incorrect for large args Closes #314 See merge request cmucl/cmucl!219 - - - - - 3 changed files: - src/code/irrat-dd.lisp - src/code/irrat.lisp - tests/irrat.lisp Changes: ===================================== src/code/irrat-dd.lisp ===================================== @@ -1800,12 +1800,10 @@ Z may be any number, but the result is always a complex." (declare (optimize (speed 3) (space 0) (inhibit-warnings 3))) (cond ((> (abs x) - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) - ;; This is more accurate under linux. - #+(or linux hpux) #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + ;; Don't need double-double accuracy here. + #.(/ (%asinh most-positive-double-float) 4d0)) (complex (float-sign x) - (float-sign y))) + (float-sign y 0w0))) (t (let* ((tv (dd-%tan y)) (beta (+ 1.0d0 (* tv tv))) ===================================== src/code/irrat.lisp ===================================== @@ -1521,12 +1521,12 @@ Z may be any number, but the result is always a complex." ;; space 0 to get maybe-inline functions inlined (declare (optimize (speed 3) (space 0))) (cond ((> (abs x) - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) - ;; This is more accurate under linux. - #+(or linux hpux) #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + (/ (%asinh most-positive-double-float) 4d0)) + ;; Kahan says the answer is + ;; + ;; copysign(1, x) + i*copysign(0, y) (coerce-to-complex-type (float-sign x) - (float-sign y) z)) + (float-sign y 0d0) z)) (t (let* ((tv (%tan y)) (beta (+ 1.0d0 (* tv tv))) ===================================== tests/irrat.lisp ===================================== @@ -231,3 +231,17 @@ (let ((z (sqrt (complex minf (- nan))))) (assert-true (ext:float-nan-p (realpart z))) (assert-eql minf (imagpart z)))))) + +;; See bug #314 +(define-test tanh-large + (:tag :issues) + (assert-eql (complex 1d0 -0d0) + (tanh #c(200d0 -200d0))) + (assert-eql (complex 1d0 +0d0) + (tanh #c(200d0 +200d0))) + (assert-eql (complex 1w0 -0w0) + (tanh #c(200w0 -200w0))) + (assert-eql (complex 1w0 +0w0) + (tanh #c(200w0 200w0)))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2fb3f8df03f6dac2c3b4a… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2fb3f8df03f6dac2c3b4a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-314-complex-tanh-incorrect-for-large-arg] 2 commits: Fix the same tanh issue in irrat-dd.lisp.
by Raymond Toy (＠rtoy) 10 May '24

10 May '24

Raymond Toy pushed to branch issue-314-complex-tanh-incorrect-for-large-arg at cmucl / cmucl Commits: e028381e by Raymond Toy at 2024-05-10T09:08:48-07:00 Fix the same tanh issue in irrat-dd.lisp. The double-double version of complex-tanh has exactly the same problem. Apply the fix too. - - - - - 22cfda6d by Raymond Toy at 2024-05-10T09:09:26-07:00 Add tests for tanh of large double-double floats too. - - - - - 2 changed files: - src/code/irrat-dd.lisp - tests/irrat.lisp Changes: ===================================== src/code/irrat-dd.lisp ===================================== @@ -1800,12 +1800,10 @@ Z may be any number, but the result is always a complex." (declare (optimize (speed 3) (space 0) (inhibit-warnings 3))) (cond ((> (abs x) - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) - ;; This is more accurate under linux. - #+(or linux hpux) #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + ;; Don't need double-double accuracy here. + #.(/ (%asinh most-positive-double-float) 4d0)) (complex (float-sign x) - (float-sign y))) + (float-sign y 0w0))) (t (let* ((tv (dd-%tan y)) (beta (+ 1.0d0 (* tv tv))) ===================================== tests/irrat.lisp ===================================== @@ -239,4 +239,9 @@ (tanh #c(200d0 -200d0))) (assert-eql (complex 1d0 +0d0) (tanh #c(200d0 +200d0))) + (assert-eql (complex 1w0 -0w0) + (tanh #c(200w0 -200w0))) + (assert-eql (complex 1w0 +0w0) + (tanh #c(200w0 200w0)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cd8e60037f2de0e8f3dedc… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cd8e60037f2de0e8f3dedc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0