- (do ((list1 list1)
- (list2 list2)
- (x list1 (cdr x))
- (splicex ()))
- ((endp x)
- (if (null splicex)
- (setq list1 list2)
- (rplacd splicex list2))
- list1)
- (do ((y list2 (cdr y))
- (splicey ()))
- ((endp y) (setq splicex x))
- (cond ((let ((key-val-x (apply-key key (car x)))
- (key-val-y (apply-key key (Car y))))
- (if notp
- (not (funcall test-not key-val-x key-val-y))
- (funcall test key-val-x key-val-y)))
- (if (null splicex)
- (setq list1 (cdr x))
- (rplacd splicex (cdr x)))
- (if (null splicey)
- (setq list2 (cdr y))
- (rplacd splicey (cdr y)))
- (return ())) ; assume lists are really sets
- (t (setq splicey y))))))
+ (when (and testp notp)
+ (error ":TEST and :TEST-NOT were both supplied."))
+ (let ((key (and key (%coerce-callable-to-fun key)))
+ (test (if testp (%coerce-callable-to-fun test) test))
+ (test-not (if notp (%coerce-callable-to-fun test-not) test-not)))
+ (declare (type function test test-not))
+ ;; The outer loop examines LIST1 while the inner loop examines
+ ;; LIST2. If an element is found in LIST2 "equal" to the element
+ ;; in LIST1, both are spliced out. When the end of LIST1 is
+ ;; reached, what is left of LIST2 is tacked onto what is left of
+ ;; LIST1. The splicing operation ensures that the correct
+ ;; operation is performed depending on whether splice is at the
+ ;; top of the list or not
+ (do ((list1 list1)
+ (list2 list2)
+ (x list1 (cdr x))
+ (splicex ()))
+ ((endp x)
+ (if (null splicex)
+ (setq list1 list2)
+ (rplacd splicex list2))
+ list1)
+ (do ((y list2 (cdr y))
+ (splicey ()))
+ ((endp y) (setq splicex x))
+ (cond ((let ((key-val-x (apply-key key (car x)))
+ (key-val-y (apply-key key (Car y))))
+ (if notp
+ (not (funcall test-not key-val-x key-val-y))
+ (funcall test key-val-x key-val-y)))
+ (if (null splicex)
+ (setq list1 (cdr x))
+ (rplacd splicex (cdr x)))
+ (if (null splicey)
+ (setq list2 (cdr y))
+ (rplacd splicey (cdr y)))
+ (return ())) ; assume lists are really sets
+ (t (setq splicey y)))))))