master: Lower more things to from EQUALP to EQUAL
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via c1f893b2dff39b06ba7df00ba4f1f812ebdb05f3 (commit)
from ce88d7209f22005baaa28ea2e8e7fbd96ee0da13 (commit)
- Log -----------------------------------------------------------------
commit c1f893b2dff39b06ba7df00ba4f1f812ebdb05f3
Author: Stas Boukarev <[email protected]>
Date: Wed Apr 8 20:45:07 2026 +0300
Lower more things to from EQUALP to EQUAL
Characters and strings without case
---
src/compiler/srctran.lisp | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index fba418568..aa6331272 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -6961,11 +6961,22 @@
,y)
(eq (car ,y) ',(car value))
(eq (cdr ,y) ',(cdr value))))
- ((and (proper-or-dotted-list-p value)
- (let ((cdr value))
- (and (loop while (consp cdr)
- always (symbolp (pop cdr)))
- (symbolp cdr))))
+ ((or
+ ;; (equalp string "123") => equal
+ (and (stringp value)
+ (notany #'both-case-p value)
+ (csubtypep (type-intersection y-type (specifier-type 'vector))
+ (specifier-type 'string)))
+ ;; (equalp x '(symbol #\0)) => equal
+ (labels ((equal-comparison-p (x)
+ (or (symbolp x)
+ (and (characterp x)
+ (not (both-case-p x))))))
+ (and (proper-or-dotted-list-p value)
+ (let ((cdr value))
+ (and (loop while (consp cdr)
+ always (equal-comparison-p (pop cdr)))
+ (equal-comparison-p cdr))))))
`(equal x y))))))
;; (equalp x (list y))
;; (equalp x (cons car cdr))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL