- (if (or (and from-end
- (not (if test-not
- (member (apply-key key (car current))
- (nthcdr (1+ start) result)
- :test-not test-not
- :key key)
- (member (apply-key key (car current))
- (nthcdr (1+ start) result)
- :test test
- :key key))))
- (and (not from-end)
- (not (do ((it (apply-key key (car current)))
- (l (cdr current) (cdr l))
- (i (1+ index) (1+ i)))
- ((or (atom l) (and end (= i (the fixnum end))))
- ())
- (declare (fixnum i))
- (if (if test-not
- (not (funcall test-not
- it
- (apply-key key (car l))))
- (funcall test it (apply-key key (car l))))
- (return t))))))
- (setq splice (cdr (rplacd splice (list (car current))))))
+ (cond
+ (hash
+ (let ((prev (gethash (car current) hash)))
+ (cond
+ ((not prev)
+ (setf (gethash (car current) hash) splice)
+ (setq splice (cdr (rplacd splice (list (car current))))))
+ (from-end nil)
+ (t
+ (let ((old (cdr prev)))
+ (let ((next (cdr old)))
+ (when next
+ (let ((next-val (car next)))
+ ;; (assert (eq (gethash next-val hash) old))
+ (setf (cdr prev) next
+ (gethash next-val hash) prev
+ (gethash (car current) hash) splice
+ splice (cdr (rplacd splice (list (car current)))))))))))))
+ (t
+ (if (or (and from-end
+ (not (if test-not
+ (member (apply-key key (car current))
+ (nthcdr (1+ start) result)
+ :test-not test-not
+ :key key)
+ (member (apply-key key (car current))
+ (nthcdr (1+ start) result)
+ :test test
+ :key key))))
+ (and (not from-end)
+ (not (do ((it (apply-key key (car current)))
+ (l (cdr current) (cdr l))
+ (i (1+ index) (1+ i)))
+ ((or (atom l) (and end (= i (the fixnum end))))
+ ())
+ (declare (fixnum i))
+ (if (if test-not
+ (not (funcall test-not
+ it
+ (apply-key key (car l))))
+ (funcall test it (apply-key key (car l))))
+ (return t))))))
+ (setq splice (cdr (rplacd splice (list (car current))))))))