-(defun butlast (list &optional (n 1))
- #!+sb-doc
- "Return a new list the same as LIST without the last N conses.
- List must not be circular."
- (declare (list list) (type index n))
- (let ((length (do ((list list (cdr list))
- (i 0 (1+ i)))
- ((atom list) (1- i)))))
- (declare (type index length))
- (unless (< length n)
- (do* ((top (cdr list) (cdr top))
- (result (list (car list)))
- (splice result)
- (count length (1- count)))
- ((= count n) result)
- (declare (type index count))
- (setq splice (cdr (rplacd splice (list (car top)))))))))
-
-(defun nbutlast (list &optional (n 1))
- #!+sb-doc
- "Modifies List to remove the last N conses. List must not be circular."
- (declare (list list) (type index n))
- (let ((length (do ((list list (cdr list))
- (i 0 (1+ i)))
- ((atom list) (1- i)))))
- (declare (type index length))
- (unless (< length n)
- (do ((1st (cdr list) (cdr 1st))
- (2nd list 1st)
- (count length (1- count)))
- ((= count n)
- (rplacd 2nd ())
- list)
- (declare (type index count))))))
+(flet (;; Return the number of conses at the head of the
+ ;; possibly-improper list LIST. (Or if LIST is circular, you
+ ;; lose.)
+ (count-conses (list)
+ (do ((in-list list (cdr in-list))
+ (result 0 (1+ result)))
+ ((atom in-list)
+ result)
+ (declare (type index result)))))
+ (declare (ftype (function (t) index) count-conses))
+ (defun butlast (list &optional (n 1))
+ (let ((n-conses-in-list (count-conses list)))
+ (cond ((zerop n)
+ ;; (We can't use SUBSEQ in this case because LIST isn't
+ ;; necessarily a proper list, but SUBSEQ expects a
+ ;; proper sequence. COPY-LIST isn't so fussy.)
+ (copy-list list))
+ ((>= n n-conses-in-list)
+ nil)
+ (t
+ ;; (LIST isn't necessarily a proper list in this case
+ ;; either, and technically SUBSEQ wants a proper
+ ;; sequence, but no reasonable implementation of SUBSEQ
+ ;; will actually walk down to the end of the list to
+ ;; check, and since we're calling our own implementation
+ ;; we know it's reasonable, so it's OK.)
+ (subseq list 0 (- n-conses-in-list n))))))
+ (defun nbutlast (list &optional (n 1))
+ (if (zerop n)
+ list
+ (let ((n-conses-in-list (count-conses list)))
+ (unless (<= n-conses-in-list n)
+ (setf (cdr (nthcdr (- n-conses-in-list n 1) list))
+ nil)
+ list)))))