From 5cb8cc568fb36108546819c47b3f819f33dabd95 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Tue, 1 Jul 2003 15:04:09 +0000 Subject: [PATCH] NTHCDR and NTH are specified to accept unsigned-byte. Found by Paul Dietz, fixed by Alexey Dejneka in SBCL. * src/compiler/fndb.lisp (nth, nthcdr): First arg is unsigned-byte. * src/code/list.lisp (nthcdr): Cope with bignums. --- code/list.lisp | 21 +++++++++++++++------ compiler/fndb.lisp | 4 ++-- general-info/release-19a.txt | 1 + 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/code/list.lisp b/code/list.lisp index a6c43354b..0233cd011 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.31 2003/05/26 20:20:32 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.32 2003/07/01 15:04:09 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -173,12 +173,21 @@ (cdr list)) (defun nthcdr (n list) - (declare (type index n)) "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)) "Returns the last N conses (not the last element!) of a list." diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index 75ca62d56..94265cc45 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.115 2003/06/06 16:23:46 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.116 2003/07/01 15:04:09 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -596,7 +596,7 @@ (foldable flushable call)) (defknown endp (list) boolean (foldable flushable movable)) (defknown list-length (list) (or index null) (foldable flushable)) -(defknown (nth nthcdr) (index list) t (foldable flushable)) +(defknown (nth nthcdr) (unsigned-byte list) t (foldable flushable)) (defknown last (list &optional index) list (foldable flushable)) (defknown list (&rest t) list (movable flushable unsafe)) (defknown list* (t &rest t) t (movable flushable unsafe)) diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index 0c0398c85..794478edf 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -127,6 +127,7 @@ New in this release: - SLOT-VALUE, (SETF SLOT-VALUE), SLOT-BOUNDP, SLOT-MAKUNBOUND returning values specified by the standard when SLOT-UNBOUND or SLOT-MISSING are called and return. + - NTH and NTHCDR accepting bignums as first argument. * Numerous bugfixes: - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR -- GitLab