From adf1fff8e895683c752451bf462f3102f1e0960b Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Wed, 16 Jul 2003 15:43:47 +0000
Subject: [PATCH] 	LAST, BUTLAST, NBUTLAST accept bignums.  Found by Paul
 Dietz.

	* src/compiler/fndb.lisp (last, butlast, nbutlast): Accept
	unsigned-byte counters.
	* src/code/list.lisp (last, butlast, nbutlast): Likewise.
---
 code/list.lisp               | 28 +++++++++++++++-------------
 compiler/fndb.lisp           |  8 ++++----
 general-info/release-19a.txt |  1 +
 3 files changed, 20 insertions(+), 17 deletions(-)

diff --git a/code/list.lisp b/code/list.lisp
index 0233cd011..5a0dd4738 100644
--- a/code/list.lisp
+++ b/code/list.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.32 2003/07/01 15:04:09 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.33 2003/07/16 15:43:47 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -191,14 +191,16 @@
 
 (defun last (list &optional (n 1))
   "Returns 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))))
+  (declare (type unsigned-byte n))
+  (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)
   "Returns constructs and returns a list of its arguments."
@@ -385,8 +387,8 @@
 (defun butlast (list &optional (n 1))
   "Returns a new list the same as List without the last N conses.
    List must not be circular."
-  (declare (list list) (type index n))
-  (unless (null list)
+  (declare (list list) (type unsigned-byte n))
+  (when (and list (typep n 'index))
     (let ((length (do ((list list (cdr list))
 		       (i 0 (1+ i)))
 		      ((atom list) (1- i)))))
@@ -402,8 +404,8 @@
 
 (defun nbutlast (list &optional (n 1))
   "Modifies List to remove the last N conses. List must not be circular."
-  (declare (list list) (type index n))
-  (unless (null list)
+  (declare (list list) (type unsigned-byte n))
+  (when (and list (typep n 'index))
     (let ((length (do ((list list (cdr list))
 		       (i 0 (1+ i)))
 		      ((atom list) (1- i)))))
diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 76de03cfa..e148ce9f8 100644
--- a/compiler/fndb.lisp
+++ b/compiler/fndb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.117 2003/07/01 15:44:40 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.118 2003/07/16 15:43:47 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -597,7 +597,7 @@
 (defknown endp (list) boolean (foldable flushable movable))
 (defknown list-length (list) (or index null) (foldable flushable))
 (defknown (nth nthcdr) (unsigned-byte list) t (foldable flushable))
-(defknown last (list &optional index) list (foldable flushable))
+(defknown last (list &optional unsigned-byte) list (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
@@ -613,8 +613,8 @@
 (defknown revappend (list t) t (flushable))
 (defknown nconc (&rest t) t ())
 (defknown nreconc (list t) list ())
-(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/general-info/release-19a.txt b/general-info/release-19a.txt
index 6de36a729..b230cb757 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -133,6 +133,7 @@ New in this release:
      - First arg of CERROR may be a function.
      - Lambda-lists of the form (X . Y) in DESTRUCTURING-BIND and macros
        are now equivalent to (X &REST Y).
+     - LAST, BUTLAST, NBUTLAST accepting bignum counts.
 
   * Numerous bugfixes:
      - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR
-- 
GitLab