X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fseqtran.lisp;h=3277b0426038a3a22bae20a2d400a4b7f242c6a6;hb=74a1797f60e26c7adbc491840f89bbaab08e504d;hp=494c04764e774700ee3a3cc78b79d690ce28bbff;hpb=ab6672fd5c392b8678681bdda138c4dc9e4de31a;p=sbcl.git diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 494c047..3277b04 100644 --- 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