(in-package "SB!IMPL")
+;;; Limitation: no list might have more than INDEX conses.
+
;;;; KLUDGE: comment from CMU CL, what does it mean?
;;;; NSUBLIS, things at the beginning broken.
;;;; -- WHN 20000127
(cdr list))
(defun nthcdr (n list)
- (declare (type index n))
#!+sb-doc
"Performs the cdr function n times on a list."
- (do ((i n (1- i))
- (result list (cdr result)))
- ((not (plusp i)) result)
- (declare (type index i))))
+ (flet ((fast-nthcdr (n list)
+ (declare (type index n))
+ (do ((i n (1- i))
+ (result list (cdr result)))
+ ((not (plusp i)) result)
+ (declare (type index i)))))
+ (typecase n
+ (index (fast-nthcdr n list))
+ (t (do ((i 0 (1+ i))
+ (r-i list (cdr r-i))
+ (r-2i list (cddr r-2i)))
+ ((and (eq r-i r-2i) (not (zerop i)))
+ (fast-nthcdr (mod n i) r-i))
+ (declare (type index i)))))))
(defun last (list &optional (n 1))
#!+sb-doc
"Return the last N conses (not the last element!) of a list."
- (declare (type index n))
- (do ((checked-list list (cdr checked-list))
- (returned-list list)
- (index 0 (1+ index)))
- ((atom checked-list) returned-list)
- (declare (type index index))
- (if (>= index n)
- (pop returned-list))))
+ (if (typep n 'index)
+ (do ((checked-list list (cdr checked-list))
+ (returned-list list)
+ (index 0 (1+ index)))
+ ((atom checked-list) returned-list)
+ (declare (type index index))
+ (if (>= index n)
+ (pop returned-list)))
+ list))
(defun list (&rest args)
#!+sb-doc
(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))))))
+ (if (typep n 'index)
+ (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)))))
+ nil))
(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)))))
+ (cond ((zerop n)
+ list)
+ ((not (typep n 'index))
+ nil)
+ (t (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))))))
(defun ldiff (list object)
"Return a new list, whose elements are those of LIST that appear before
;;; Set the Nth element of LIST to NEWVAL.
(defun %setnth (n list newval)
- (declare (type index n))
- (do ((count n (1- count))
- (list list (cdr list)))
- ((endp list)
- (error "~S is too large an index for SETF of NTH." n))
- (declare (type fixnum count))
- (when (<= count 0)
- (rplaca list newval)
- (return newval))))
+ (typecase n
+ (index
+ (do ((count n (1- count))
+ (list list (cdr list)))
+ ((endp list)
+ (error "~S is too large an index for SETF of NTH." n))
+ (declare (type fixnum count))
+ (when (<= count 0)
+ (rplaca list newval)
+ (return newval))))
+ (t (let ((cons (nthcdr n list)))
+ (when (endp cons)
+ (error "~S is too large an index for SETF of NTH." n))
+ (rplaca cons newval)
+ newval))))
\f
;;;; :KEY arg optimization to save funcall of IDENTITY
((atom subtree) subtree)
(t (let ((car (s (car subtree)))
(cdr (s (cdr subtree))))
- (if (and (eq car (car subtreE))
+ (if (and (eq car (car subtree))
(eq cdr (cdr subtree)))
subtree
(cons car cdr))))))))