From 2419deec84b45d81610dc8d3db610c3e2f7b9486 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 20 Nov 2007 14:19:54 +0000 Subject: [PATCH] 1.0.11.34: better SUBSEQ on lists * Be prepared to handle bignum cases (once we support them.) * Better (and faster) error-checking. --- BUGS | 8 ++++++ NEWS | 3 ++ package-data-list.lisp-expr | 4 ++- src/code/seq.lisp | 66 +++++++++++++++++++++++++++++++------------ src/compiler/seqtran.lisp | 5 ++++ tests/list.pure.lisp | 7 +++++ version.lisp-expr | 2 +- 7 files changed, 75 insertions(+), 20 deletions(-) diff --git a/BUGS b/BUGS index 9e778d1..a375a31 100644 --- a/BUGS +++ b/BUGS @@ -1854,3 +1854,11 @@ WORKAROUND: ; note: deleting unreachable code Deleting the toplevel NIL, or even replacing it with 3, causes the system not to complain. + +418: SUBSEQ on lists doesn't support bignum indexes + + LIST-SUBSEQ* now has all the works necessary to support bignum indexes, + but it needs to be verified that changing the DEFKNOWN doesn't kill + performance elsewhere. + + Other generic sequence functions have this problem as well. diff --git a/NEWS b/NEWS index 6e7c352..87f44f2 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,9 @@ changes in sbcl-1.0.12 relative to sbcl-1.0.11: SB-EXT:HASH-TABLE-SYNCHRONIZED-P. * optimization: CONCATENATE on strings is an order of magnitue faster in code compiled with (> SPEED SPACE). + * optimization: SUBSEQ is ~50% faster on lists. + * bug fix: SUBSEQ on a list will now correctly signal an error if if + END is smaller then START. * bug fix: SB-PROFILE will no longer report extra consing for nested calls to profiled functions. * bug fix: ROOM implementation had bogus fixnum declarations which diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 3e5507f..abad961 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1318,7 +1318,9 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "LAYOUT-N-UNTAGGED-SLOTS" "LAYOUT-FOR-STD-CLASS-P" "LAYOUT-SLOT-TABLE" #!+(or x86-64 x86) "%LEA" - "LEXENV" "LEXENV-DESIGNATOR" "LINE-LENGTH" "ANSI-STREAM" + "LEXENV" "LEXENV-DESIGNATOR" "LINE-LENGTH" + "LIST-SUBSEQ*" + "ANSI-STREAM" "ANSI-STREAM-BIN" "ANSI-STREAM-BOUT" "ANSI-STREAM-CLOSE" "ANSI-STREAM-ELEMENT-TYPE" "ANSI-STREAM-IN" "ANSI-STREAM-IN-BUFFER" "ANSI-STREAM-IN-INDEX" diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 37d333c..859fed3 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -368,24 +368,54 @@ (setf (aref copy new-index) (aref sequence old-index)))) -(defun list-subseq* (sequence start &optional end) - (declare (type list sequence)) - ;; the INDEX declaration isn't actually mandatory, but it's true for - ;; all practical purposes. - (declare (type index start)) - (declare (type (or null index) end)) - (do ((list sequence (cdr list)) - (index 0 (1+ index)) - (result nil)) - (nil) - (cond - ((null list) (if (or (and end (> end index)) - (< index start)) - (signal-bounding-indices-bad-error sequence start end) - (return (nreverse result)))) - ((< index start) nil) - ((and end (= index end)) (return (nreverse result))) - (t (push (car list) result))))) +(defun list-subseq* (sequence start end) + (declare (type list sequence) + (type unsigned-byte start) + (type (or null unsigned-byte) end)) + (flet ((oops () + (signal-bounding-indices-bad-error sequence start end))) + (let ((pointer sequence)) + (unless (zerop start) + ;; If START > 0 the list cannot be empty. So CDR down to + ;; it START-1 times, check that we still have something, then + ;; CDR the final time. + ;; + ;; If START was zero, the list may be empty if END is NIL or + ;; also zero. + (when (> start 1) + (setf pointer (nthcdr (1- start) pointer))) + (if pointer + (pop pointer) + (oops))) + (if end + (let ((n (- end start))) + (declare (integer n)) + (when (minusp n) + (oops)) + (when (plusp n) + (let* ((head (list nil)) + (tail head)) + (macrolet ((pop-one () + `(let ((tmp (list (pop pointer)))) + (setf (cdr tail) tmp + tail tmp)))) + ;; Bignum case + (loop until (fixnump n) + do (pop-one) + (decf n)) + ;; Fixnum case, but leave last element, so we should + ;; still have something left in the sequence. + (let ((m (1- n))) + (declare (fixnum m)) + (loop repeat m + do (pop-one))) + (unless pointer + (oops)) + ;; OK, pop the last one. + (pop-one) + (cdr head))))) + (loop while pointer + collect (pop pointer)))))) (defun subseq (sequence start &optional end) #!+sb-doc diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index cb127c4..d7dbab22 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -284,6 +284,7 @@ (deftransform %check-vector-sequence-bounds ((vector start end) (vector * *) * :node node) + ;; FIXME: Should this not be INSERT-ARRAY-BOUNDS-CHECKS? (if (policy node (< safety speed)) '(or end (length vector)) '(let ((length (length vector))) @@ -801,6 +802,10 @@ 'result 0 'size element-type) result))))) +(deftransform subseq ((seq start &optional end) + (list t &optional t)) + `(list-subseq* seq start end)) + (deftransform copy-seq ((seq) ((or (simple-unboxed-array (*)) simple-vector)) *) (let ((array-type (lvar-type seq))) (unless (array-type-p array-type) diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp index afc5c6b..702b89e 100644 --- a/tests/list.pure.lisp +++ b/tests/list.pure.lisp @@ -229,3 +229,10 @@ :b '((:a . 1) (:b . 2)))))) (assert (equal '(3 4 5) (funcall (compile nil '(lambda (i l) (member i l))) 3 '(1 2 3 4 5))))) + +;;; bad bounding index pair to SUBSEQ on a list +(let ((list (list 0 1 2 3 4 5))) + (multiple-value-bind (res err) (ignore-errors (subseq list 4 2)) + (assert (not res)) + (assert (typep err 'sb-kernel:bounding-indices-bad-error)))) + diff --git a/version.lisp-expr b/version.lisp-expr index e1f564e..156fa07 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".) -"1.0.11.33" +"1.0.11.34" -- 1.7.10.4