From c33612272b00979a34861d962f5e7bd47f36ae6e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 18 Oct 2002 11:03:01 +0000 Subject: [PATCH] 0.7.8.45: Some more maintenance on MAKE-SEQUENCE, this time on LIST-like type specifiers, motivated by Paul Dietz' ansi-tests example of (MERGE 'NULL '(1 3) '(2 4) #'>) ... abstract some more of the errors into helper macros, in preparation for their use in MAP/MERGE/CONCATENATE/COERCE; ... make MAKE-SEQUENCE detect (most) wrong uses of CONS/NULL and friends, and error on too-hairy cases. ... probably still non-compliant (throwing an error) on e.g. (MAKE-SEQUENCE '(CONS * (CONS * NULL)) 2) :-( --- src/code/seq.lisp | 79 +++++++++++++++++++++++++++++++++++-------------- tests/seq.impure.lisp | 19 ++++++++++++ version.lisp-expr | 2 +- 3 files changed, 76 insertions(+), 24 deletions(-) diff --git a/src/code/seq.lisp b/src/code/seq.lisp index e602e10..93bfa19 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -56,6 +56,34 @@ :format-control "~S is a bad type specifier for sequences." :format-arguments (list ,type-spec))) +(sb!xc:defmacro sequence-type-length-mismatch-error (type length) + `(error 'simple-type-error + :datum ,length + :expected-type (cond ((array-type-p ,type) + `(eql ,(car (array-type-dimensions ,type)))) + ((type= ,type (specifier-type 'null)) + '(eql 0)) + ((cons-type-p ,type) + '(integer 1)) + (t (bug "weird type in S-T-L-M-ERROR"))) + ;; FIXME: this format control causes ugly printing. There's + ;; probably some ~<~@:_~> incantation that would make it + ;; nicer. -- CSR, 2002-10-18 + :format-control "The length requested (~S) does not match the type restriction in ~S." + :format-arguments (list ,length (type-specifier ,type)))) + +(sb!xc:defmacro sequence-type-too-hairy (type-spec) + ;; FIXME: Should this be a BUG? I'm inclined to think not; there are + ;; words that give some but not total support to this position in + ;; ANSI. Essentially, we are justified in throwing this on + ;; e.g. '(OR SIMPLE-VECTOR (VECTOR FIXNUM)), but maybe not (by ANSI) + ;; on '(CONS * (CONS * NULL)) -- CSR, 2002-10-18 + `(error 'simple-type-error + :datum ,type-spec + ;; FIXME: as in BAD-SEQUENCE-TYPE-ERROR, this is wrong. + :expected-type 'sequence + :format-control "~S is too hairy for sequence functions." + :format-arguments (list ,type-spec))) ) ; EVAL-WHEN ;;; It's possible with some sequence operations to declare the length @@ -158,7 +186,28 @@ (declare (fixnum length)) (let ((type (specifier-type type))) (cond ((csubtypep type (specifier-type 'list)) - (make-list length :initial-element initial-element)) + (cond + ((type= type (specifier-type 'list)) + (make-list length :initial-element initial-element)) + ((eq type *empty-type*) + (bad-sequence-type-error nil)) + ((type= type (specifier-type 'null)) + (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))) + ;; 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. + (t (sequence-type-too-hairy (type-specifier type))))) ((csubtypep type (specifier-type 'vector)) (if (typep type 'array-type) ;; KLUDGE: the above test essentially asks "Do we know @@ -171,13 +220,7 @@ (type-length (car (array-type-dimensions type)))) (unless (or (eq type-length '*) (= type-length length)) - (error 'simple-type-error - :datum length - :expected-type `(eql ,type-length) - :format-control "The length requested (~S) ~ - does not match the length type restriction in ~S." - :format-arguments (list length - (type-specifier type)))) + (sequence-type-length-mismatch-error type length)) ;; FIXME: These calls to MAKE-ARRAY can't be ;; open-coded, as the :ELEMENT-TYPE argument isn't ;; constant. Probably we ought to write a @@ -187,13 +230,7 @@ (make-array length :element-type etype :initial-element initial-element) (make-array length :element-type etype)))) - ;; We have a subtype of VECTOR, but it isn't an array - ;; type. Maybe this should be a BUG instead? - (error 'simple-type-error - :datum type - :expected-type 'sequence - :format-control "~S is too hairy for MAKE-SEQUENCE." - :format-arguments (list (type-specifier type))))) + (sequence-type-too-hairy (type-specifier type)))) (t (bad-sequence-type-error (type-specifier type)))))) ;;;; SUBSEQ @@ -1477,7 +1514,7 @@ which case the one later in the sequence is discarded. The resulting sequence is returned. - The :TEST-NOT argument is depreciated." + The :TEST-NOT argument is deprecated." (declare (fixnum start)) (seq-dispatch sequence (if sequence @@ -1550,7 +1587,7 @@ discarded. The resulting sequence, which may be formed by destroying the given sequence, is returned. - The :TEST-NOT argument is depreciated." + The :TEST-NOT argument is deprecated." (seq-dispatch sequence (if sequence (list-delete-duplicates* sequence test test-not key from-end start end)) @@ -1961,12 +1998,8 @@ ;;; perhaps it's worth optimizing the -if-not versions in the same ;;; way as the others? ;;; -;;; That sounds reasonable, so if someone wants to submit patches to -;;; make the -IF-NOT functions compile as efficiently as the -;;; corresponding -IF variants do, go for it. -- WHN 2001-10-06) -;;; -;;; FIXME: Remove uses of these deprecated functions (and of :TEST-NOT -;;; too) within the implementation of SBCL. +;;; FIXME: Maybe remove uses of these deprecated functions (and +;;; definitely of :TEST-NOT) within the implementation of SBCL. (declaim (inline find-if-not position-if-not)) (macrolet ((def-find-position-if-not (fun-name values-index) `(defun ,fun-name (predicate sequence diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index 92dff11..5aea01c 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -285,6 +285,25 @@ (assert (equal '(1 2 3 4) (merge 'list-typeoid '(1 3) '(2 4) '<))) ;;; and also with types that weren't precicely LIST (assert (equal '(1 2 3 4) (merge 'cons '(1 3) '(2 4) '<))) + +;;; but wait, there's more! The NULL and CONS types also have implicit +;;; length requirements: +(macrolet ((assert-type-error (form) + `(assert (typep (nth-value 1 (ignore-errors ,form)) + 'type-error)))) + (locally + (declare (optimize safety)) + ;; MAKE-SEQUENCE + (assert-type-error (make-sequence 'cons 0)) + (assert-type-error (make-sequence 'null 1)) + (assert (null (make-sequence 'null 0))) + (assert (= (length (make-sequence 'cons 3)) 3)) + ;; and NIL is not a valid type for MAKE-SEQUENCE + (assert-type-error (make-sequence 'nil 0)) + ;; tests for MAP/MERGE/CONCATENATE/COERCE to come. + )) + + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 236eb25..64b4fcf 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.44" +"0.7.8.45" -- 1.7.10.4