1.0.18.11: Add SB-EXT:*MUFFLED-WARNINGS*, to muffle warnings at runtime.

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

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 494c047..3277b04 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,12 +364,15 @@
                      `(%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))
-                 ;; constant nil list -- nothing to find!
-                 nil)
+                 ;; constant nil list
+                 (if (eq name 'adjoin)
+                     '(list item)
+                     nil))
                 (t
                  ;; specialized out-of-line version
                  `(,(specialized-list-seek-function-name name funs c-test)
@@ -381,6 +384,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