;;; our equality tests, because MEMBER and friends refer to EQLity.
;;; So:
(defun equal-but-no-car-recursion (x y)
- (cond
- ((eql x y) t)
- ((consp x)
- (and (consp y)
- (eql (car x) (car y))
- (equal-but-no-car-recursion (cdr x) (cdr y))))
- (t nil)))
+ (do () (())
+ (cond ((eql x y) (return t))
+ ((and (consp x)
+ (consp y)
+ (eql (pop x) (pop y))))
+ (t
+ (return)))))
\f
;;;; package idioms
(list (list :line lineno)
(list :column colno)
(list :file-position pos)))))))
+
+(declaim (inline schwartzian-stable-sort-list))
+(defun schwartzian-stable-sort-list (list comparator &key key)
+ (if (null key)
+ (stable-sort (copy-list list) comparator)
+ (let* ((key (if (functionp key)
+ key
+ (symbol-function key)))
+ (wrapped (mapcar (lambda (x)
+ (cons x (funcall key x)))
+ list))
+ (sorted (stable-sort wrapped comparator :key #'cdr)))
+ (map-into sorted #'car sorted))))