1.0.16.19: cleanups motivated by clisp host-2

[sbcl.git] / src / compiler / seqtran.lisp

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 494c047..28da444 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -315,7 +315,7 @@
     (setf test nil))
   ;; Ditto for KEY IDENTITY.
   (when (and key (lvar-for-named-function key 'identity))
-    (set key nil))
+    (setf key nil))
   ;; Key can legally be NIL, but if it's NIL for sure we pretend it's
   ;; not there at all. If it might be NIL, make up a form to that
   ;; ensures it is a function.
@@ -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))
@@ -381,6 +382,9 @@
 (deftransform assoc ((item list &key key test test-not) * * :node node)
   (transform-list-item-seek 'assoc item list key test test-not node))
 
+(deftransform adjoin ((item list &key key test test-not) * * :node node)
+  (transform-list-item-seek 'adjoin item list key test test-not node))
+
 (deftransform memq ((item list) (t (constant-arg list)))
   (labels ((rec (tail)
              (if tail