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