1.0.11.34: better SUBSEQ on lists

* Be prepared to handle bignum cases (once we support
  them.)

* Better (and faster) error-checking.

diff --git a/BUGS b/BUGS
index 9e778d1..a375a31 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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..d7dbab2 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"