From 5f492c8a8eea8a407d82de104e16b7148a7f9eb8 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Mon, 30 Jun 2003 07:06:48 +0000 Subject: [PATCH] 0.8.1.11: * Index argument of NTH and NTHCDR may be a bignum (bug reported by Adam Warner on c.l.l). --- NEWS | 2 ++ contrib/sb-bsd-sockets/tests.lisp | 2 +- make.sh | 10 ++++----- src/code/list.lisp | 43 +++++++++++++++++++++++++------------ src/compiler/fndb.lisp | 6 +++--- tests/list.pure.lisp | 7 ++++++ version.lisp-expr | 2 +- 7 files changed, 48 insertions(+), 24 deletions(-) diff --git a/NEWS b/NEWS index 300e284..807f3d4 100644 --- a/NEWS +++ b/NEWS @@ -1901,6 +1901,8 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1: * declared types of functions from the "Conditions" chapter. (reported by Paul Dietz) * 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) planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp index 0d6f3fc..0959a00 100644 --- a/contrib/sb-bsd-sockets/tests.lisp +++ b/contrib/sb-bsd-sockets/tests.lisp @@ -135,7 +135,7 @@ Tests are in the file tests.lisp and also make good examples. #-sunos (deftest simple-local-client - (let ((s (make-instance 'local-socket :type :datagram))) + (let ((s (make-instance 'local-socket :type :stream))) (format t "~A~%" s) (socket-connect s "/dev/log") (let ((stream (socket-make-stream s :input t :output t :buffering :none))) diff --git a/make.sh b/make.sh index 8626c85..64a565b 100755 --- a/make.sh +++ b/make.sh @@ -113,9 +113,9 @@ sh make-config.sh || exit 1 # Or, if you can set up the files somewhere shared (with NFS, AFS, or # whatever) between the host machine and the target machine, the basic # procedure above should still work, but you can skip the "copy" steps. -sh make-host-1.sh || exit 1 -sh make-target-1.sh || exit 1 -sh make-host-2.sh || exit 1 -sh make-target-2.sh || exit 1 -sh make-target-contrib.sh || exit 1 +time sh make-host-1.sh || exit 1 +time sh make-target-1.sh || exit 1 +time sh make-host-2.sh || exit 1 +time sh make-target-2.sh || exit 1 +time sh make-target-contrib.sh || exit 1 date diff --git a/src/code/list.lisp b/src/code/list.lisp index 47e476a..dee3790 100644 --- a/src/code/list.lisp +++ b/src/code/list.lisp @@ -211,13 +211,22 @@ (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 @@ -468,15 +477,21 @@ ;;; 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)))) ;;;; :KEY arg optimization to save funcall of IDENTITY diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index e48440d..23a156e 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -684,8 +684,8 @@ (foldable flushable call)) (defknown endp (list) boolean (foldable flushable movable)) (defknown list-length (list) (or index null) (foldable unsafely-flushable)) -(defknown nth (index list) t (foldable flushable)) -(defknown nthcdr (index list) t (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 list (&rest t) list (movable flushable unsafe)) (defknown list* (t &rest t) t (movable flushable unsafe)) @@ -1413,7 +1413,7 @@ (defknown (setf fdocumentation) ((or string null) t symbol) (or string null) ()) -(defknown %setnth (index list t) t (unsafe)) +(defknown %setnth (unsigned-byte list t) t (unsafe)) (defknown %set-fill-pointer (vector index) index (unsafe)) ;;;; miscellaneous internal utilities diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index 9bf32a8..3a2894c 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -117,3 +117,10 @@ (list 4 1 3 3)) #'<)) '(2 4))) + +;;; Bug reported by Adam Warner: valid list index designator is not +;;; necessary a fixnum +(let ((s (read-from-string "(a . #1=(b c . #1#))"))) + (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))) diff --git a/version.lisp-expr b/version.lisp-expr index a37bc1b..2965c2a 100644 --- 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.10" +"0.8.1.11" -- 1.7.10.4