diff --git a/tests/lists.lisp b/tests/lists.lisp index 0d8578c3..793a4467 100644 --- a/tests/lists.lisp +++ b/tests/lists.lisp @@ -264,3 +264,10 @@ (with-member-test (mem :key nil :test nil) (is-true (mem 1 '(1 2 3))) (is-false (mem 4 '(1 2 3)))))) + +(test with-member-test/complex-expansion () + "Test expansion of with-member-test when speed is the priority." + (locally (declare (optimize (speed 3) (space 0) (compilation-speed 0) (debug 0))) + (with-member-test (mem :key nil :test nil) + (is-true (mem 1 '(1 2 3))) + (is-false (mem 4 '(1 2 3)))))) diff --git a/types.lisp b/types.lisp index 1e2ff2dd..b51e9729 100644 --- a/types.lisp +++ b/types.lisp @@ -748,25 +748,34 @@ WITH-BOOLEAN." '(values :test-not ',utest-not) '(values))))) ,@body))) - `(let ((,test (canonicalize-test ,test ,test-not))) - (with-item-key-function (,key) - (with-two-arg-test (,test) - (macrolet ((,test-fn (x l) - (let ((test ',test) - (key ',key)) - (with-unique-names (ul ux mem) - `(let ((,ul ,l) - (,ux ,x)) - (declare (optimize (safety 0) (debug 0)) - (list ,ul)) - (block ,mem - (tagbody loop - (when ,ul - (unless (,test ,ux (,key (first ,ul))) - (setf ,ul (cdr ,ul)) - (go loop))) - (return-from ,mem ,ul)))))))) - ,@body)))))) + (let ((test? test) + (test (or test (gensym (string 'test)))) + (test-not? test-not) + (test-not (or test (gensym (string 'test-not)))) + (key? key) + (key (or key (gensym (string 'key))))) + `(let ((,test (canonicalize-test + ,(and test? test) + ,(and test-not? test-not))) + (,key ,(and key? key))) + (with-item-key-function (,key) + (with-two-arg-test (,test) + (macrolet ((,test-fn (x l) + (let ((test ',test) + (key ',key)) + (with-unique-names (ul ux mem) + `(let ((,ul ,l) + (,ux ,x)) + (declare (optimize (safety 0) (debug 0)) + (list ,ul)) + (block ,mem + (tagbody loop + (when ,ul + (unless (,test ,ux (,key (first ,ul))) + (setf ,ul (cdr ,ul)) + (go loop))) + (return-from ,mem ,ul)))))))) + ,@body))))))) (defmacro with-item-key-function ((key &optional (key-form key)) &body body &environment env)