0.7.8.36:

        * :COUNT argument to sequence functions may be negative.
        * DO-SYMBOLS body may contain declarations.
        * Reverted patch by CSR in 0.7.8.28: ARRAY-HAS-FILL-POINTER-P
          is FLUSHABLE again.

diff --git a/NEWS b/NEWS
index f278677..6c65e6a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1317,11 +1317,15 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8:
     derived types contradict their declared type.
   * DEFMACRO is implemented via EVAL-WHEN instead of IR1 translation,
     so it can be non-toplevel.
+  * The fasl file version number has changed (because of the new
+    implementation of DEFMACRO).
   * fixed bugs 46h and 46i: TWO-WAY- and CONCATENATED-STREAM creation
     functions now check the types of their inputs as required by ANSI.
   * fixed bug 48c: SYMBOL-MACROLET signals PROGRAM-ERROR when an
     introduced symbol is DECLAREd to be SPECIAL.
   * fixed reading of (COMPLEX DOUBLE-FLOAT) literals from fasl files
+  * fixed bug: :COUNT argument to sequence functions may be negative
+  * fixed bug: body of DO-SYMBOLS may contain declarations
 
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 87f9323..ff61204 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1176,6 +1176,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
              "SCALE-DOUBLE-FLOAT"
             #!+long-float "SCALE-LONG-FLOAT"
              "SCALE-SINGLE-FLOAT"
+             "SEQUENCE-COUNT"
              "SEQUENCE-END" "SEQUENCE-OF-CHECKED-LENGTH-GIVEN-TYPE"
              "SET-ARRAY-HEADER" "SET-HEADER-DATA" "SHIFT-TOWARDS-END"
              "SHIFT-TOWARDS-START" "SHRINK-VECTOR" "SIGNED-BYTE-32-P"

diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp
index c153a2e..ddfe5fb 100644 (file)
--- a/src/code/deftypes-for-target.lisp
+++ b/src/code/deftypes-for-target.lisp
@@ -140,6 +140,11 @@
 ;;; the :END arg to a sequence
 (sb!xc:deftype sequence-end () '(or null index))
 
+;;; the :COUNT arg to a sequence
+(sb!xc:deftype sequence-count ()
+  `(or null (integer ,(- sb!xc:array-dimension-limit)
+                     (,sb!xc:array-dimension-limit))))
+
 ;;; a valid argument to a stream function
 ;;;
 ;;; FIXME: should probably be STREAM-DESIGNATOR, after the term

diff --git a/src/code/package.lisp b/src/code/package.lisp
index e71f345..e376b9d 100644 (file)
--- a/src/code/package.lisp
+++ b/src/code/package.lisp
@@ -111,7 +111,7 @@
   "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs at least once for each symbol accessible in the given
    PACKAGE with VAR bound to the current symbol."
-  (multiple-value-bind (body decls) body-decls
+  (multiple-value-bind (body decls) (parse-body body-decls nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
         (flet ((,flet-name (,var)

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 9269296..8d09e37 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -104,6 +104,14 @@
                              `(integer 0 ,max-end)
                              ;; This seems silly, is there something better?
                              '(integer (0) 0)))))
+
+(declaim (inline adjust-count)
+         (ftype (function (sequence-count) index) adjust-count))
+(defun adjust-count (count)
+  (cond ((not count) most-positive-fixnum)
+        ((< count 0) 0)
+        (t count)))
+
 \f
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
@@ -1106,7 +1114,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1144,7 +1152,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1182,7 +1190,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1329,7 +1337,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1347,7 +1355,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1365,7 +1373,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (seq-dispatch sequence
@@ -1653,7 +1661,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum)))
+        (count (adjust-count count)))
     (declare (type index length end)
             (fixnum count))
     (subst-dispatch 'normal)))
@@ -1668,7 +1676,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum))
+        (count (adjust-count count))
         test-not
         old)
     (declare (type index length end)
@@ -1684,7 +1692,7 @@
   (declare (fixnum start))
   (let* ((length (length sequence))
         (end (or end length))
-        (count (or count most-positive-fixnum))
+        (count (adjust-count count))
         test-not
         old)
     (declare (type index length end)
@@ -1701,7 +1709,7 @@
   may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))
     (declare (fixnum count))
     (if (listp sequence)
        (if from-end
@@ -1751,7 +1759,7 @@
    SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end
@@ -1791,7 +1799,7 @@
    SEQUENCE may be destructively modified. See manual for details."
   (declare (fixnum start))
   (let ((end (or end (length sequence)))
-       (count (or count most-positive-fixnum)))
+       (count (adjust-count count)))
     (declare (fixnum end count))
     (if (listp sequence)
        (if from-end

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 002b9c3..dbdc0a5 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -495,7 +495,7 @@
 (defknown remove
   (t sequence &key (:from-end t) (:test callable)
      (:test-not callable) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   consed-sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 2))
@@ -503,21 +503,21 @@
 (defknown substitute
   (t t sequence &key (:from-end t) (:test callable)
      (:test-not callable) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   consed-sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown (remove-if remove-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
-           (:count sequence-end) (:key callable))
+           (:count sequence-count) (:key callable))
   consed-sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown (substitute-if substitute-if-not)
   (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   consed-sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 3))
@@ -525,7 +525,7 @@
 (defknown delete
   (t sequence &key (:from-end t) (:test callable)
      (:test-not callable) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 2))
@@ -533,21 +533,21 @@
 (defknown nsubstitute
   (t t sequence &key (:from-end t) (:test callable)
      (:test-not callable) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown (delete-if delete-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
-           (:count sequence-end) (:key callable))
+           (:count sequence-count) (:key callable))
   sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown (nsubstitute-if nsubstitute-if-not)
   (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
-     (:count sequence-end) (:key callable))
+     (:count sequence-count) (:key callable))
   sequence
   (flushable call)
   :derive-type (sequence-result-nth-arg 3))
@@ -805,7 +805,7 @@
   #|:derive-type #'result-type-last-arg|#)
 
 (defknown array-has-fill-pointer-p (array) boolean
-  (movable foldable unsafely-flushable))
+  (movable foldable flushable))
 (defknown fill-pointer (vector) index (foldable unsafely-flushable))
 (defknown vector-push (t vector) (or index null) ())
 (defknown vector-push-extend (t vector &optional index) index ())

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 3287929..2dcfc4d 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -485,6 +485,9 @@
                           (if (policy node (= safety 3))
                               (and (ir1-attributep attr flushable)
                                    (every (lambda (arg)
+                                            ;; FIXME: when bug 203
+                                            ;; will be fixed, remove
+                                            ;; this check
                                             (member (continuation-type-check arg)
                                                     '(nil :deleted)))
                                           (basic-combination-args node))

diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
index 78433e0..54d71e4 100644 (file)
--- a/src/compiler/knownfun.lisp
+++ b/src/compiler/knownfun.lisp
@@ -51,7 +51,10 @@
   ;; may be eliminated if value is unused. The function has no side
   ;; effects except possibly cons. If a function might signal errors,
   ;; then it is not flushable even if it is movable, foldable or
-  ;; unsafely-flushable. Implies UNSAFELY-FLUSHABLE.
+  ;; unsafely-flushable. Implies UNSAFELY-FLUSHABLE. (In safe code
+  ;; type checking of arguments is always performed by the caller, so
+  ;; a function which SHOULD signal an error if arguments are not of
+  ;; declared types may be FLUSHABLE.)
   flushable
   ;; unsafe call may be eliminated if value is unused. The function
   ;; has no side effects except possibly cons and signalling an error

diff --git a/version.lisp-expr b/version.lisp-expr
index 0ec4ea7..5e0b755 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.8.35"
+"0.7.8.36"