- (let ((key (and key (%coerce-callable-to-fun key))))
- (let ((res list2)
- (list1 list1))
- (do ()
- ((endp list1))
- (if (not (with-set-keys (member (apply-key key (car list1)) list2)))
- (steve-splice list1 res)
- (setf list1 (cdr list1))))
- res)))
+ ;; We have to possibilities here: for shortish lists we pick up the
+ ;; shorter one as the result, and add the other one to it. For long
+ ;; lists we use a hash-table when possible.
+ (let ((n1 (length list1))
+ (n2 (length list2))
+ (key (and key (%coerce-callable-to-fun key)))
+ (test (if notp
+ (let ((test-not-fun (%coerce-callable-to-fun test-not)))
+ (lambda (x) (not (funcall test-not-fun x))))
+ (%coerce-callable-to-fun test))))
+ (multiple-value-bind (short long n-short)
+ (if (< n1 n2)
+ (values list1 list2 n1)
+ (values list2 list1 n2))
+ (if (or (< n-short +list-based-union-limit+)
+ (not (member test (list #'eq #'eql #'equal #'equalp))))
+ (let ((orig short))
+ (do ((elt (car long) (car long)))
+ ((endp long))
+ (if (not (member (apply-key key elt) orig :key key :test test))
+ (steve-splice long short)
+ (setf long (cdr long))))
+ short)
+ (let ((table (make-hash-table :test test :size (+ n1 n2))))
+ (dolist (elt long)
+ (setf (gethash (apply-key key elt) table) elt))
+ (dolist (elt short)
+ (setf (gethash (apply-key key elt) table) elt))
+ (let ((union long)
+ (head long))
+ (maphash (lambda (k v)
+ (declare (ignore k))
+ (if head
+ (setf (car head) v
+ head (cdr head))
+ (push v union)))
+ table)
+ union))))))