all of the arguments are circular is probably desireable).
213: "Sequence functions and type checking"
- a. MAKE-SEQUENCE, COERCE, MERGE and CONCATENATE cannot deal with
- various complicated, though recognizeable, CONS types [e.g.
- (CONS * (CONS * NULL))
- which according to ANSI should be recognized] (and, in SAFETY 3
- code, should return a list of LENGTH 2 or signal an error)
+ a. (fixed in 0.8.4.36)
b. MAP, when given a type argument that is SUBTYPEP LIST, does not
check that it will return a sequence of the given type. Fixing
it along the same lines as the others (cf. work done around
* bug fix: LOOP forms using NIL as a for-as-arithmetic counter no
longer raise an error; further, using a list as a for-as-arithmetic
counter now raises a meaningful error.
+ * fixed bug 213a: even fairly unreasonable CONS type specifiers are
+ now understood by sequence creation functions such as MAKE-SEQUENCE
+ and COERCE.
* compiler enhancement: SIGNUM is now better able to derive the type
of its result.
* type declarations inside WITH-SLOTS are checked. (reported by
# versions 2.3.1 and 2.3.2
$GNUMAKE -C tools-for-build where-is-mcontext
tools-for-build/where-is-mcontext > src/runtime/ppc-linux-mcontext.h
+elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "darwin" ]; then
+ # The default stack ulimit under darwin is too small to run PURIFY.
+ # Best we can do is complain and exit at this stage
+ if [ $(ulimit -s) = "512" ]; then
+ echo "Your stack size limit is too small to build SBCL."
+ echo "See the limit(1) or ulimit(1) commands and the README file."
+ exit 1
+ fi
else
# Nothing need be done in this case, but sh syntax wants a placeholder.
echo > /dev/null
res))))
((csubtypep type (specifier-type 'list))
(if (vectorp object)
- (cond ((type= type (specifier-type 'list))
- (vector-to-list* object))
- ((type= type (specifier-type 'null))
- (if (= (length object) 0)
- 'nil
- (sequence-type-length-mismatch-error type
- (length object))))
- ((csubtypep (specifier-type '(cons nil t)) type)
- (if (> (length object) 0)
- (vector-to-list* object)
- (sequence-type-length-mismatch-error type 0)))
- (t (sequence-type-too-hairy (type-specifier type))))
+ (cond
+ ((type= type (specifier-type 'list))
+ (vector-to-list* object))
+ ((type= type (specifier-type 'null))
+ (if (= (length object) 0)
+ 'nil
+ (sequence-type-length-mismatch-error type
+ (length object))))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (length object)))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (vector-to-list* object))))
+ (t (sequence-type-too-hairy (type-specifier type))))
(coerce-error)))
((csubtypep type (specifier-type 'vector))
(typecase object
(eq cdr-type *empty-type*))
*empty-type*
(%make-cons-type car-type cdr-type)))
+
+(defun cons-type-length-info (type)
+ (declare (type cons-type type))
+ (do ((min 1 (1+ min))
+ (cdr (cons-type-cdr-type type) (cons-type-cdr-type cdr)))
+ ((not (cons-type-p cdr))
+ (cond
+ ((csubtypep cdr (specifier-type 'null))
+ (values min t))
+ ((csubtypep *universal-type* cdr)
+ (values min nil))
+ ((type/= (type-intersection (specifier-type 'cons) cdr) *empty-type*)
+ (values min nil))
+ ((type/= (type-intersection (specifier-type 'null) cdr) *empty-type*)
+ (values min t))
+ (t (values min :maybe))))
+ ()))
+
\f
;;;; type utilities
(defun make-sequence (type length &key (initial-element nil iep))
#!+sb-doc
"Return a sequence of the given TYPE and LENGTH, with elements initialized
- to :INITIAL-ELEMENT."
+ to INITIAL-ELEMENT."
(declare (fixnum length))
(let* ((adjusted-type
(typecase type
(if (= length 0)
'nil
(sequence-type-length-mismatch-error type length)))
- ((csubtypep (specifier-type '(cons nil t)) type)
- ;; The above is quite a neat way of finding out if
- ;; there's a type restriction on the CDR of the
- ;; CONS... if there is, I think it's probably fair to
- ;; give up; if there isn't, then the list to be made
- ;; must have a length of more than 0.
- (if (> length 0)
- (make-list length :initial-element initial-element)
- (sequence-type-length-mismatch-error type length)))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (make-list length :initial-element initial-element)))
;; We'll get here for e.g. (OR NULL (CONS INTEGER *)),
;; which may seem strange and non-ideal, but then I'd say
;; it was stranger to feed that type in to MAKE-SEQUENCE.
(and (vectorp x) (= (length x) 0))))
sequences)
'nil
- (sequence-type-length-mismatch-error type
- ;; FIXME: circular
- ;; list issues. And
- ;; rightward-drift.
- (reduce #'+
- (mapcar #'length
- sequences)))))
- ((csubtypep (specifier-type '(cons nil t)) type)
- (if (notevery (lambda (x) (or (null x)
- (and (vectorp x) (= (length x) 0))))
- sequences)
- (apply #'concat-to-list* sequences)
- (sequence-type-length-mismatch-error type 0)))
+ (sequence-type-length-mismatch-error
+ type
+ ;; FIXME: circular list issues.
+ (reduce #'+ sequences :key #'length))))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (reduce #'+ sequences :key #'length)))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (apply #'concat-to-list* sequences))))
(t (sequence-type-too-hairy (type-specifier type)))))
((csubtypep type (specifier-type 'vector))
(apply #'concat-to-simple* output-type-spec sequences))
(sequence-type-length-mismatch-error type
(+ (length s1)
(length s2)))))
- (if (csubtypep (specifier-type '(cons nil t)) type)
- (if (and (null s1) (null s2))
- (sequence-type-length-mismatch-error type 0)
- (values (merge-lists* s1 s2 pred-fun key-fun)))
+ (if (cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (+ (length s1) (length s2))))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (values (merge-lists* s1 s2 pred-fun key-fun))))
(sequence-type-too-hairy result-type))))
((csubtypep type (specifier-type 'vector))
(let* ((vector-1 (coerce sequence1 'vector))
;; MAKE-SEQUENCE
(assert-type-error (make-sequence 'cons 0))
(assert-type-error (make-sequence 'null 1))
+ (assert-type-error (make-sequence '(cons t null) 0))
+ (assert-type-error (make-sequence '(cons t null) 2))
;; KLUDGE: I'm not certain that this test actually tests for what
;; it should test, in that the type deriver and optimizers might
;; be too smart for the good of an exhaustive test system.
;; However, it makes me feel good. -- CSR, 2002-10-18
(assert (null (make-sequence 'null 0)))
(assert (= (length (make-sequence 'cons 3)) 3))
+ (assert (= (length (make-sequence '(cons t null) 1)) 1))
;; and NIL is not a valid type for MAKE-SEQUENCE
(assert-type-error (make-sequence 'nil 0))
;; COERCE
(assert-type-error (coerce #(1) 'null))
(assert-type-error (coerce #() 'cons))
+ (assert-type-error (coerce #() '(cons t null)))
+ (assert-type-error (coerce #(1 2) '(cons t null)))
(assert (null (coerce #() 'null)))
(assert (= (length (coerce #(1) 'cons)) 1))
+ (assert (= (length (coerce #(1) '(cons t null))) 1))
(assert-type-error (coerce #() 'nil))
;; MERGE
(assert-type-error (merge 'null '(1 3) '(2 4) '<))
(assert-type-error (merge 'cons () () '<))
(assert (null (merge 'null () () '<)))
(assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+ (assert (= (length (merge '(cons t (cons t (cons t (cons t null))))
+ '(1 3) '(2 4) '<)) 4))
(assert-type-error (merge 'nil () () '<))
;; CONCATENATE
(assert-type-error (concatenate 'null '(1) "2"))
(assert-type-error (concatenate 'cons #() ()))
+ (assert-type-error (concatenate '(cons t null) #(1 2 3) #(4 5 6)))
(assert (null (concatenate 'null () #())))
(assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
+ (assert (= (length (concatenate '(cons t cons) '(1) "34")) 3))
(assert-type-error (concatenate 'nil '(3)))
;; FIXME: tests for MAP to come when some brave soul implements
;; the analogous type checking for MAP/%MAP.
;;; 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.4.35"
+"0.8.4.36"
projects / sbcl.git / commitdiff