diff --git a/code/list.lisp b/code/list.lisp index 32d183c6560da7b404ff4b90533cc540cfb0cd63..1d84582a5cb5c86883b6b04988fb765ce8534703 100644 --- a/code/list.lisp +++ b/code/list.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.26 2001/03/04 23:37:32 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.27 2002/11/20 16:14:33 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -782,16 +782,27 @@ (defun set-exclusive-or (list1 list2 &key key - (test #'eql testp) (test-not nil notp)) - "Returns new list of elements appearing exactly once in list1 and list2." + (test #'eql testp) (test-not nil notp)) + "Return new list of elements appearing exactly once in LIST1 and LIST2." (declare (inline member)) - (let ((result nil)) + (let ((result nil) + (key (when key (coerce key 'function))) + (test (coerce test 'function)) + (test-not (if test-not (coerce test-not 'function) #'eql))) + (declare (type (or function null) key) + (type function test test-not)) (dolist (elt list1) (unless (with-set-keys (member (apply-key key elt) list2)) (setq result (cons elt result)))) - (dolist (elt list2) - (unless (with-set-keys (member (apply-key key elt) list1)) - (setq result (cons elt result)))) + (let ((test (if testp + (lambda (x y) (funcall test y x)) + test)) + (test-not (if notp + (lambda (x y) (funcall test-not y x)) + test-not))) + (dolist (elt list2) + (unless (with-set-keys (member (apply-key key elt) list1)) + (setq result (cons elt result))))) result))