From f24a665895283c52443ed45bb3e07530f760bbfa Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 4 May 2008 15:06:37 +0000 Subject: [PATCH] 1.0.16.15: fix TRANSFORM-LIST-ITEM-SEEK for ADJOIN with constant list arg * Urk, missed a spot. There is probably little sense to open code ADJOIN like ASSOC and MEMBER, so let's not. * Tests. --- src/compiler/seqtran.lisp | 3 ++- tests/list.pure.lisp | 12 ++++++++++++ version.lisp-expr | 2 +- 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 4c5e02d..28da444 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -364,7 +364,8 @@ `(%coerce-callable-to-fun ,fun)))) (let* ((cp (constant-lvar-p list)) (c-list (when cp (lvar-value list)))) - (cond ((and cp c-list (policy node (>= speed space))) + (cond ((and cp c-list (member name '(assoc member)) + (policy node (>= speed space))) `(let ,(mapcar (lambda (fun) `(,fun ,(ensure-fun fun))) funs) ,(open-code c-list))) ((and cp (not c-list)) diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 66882ea..921500d 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -250,3 +250,15 @@ (assert (equal '((:b)) (let ((sb-ext:*evaluator-mode* :interpret)) (eval '(adjoin (list 'b) (list '(:b)) :key #'car :test #'string=))))) + +;;; constant list argument to ADJOIN +(assert (equal '(:x :y) (funcall + (compile nil '(lambda (elt) + (declare (optimize speed)) + (adjoin elt '(:x :y)))) + ':x))) +(assert (equal '(:x :y) (funcall + (compile nil '(lambda (elt) + (declare (optimize speed)) + (adjoin elt '(:y)))) + ':x))) diff --git a/version.lisp-expr b/version.lisp-expr index 1803b76..0424d81 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.16.14" +"1.0.16.15" -- 1.7.10.4