From ea1fd7753b7dc1277a7d250fed317300fe1e5772 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Mon, 14 Oct 2002 06:59:19 +0000 Subject: [PATCH] 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. --- NEWS | 4 ++++ package-data-list.lisp-expr | 1 + src/code/deftypes-for-target.lisp | 5 +++++ src/code/package.lisp | 2 +- src/code/seq.lisp | 32 ++++++++++++++++++++------------ src/compiler/fndb.lisp | 18 +++++++++--------- src/compiler/ir1opt.lisp | 3 +++ src/compiler/knownfun.lisp | 5 ++++- version.lisp-expr | 2 +- 9 files changed, 48 insertions(+), 24 deletions(-) diff --git a/NEWS b/NEWS index f278677..6c65e6a 100644 --- 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 --- 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 --- 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 --- 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 --- 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))) + (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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4