* (CONCATENATE 'NULL SEQUENCE1 SEQUENCE2 ...) ensures that SEQUENCE1,
SEQUENCE2, ... are empty, but only did so for lists and
vectors. Instead, use new function EMPTYP which works for all
sequences. EMPTYP is not exported.
* Add generic function SEQUENCE:EMPTYP to which EMPTYP dispatches for
generic sequences. Methods for lists, vectors and generic sequences
use NULL or (ZEROP (LENGTH ...)).
* Test cases in seq.impure.lisp.
* Patch by Jan Moringen; fixes lp#1162301.
recursion no longer causes undescriptive compiler errors. (lp#1180992)
* bug fix: sub-word BOOLEAN alien types now disregard higher order bits
when testing for non-zero-ness.
recursion no longer causes undescriptive compiler errors. (lp#1180992)
* bug fix: sub-word BOOLEAN alien types now disregard higher order bits
when testing for non-zero-ness.
+ * bug fix: (CONCATENATE 'null ...) no longer fails for generic sequences.
+ (lp#1162301)
* optimization: faster ISQRT on fixnums and small bignums
* optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
* optimization: On x86-64, the number of multi-byte NOP instructions used
* optimization: faster ISQRT on fixnums and small bignums
* optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
* optimization: On x86-64, the number of multi-byte NOP instructions used
"CANONIZE-TEST" "CANONIZE-KEY"
"CANONIZE-TEST" "CANONIZE-KEY"
+ "EMPTYP" "LENGTH" "ELT"
"MAKE-SEQUENCE-LIKE" "ADJUST-SEQUENCE"
"COUNT" "COUNT-IF" "COUNT-IF-NOT"
"MAKE-SEQUENCE-LIKE" "ADJUST-SEQUENCE"
"COUNT" "COUNT-IF" "COUNT-IF-NOT"
:type '(and list (satisfies list-length)))))
\f
:type '(and list (satisfies list-length)))))
\f
+
+(defun emptyp (sequence)
+ #!+sb-doc
+ "Returns T if SEQUENCE is an empty sequence and NIL
+ otherwise. Signals an error if SEQUENCE is not a sequence."
+ (seq-dispatch sequence
+ (null sequence)
+ (zerop (length sequence))
+ (sb!sequence:emptyp sequence)))
+
(defun elt (sequence index)
#!+sb-doc "Return the element of SEQUENCE specified by INDEX."
(seq-dispatch sequence
(defun elt (sequence index)
#!+sb-doc "Return the element of SEQUENCE specified by INDEX."
(seq-dispatch sequence
((eq type *empty-type*)
(bad-sequence-type-error nil))
((type= type (specifier-type 'null))
((eq type *empty-type*)
(bad-sequence-type-error nil))
((type= type (specifier-type 'null))
- (if (every (lambda (x) (or (null x)
- (and (vectorp x) (= (length x) 0))))
- sequences)
- 'nil
- (sequence-type-length-mismatch-error
- type
- ;; FIXME: circular list issues.
- (reduce #'+ sequences :key #'length))))
+ (unless (every #'emptyp sequences)
+ (sequence-type-length-mismatch-error
+ type (reduce #'+ sequences :key #'length))) ; FIXME: circular list issues.
+ '())
((cons-type-p type)
(multiple-value-bind (min exactp)
(sb!kernel::cons-type-length-info type)
((cons-type-p type)
(multiple-value-bind (min exactp)
(sb!kernel::cons-type-length-info type)
(error 'sequence::protocol-unimplemented
:datum sequence :expected-type '(or list vector)))
(error 'sequence::protocol-unimplemented
:datum sequence :expected-type '(or list vector)))
+(defgeneric sequence:emptyp (sequence)
+ (:method ((s list)) (null s))
+ (:method ((s vector)) (zerop (length s)))
+ (:method ((s sequence)) (zerop (length s))))
+
(defgeneric sequence:length (sequence)
(:method ((s list)) (length s))
(:method ((s vector)) (length s))
(defgeneric sequence:length (sequence)
(:method ((s list)) (length s))
(:method ((s vector)) (length s))
+;;; user-defined mock sequence class for testing generic versions of
+;;; sequence functions.
(defclass list-backed-sequence (standard-object
sequence)
((elements :initarg :elements :type list :accessor %elements)))
(defclass list-backed-sequence (standard-object
sequence)
((elements :initarg :elements :type list :accessor %elements)))
(assert (eql 4 ; modified more, avoids charset technicalities completely
(find 5 '(6 4) :test '>)))
(assert (eql 4 ; modified more, avoids charset technicalities completely
(find 5 '(6 4) :test '>)))
+(with-test (:name sequence:emptyp)
+ (for-every-seq #()
+ '((eq t (sequence:emptyp seq))))
+ (for-every-seq #(1)
+ '((eq nil (sequence:emptyp seq)))))
+
;;; tests of FIND, POSITION, FIND-IF, and POSITION-IF (and a few for
;;; deprecated FIND-IF-NOT and POSITION-IF-NOT too)
(for-every-seq #()
;;; tests of FIND, POSITION, FIND-IF, and POSITION-IF (and a few for
;;; deprecated FIND-IF-NOT and POSITION-IF-NOT too)
(for-every-seq #()
;; ... though not in all cases.
(assert-type-error (coerce '(#\f #\o #\o) 'simple-array))))
;; ... though not in all cases.
(assert-type-error (coerce '(#\f #\o #\o) 'simple-array))))
+;; CONCATENATE used to fail for generic sequences for result-type NULL.
+(with-test (:name (concatenate :result-type-null :bug-1162301))
+ (assert (sequence:emptyp (concatenate 'null)))
+
+ (for-every-seq #()
+ '((sequence:emptyp (concatenate 'null seq))
+ (sequence:emptyp (concatenate 'null seq seq))
+ (sequence:emptyp (concatenate 'null seq #()))
+ (sequence:emptyp (concatenate 'null seq ""))))
+
+ (for-every-seq #(1)
+ (mapcar (lambda (form)
+ `(typep (nth-value 1 (ignore-errors ,form)) 'type-error))
+ '((concatenate 'null seq)
+ (concatenate 'null seq seq)
+ (concatenate 'null seq #())
+ (concatenate 'null seq "2")))))
+
;;; As pointed out by Raymond Toy on #lisp IRC, MERGE had some issues
;;; with user-defined types until sbcl-0.7.8.11
(deftype list-typeoid () 'list)
;;; As pointed out by Raymond Toy on #lisp IRC, MERGE had some issues
;;; with user-defined types until sbcl-0.7.8.11
(deftype list-typeoid () 'list)
4))
(assert-type-error (merge 'nil () () '<))
;; CONCATENATE
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-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)))
(assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
(assert (= (length (concatenate '(cons t cons) '(1) "34")) 3))
(assert-type-error (concatenate 'nil '(3)))