0.8.1.13:

        * Index argument of LAST and [N]BUTLAST may be a bignum (from
          Paul Dietz' test suite).

diff --git a/NEWS b/NEWS
index 807f3d4..db3425d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1903,6 +1903,8 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1:
   * bug fix: CERROR accepts a function as its first argument.
   * bug fix: NTH an NTHCDR accept a bignum as index
     arguments. (reported by Adam Warner)
+  * fixed some bugs revealed by Paul Dietz' test suite:
+    ** LAST and [N]BUTLAST should accept a bignum.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/list.lisp b/src/code/list.lisp
index dee3790..0454ffc 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -11,6 +11,8 @@
 
 (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
@@ -231,14 +233,15 @@
 (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
@@ -417,30 +420,34 @@
           (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

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 23a156e..50f40e3 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -686,7 +686,7 @@
 (defknown list-length (list) (or index null) (foldable unsafely-flushable))
 (defknown nth (unsigned-byte list) t (foldable flushable))
 (defknown nthcdr (unsigned-byte list) t (foldable unsafely-flushable))
-(defknown last (list &optional index) t (foldable flushable))
+(defknown last (list &optional unsigned-byte) t (foldable flushable))
 (defknown list (&rest t) list (movable flushable unsafe))
 (defknown list* (t &rest t) t (movable flushable unsafe))
 (defknown make-list (index &key (:initial-element t)) list
@@ -707,8 +707,8 @@
 (defknown nconc (&rest t) t ())
 
 (defknown nreconc (list t) t ())
-(defknown butlast (list &optional index) list (flushable))
-(defknown nbutlast (list &optional index) list ())
+(defknown butlast (list &optional unsigned-byte) list (flushable))
+(defknown nbutlast (list &optional unsigned-byte) list ())
 (defknown ldiff (list t) list (flushable))
 (defknown (rplaca rplacd) (cons t) list (unsafe))
 

diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp
index 3a2894c..caf0bb5 100644 (file)
--- a/tests/list.pure.lisp
+++ b/tests/list.pure.lisp
@@ -124,3 +124,8 @@
   (assert (eq (nth (* 1440 most-positive-fixnum) s) 'c))
   (setf (nth (* 1440 most-positive-fixnum) s) 14)
   (assert (eq (nth (* 1440 most-positive-fixnum) s) 14)))
+
+(let ((s (copy-list '(1 2 3))))
+  (assert (eq s (last s (* 1440 most-positive-fixnum))))
+  (assert (null (butlast s (* 1440 most-positive-fixnum))))
+  (assert (null (nbutlast s (* 1440 most-positive-fixnum)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index b2e1faa..7fd05c3 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.12"
+"0.8.1.13"