From ecd87c1ac0983a9ccf823c0344c5736c41e10e57 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 1 Jul 2003 05:23:06 +0000 Subject: [PATCH] 0.8.1.13: * Index argument of LAST and [N]BUTLAST may be a bignum (from Paul Dietz' test suite). --- NEWS | 2 ++ src/code/list.lisp | 69 ++++++++++++++++++++++++++---------------------- src/compiler/fndb.lisp | 6 ++--- tests/list.pure.lisp | 5 ++++ version.lisp-expr | 2 +- 5 files changed, 49 insertions(+), 35 deletions(-) diff --git a/NEWS b/NEWS index 807f3d4..db3425d 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4