master: Better predicates for named list structures
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 6133cb16778d84f93a3aa03bc09de6359b3358c6 (commit)
from e18e2ccd71bd7a625b9e28d23dd2ee3bae42905a (commit)
- Log -----------------------------------------------------------------
commit 6133cb16778d84f93a3aa03bc09de6359b3358c6
Author: Stas Boukarev <[email protected]>
Date: Wed Apr 15 21:37:26 2026 +0300
Better predicates for named list structures
---
src/code/defstruct.lisp | 17 +++++++++++++----
1 file changed, 13 insertions(+), 4 deletions(-)
diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 57a9867e8..69d499e7b 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -565,10 +565,19 @@
(and (typep ,argname ',ltype)
,(cond
((subtypep ltype 'list)
- `(do ((head (the ,ltype ,argname) (cdr head))
- (i 0 (1+ i)))
- ((or (not (consp head)) (= i ,name-index))
- (and (consp head) (eq ',name (car head))))))
+ (if (zerop name-index)
+ (if (null name)
+ `(and (consp ,argname)
+ (eq (car ,argname) ',name))
+ `(eq (car ,argname) ',name))
+ `(do ((head (the ,ltype ,argname) (cdr head))
+ (i 0 (1+ i)))
+ ((if (,(if (null name)
+ 'consp
+ 'listp) head)
+ (>= i ,name-index)
+ (return))
+ (eq ',name (car head))))))
((subtypep ltype 'vector)
`(and (>= (length (the ,ltype ,argname))
,(dd-length defstruct))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL